From 6fa9273a1e62c16f10c149ad3c6aa8dd5066faf1 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Mon, 15 Apr 2019 14:43:13 -0600 Subject: [PATCH 01/72] broken: started adding changes for mode-shape visualization --- modules-local/elastodyn/src/ElastoDyn_IO.f90 | 2 +- modules-local/hydrodyn/src/SS_Radiation.txt | 2 +- modules-local/nwtc-library/src/NWTC_IO.f90 | 1 + .../openfast-library/src/FAST_Mods.f90 | 1 + .../openfast-library/src/FAST_Registry.txt | 108 +++++++++++++++++- .../openfast-library/src/FAST_Subs.f90 | 53 ++++++--- 6 files changed, 146 insertions(+), 21 deletions(-) diff --git a/modules-local/elastodyn/src/ElastoDyn_IO.f90 b/modules-local/elastodyn/src/ElastoDyn_IO.f90 index 8222a52495..6aa3f98b6b 100644 --- a/modules-local/elastodyn/src/ElastoDyn_IO.f90 +++ b/modules-local/elastodyn/src/ElastoDyn_IO.f90 @@ -61,7 +61,7 @@ MODULE ElastoDyn_Parameters INTEGER(IntKi), PARAMETER :: DOF_Teet = 22 !DOF_TFrl + 2*(NumBE+NumBF)+ 1 ! DOF index for rotor-teeter - + INTEGER(IntKi), PARAMETER :: ED_MaxDOFs = 24 INTEGER(IntKi), PARAMETER :: NPA = 9 ! Number of DOFs that contribute to the angular velocity of the tail (body A) in the inertia frame. diff --git a/modules-local/hydrodyn/src/SS_Radiation.txt b/modules-local/hydrodyn/src/SS_Radiation.txt index ece9c86958..8f7d95a1d9 100644 --- a/modules-local/hydrodyn/src/SS_Radiation.txt +++ b/modules-local/hydrodyn/src/SS_Radiation.txt @@ -17,7 +17,7 @@ typedef ^ ^ ReKi DOFs {1}{6} - - "Vector typedef ^ InitOutputType CHARACTER(10) WriteOutputHdr {7} - - "Header of the output" - typedef ^ InitOutputType CHARACTER(10) WriteOutputUnt {7} - - "Units of the output" - -typedef ^ ContinuousStateType ReKi x {:} - - "Continuous States" - +typedef ^ ContinuousStateType R8Ki x {:} - - "Continuous States" - typedef ^ DiscreteStateType SiKi DummyDiscState - - - "" - diff --git a/modules-local/nwtc-library/src/NWTC_IO.f90 b/modules-local/nwtc-library/src/NWTC_IO.f90 index 5109af6c6e..cd43d839e0 100644 --- a/modules-local/nwtc-library/src/NWTC_IO.f90 +++ b/modules-local/nwtc-library/src/NWTC_IO.f90 @@ -1526,6 +1526,7 @@ SUBROUTINE CheckArgs ( InputFile, ErrStat, Arg2, Flag ) CALL Conv2UC( Arg ) Flag = Arg(2:) !this results in only the last flag IF ( TRIM(Flag) == 'RESTART' ) CYCLE ! Get next argument (which will be input [checkpoint] file name) + IF ( TRIM(Flag) == 'VTKLIN' ) CYCLE ! Get next argument (which will be input [checkpoint] file name) END IF CALL NWTC_DisplaySyntax( InputFile, ProgName ) diff --git a/modules-local/openfast-library/src/FAST_Mods.f90 b/modules-local/openfast-library/src/FAST_Mods.f90 index 2d5e1bffb3..f528ae815d 100644 --- a/modules-local/openfast-library/src/FAST_Mods.f90 +++ b/modules-local/openfast-library/src/FAST_Mods.f90 @@ -42,6 +42,7 @@ MODULE FAST_ModTypes INTEGER(IntKi), PARAMETER :: VTK_None = 0 !< none (no VTK output) INTEGER(IntKi), PARAMETER :: VTK_InitOnly = 1 !< VTK output only at initialization INTEGER(IntKi), PARAMETER :: VTK_Animate = 2 !< VTK animation output + INTEGER(IntKi), PARAMETER :: VTK_ModeShapes = 3 !< VTK output after linearization analysis INTEGER(IntKi), PARAMETER :: VTK_Surf = 1 !< output surfaces INTEGER(IntKi), PARAMETER :: VTK_Basic = 2 !< output minimal number of point/line meshes diff --git a/modules-local/openfast-library/src/FAST_Registry.txt b/modules-local/openfast-library/src/FAST_Registry.txt index 701df1f6fa..a9143262dd 100644 --- a/modules-local/openfast-library/src/FAST_Registry.txt +++ b/modules-local/openfast-library/src/FAST_Registry.txt @@ -70,6 +70,23 @@ typedef ^ FAST_VTK_SurfaceType SiKi WaveElev {:}{:} - - "wave elevation at WaveE typedef ^ FAST_VTK_SurfaceType FAST_VTK_BLSurfaceType BladeShape {:} - - "AirfoilCoords for each blade" m typedef ^ FAST_VTK_SurfaceType SiKi MorisonRad {:} - - "radius of each Morison node" m + +typedef ^ FAST_VTK_ModeShapeType CHARACTER(1024) CheckpointRoot - - - "name of the checkpoint file written by FAST when linearization data was produced" +typedef ^ FAST_VTK_ModeShapeType CHARACTER(1024) MatlabFileName - - - "name of the file with eigenvectors written by Matlab" +typedef ^ FAST_VTK_ModeShapeType IntKi VTKLinModes - - - "Number of modes to visualize" - +typedef ^ FAST_VTK_ModeShapeType IntKi VTKModes {:} - - "Which modes to visualize" - +typedef ^ FAST_VTK_ModeShapeType IntKi VTKLinTim - - - "Switch to make one animation for all LinTimes together (1) or separate animations for each LinTimes(2)" - +typedef ^ FAST_VTK_ModeShapeType IntKi VTKNLinTimes - - - "number of linearization times to use when VTKLinTim==2" - +typedef ^ FAST_VTK_ModeShapeType ReKi VTKLinScale - - - "Mode shape visualization scaling factor" - +typedef ^ FAST_VTK_ModeShapeType ReKi VTKLinPhase - - - "Phase when making one animation for all LinTimes together (used only when VTKLinTim=1)" - +typedef ^ FAST_VTK_ModeShapeType R8Ki DampingRatio {:} - - "damping ratios from mbc3 analysis" - +typedef ^ FAST_VTK_ModeShapeType R8Ki NaturalFreq_Hz {:} - - "natural frequency from mbc3 analysis" - +typedef ^ FAST_VTK_ModeShapeType R8Ki DampedFreq_Hz {:} - - "damped frequency from mbc3 analysis" - +typedef ^ FAST_VTK_ModeShapeType R8Ki x_eig_magnitude {:}{:}{:} - - "magnitude of eigenvector (dimension 1=state, dim 2= azimuth, dim 3 = mode)" - +typedef ^ FAST_VTK_ModeShapeType R8Ki x_eig_phase {:}{:}{:} - - "phase of eigenvector (dimension 1=state, dim 2= azimuth, dim 3 = mode)" - + + + # ..... FAST_ParameterType data ....................................................................................................... # Misc data for coupling: typedef FAST FAST_ParameterType DbKi DT - - - "Integration time step [global time]" s @@ -122,7 +139,7 @@ typedef ^ FAST_ParameterType LOGICAL WrBinOutFile - - - "Write a binary output f typedef ^ FAST_ParameterType LOGICAL WrTxtOutFile - - - "Write a text (formatted) output file? (.out)" - typedef ^ FAST_ParameterType IntKi WrBinMod - - - "If writing binary, which file format is to be written [1, 2, or 3]" - typedef ^ FAST_ParameterType LOGICAL SumPrint - - - "Print summary data to file? (.sum)" - -typedef ^ FAST_ParameterType INTEGER WrVTK - - - "VTK Visualization data output: (switch) {0=none; 1=initialization data only; 2=animation}" - +typedef ^ FAST_ParameterType INTEGER WrVTK - 0 - "VTK Visualization data output: (switch) {0=none; 1=initialization data only; 2=animation}" - typedef ^ FAST_ParameterType INTEGER VTK_Type - - - "Type of VTK visualization data: (switch) {1=surfaces; 2=basic meshes (lines/points); 3=all meshes (debug)}" - typedef ^ FAST_ParameterType LOGICAL VTK_fields - - - "Write mesh fields to VTK data files? (flag) {true/false}" - typedef ^ FAST_ParameterType CHARACTER(1) Delim - - - "Delimiter between columns of text output file (.out): space or tab" - @@ -132,18 +149,104 @@ typedef ^ FAST_ParameterType IntKi FmtWidth - - - "width of the time OutFmt spec typedef ^ FAST_ParameterType IntKi TChanLen - - - "width of the time channel" - typedef ^ FAST_ParameterType CHARACTER(1024) OutFileRoot - - - "The rootname of the output files" - typedef ^ FAST_ParameterType CHARACTER(1024) FTitle - - - "The description line from the FAST (glue-code) input file" - +typedef ^ FAST_ParameterType DbKi VTK_fps - - - "number of frames per second to output VTK data" - typedef ^ FAST_ParameterType DbKi LinTimes {:} - - "List of times at which to linearize" s typedef ^ FAST_ParameterType IntKi LinInputs - - - "Inputs included in linearization (switch) {0=none; 1=standard; 2=all module inputs (debug)} [unused if Linearize=False]" - typedef ^ FAST_ParameterType IntKi LinOutputs - - - "Outputs included in linearization (switch) {0=none; 1=from OutList(s); 2=all module outputs (debug)} [unused if Linearize=False]" - typedef ^ FAST_ParameterType LOGICAL LinOutJac - - - "Include full Jacabians in linearization output (for debug) (flag) [unused if Linearize=False; used only if LinInputs=LinOutputs=2]" - typedef ^ FAST_ParameterType LOGICAL LinOutMod - - - "Write module-level linearization output files in addition to output for full system? (flag) [unused if Linearize=False]" - typedef ^ FAST_ParameterType FAST_VTK_SurfaceType VTK_surface - - - "Data for VTK surface visualization" +typedef ^ FAST_ParameterType FAST_VTK_ModeShapeType VTK_modes - - - "Data for VTK mode-shape visualization" typedef ^ FAST_ParameterType SiKi TurbinePos {3} - - "Initial position of turbine base (origin used for graphics)" m typedef ^ FAST_ParameterType IntKi Lin_NumMods - - - "number of modules in the linearization" typedef ^ FAST_ParameterType Integer Lin_ModOrder {NumModules} - - "indices that determine which order the modules are in the glue-code linearization matrix" typedef ^ FAST_ParameterType CHARACTER(4) Tdesc - - - "description of turbine ID (for FAST.Farm) screen printing" + +# 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" +# ..... ElatoDyn 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" +# ..... 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" +# ..... No AeroDyn14 data ....................................................................................................... +# ..... 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" +# ..... 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 OpenFOAM 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" +# ..... 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" typedef ^ FAST_LinType CHARACTER(LinChanLen) Names_y {:} - - "Names of the linearized outputs" @@ -156,6 +259,8 @@ typedef ^ FAST_LinType ReKi op_x {:} - - "continuous state operating point" typedef ^ FAST_LinType ReKi op_dx {:} - - "1st time derivative of continuous state operating point" typedef ^ FAST_LinType ReKi op_xd {:} - - "discrete state operating point" typedef ^ FAST_LinType ReKi op_z {:} - - "constraint state operating point" +typedef ^ FAST_LinType R8Ki op_x_eig_mag {:} - - "continuous state eigenvector magnitude" +typedef ^ FAST_LinType R8Ki op_x_eig_phase {:} - - "continuous state eigenvector phase" typedef ^ FAST_LinType Logical Use_u {:} - - "array same size as names_u, which indicates if this input is used in linearization output file" typedef ^ FAST_LinType Logical Use_y {:} - - "array same size as names_y, which indicates if this output is used in linearization output file" typedef ^ FAST_LinType R8Ki A {:}{:} - - "A matrix" @@ -200,6 +305,7 @@ typedef ^ FAST_OutputFileType CHARACTER(ChanLen) Module_Abrev {NumModules} - - " typedef ^ FAST_OutputFileType IntKi VTK_count - - - "Number of VTK files written (for naming output files)" typedef ^ FAST_OutputFileType IntKi VTK_LastWaveIndx - - - "last index into wave array" - typedef ^ FAST_OutputFileType FAST_LinFileType Lin - - - "linearization data for output" +typedef ^ FAST_OutputFileType FAST_LinStateSave op - - - "operating points of states and inputs for VTK output of mode shapes" # ..... IceDyn data ....................................................................................................... diff --git a/modules-local/openfast-library/src/FAST_Subs.f90 b/modules-local/openfast-library/src/FAST_Subs.f90 index d295aeacfc..e23f1b40bd 100644 --- a/modules-local/openfast-library/src/FAST_Subs.f90 +++ b/modules-local/openfast-library/src/FAST_Subs.f90 @@ -1726,14 +1726,30 @@ SUBROUTINE ValidateInputData(p, ErrStat, ErrMsg) END IF - if ( p%WrVTK == VTK_Unknown ) then - call SetErrStat(ErrID_Fatal, 'WrVTK must be 0 (none), 1 (initialization only), or 2 (animation).', ErrStat, ErrMsg, RoutineName) - else - if ( p%VTK_type == VTK_Unknown ) then - call SetErrStat(ErrID_Fatal, 'VTK_type must be 1 (surfaces), 2 (basic meshes:lines/points), or 3 (all meshes).', ErrStat, ErrMsg, RoutineName) - ! note I'm not going to write that 4 (old) is an option - end if - end if + if ( p%WrVTK == VTK_Unknown ) then + call SetErrStat(ErrID_Fatal, 'WrVTK must be 0 (none), 1 (initialization only), 2 (animation), or 3 (mode shapes).', ErrStat, ErrMsg, RoutineName) + else + if ( p%VTK_type == VTK_Unknown ) then + call SetErrStat(ErrID_Fatal, 'VTK_type must be 1 (surfaces), 2 (basic meshes:lines/points), or 3 (all meshes).', ErrStat, ErrMsg, RoutineName) + ! note I'm not going to write that 4 (old) is an option + end if + + if (p%WrVTK == VTK_ModeShapes .and. .not. p%Linearize) then + call SetErrStat(ErrID_Fatal, 'WrVTK cannot be 3 (mode shapes) when Linearize is false. (Mode shapes require linearization analysis.)', ErrStat, ErrMsg, RoutineName) + end if + end if + + if (p%Linearize) then + if (.not. allocated(p%LinTimes)) then + call SetErrStat(ErrID_Fatal, 'NLinTimes must be at least 1 for linearization analysis.',ErrStat, ErrMsg, RoutineName) + else + do i=1,size(p%LinTimes) + if (p%LinTimes(i) < 0) call SetErrStat(ErrID_Fatal,'LinTimes must be positive values.',ErrStat, ErrMsg, RoutineName) + end do + do i=2,size(p%LinTimes) + if (p%LinTimes(i) <= p%LinTimes(i-1)) call SetErrStat(ErrID_Fatal,'LinTimes must be unique values entered in increasing order.',ErrStat, ErrMsg, RoutineName) + end do + end if if (p%Linearize) then @@ -2149,7 +2165,6 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, OverrideAbortErrLev, ErrStat, Err ! Local variables: REAL(DbKi) :: TmpRate ! temporary variable to read VTK_fps before converting to #steps based on DT - REAL(DbKi) :: VTK_fps ! temporary variable to read VTK_fps before converting to #steps based on DT REAL(DbKi) :: TmpTime ! temporary variable to read SttsTime and ChkptTime before converting to #steps based on DT INTEGER(IntKi) :: I ! loop counter INTEGER(IntKi) :: UnIn ! Unit number for reading file @@ -2762,7 +2777,7 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, OverrideAbortErrLev, ErrStat, Err end if ! LinTimes - Times to linearize (s) [1 to NLinTimes] - if (NLinTimes >= 1) then + if (p%Linearize .and. NLinTimes >= 1) then call AllocAry( p%LinTimes, NLinTimes, 'p%LinTimes', ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat < AbortErrLev) then @@ -2817,15 +2832,15 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, OverrideAbortErrLev, ErrStat, Err RETURN end if - ! WrVTK - VTK Visualization data output: (switch) {0=none; 1=initialization data only; 2=animation}: - CALL ReadVar( UnIn, InputFile, p%WrVTK, "WrVTK", "Write VTK visualization files (0=none; 1=initialization data only; 2=animation)", ErrStat2, ErrMsg2, UnEc) + ! WrVTK - VTK Visualization data output: (switch) {0=none; 1=initialization data only; 2=animation; 3=mode shapes}: + CALL ReadVar( UnIn, InputFile, p%WrVTK, "WrVTK", "Write VTK visualization files (0=none; 1=initialization data only; 2=animation; 3=mode shapes)", ErrStat2, ErrMsg2, UnEc) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if ( ErrStat >= AbortErrLev ) then call cleanup() RETURN end if - IF ( p%WrVTK < 0 .OR. p%WrVTK > 2 ) THEN + IF ( p%WrVTK < 0 .OR. p%WrVTK > 3 ) THEN p%WrVTK = VTK_Unknown END IF @@ -2866,7 +2881,7 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, OverrideAbortErrLev, ErrStat, Err end if ! VTK_fps - Frame rate for VTK output (frames per second) {will use closest integer multiple of DT} - CALL ReadVar( UnIn, InputFile, VTK_fps, "VTK_fps", "Frame rate for VTK output(fps)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InputFile, p%VTK_fps, "VTK_fps", "Frame rate for VTK output(fps)", ErrStat2, ErrMsg2, UnEc) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if ( ErrStat >= AbortErrLev ) then call cleanup() @@ -2875,19 +2890,21 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, OverrideAbortErrLev, ErrStat, Err ! convert frames-per-second to seconds per sample: - if ( EqualRealNos(VTK_fps, 0.0_DbKi) ) then + if ( EqualRealNos(p%VTK_fps, 0.0_DbKi) ) then TmpTime = p%TMax + p%DT else - TmpTime = 1.0_DbKi / VTK_fps + TmpTime = 1.0_DbKi / p%VTK_fps end if ! now save the number of time steps between VTK file output: - IF (TmpTime > p%TMax) THEN + IF (p%WrVTK == VTK_ModeShapes) THEN + p%n_VTKTime = 1 + ELSE IF (TmpTime > p%TMax) THEN p%n_VTKTime = HUGE(p%n_VTKTime) ELSE p%n_VTKTime = NINT( TmpTime / p%DT ) ! I'll warn if p%n_VTKTime*p%DT is not TmpTime - IF (p%WrVTK > VTK_None) THEN + IF (p%WrVTK == VTK_Animate) THEN TmpRate = p%n_VTKTime*p%DT if (.not. EqualRealNos(TmpRate, TmpTime)) then call SetErrStat(ErrID_Info, '1/VTK_fps is not an integer multiple of DT. FAST will output VTK information at '//& From c6c40cb4d43de6312062b833a22d9c206118eeb9 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Fri, 19 Jul 2019 10:13:29 -0600 Subject: [PATCH 02/72] update formatting and removed unnecessary variables in HD --- modules/hydrodyn/src/HydroDyn.f90 | 8 ++------ modules/hydrodyn/src/HydroDyn.txt | 1 - modules/hydrodyn/src/SS_Radiation.f90 | 2 +- 3 files changed, 3 insertions(+), 8 deletions(-) diff --git a/modules/hydrodyn/src/HydroDyn.f90 b/modules/hydrodyn/src/HydroDyn.f90 index 6fcf23a1b4..9f1b60fb8e 100644 --- a/modules/hydrodyn/src/HydroDyn.f90 +++ b/modules/hydrodyn/src/HydroDyn.f90 @@ -2158,7 +2158,7 @@ SUBROUTINE CheckError(ErrID,Msg) CHARACTER(*), INTENT(IN) :: Msg ! The error message (ErrMsg) INTEGER(IntKi) :: ErrStat3 ! The error identifier (ErrStat) - CHARACTER(1024) :: ErrMsg3 ! The error message (ErrMsg) + CHARACTER(ErrMsgLen) :: ErrMsg3 ! The error message (ErrMsg) !............................................................................................................................ ! Set error status/message; @@ -2229,7 +2229,6 @@ SUBROUTINE HD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ErrStat = ErrID_None ErrMsg = '' - m%IgnoreMod = .true. ! to compute perturbations, we need to ignore the modulo function ! LIN_TODO: We need to deal with the case where either RdtnMod=0, and/or ExtcnMod=0 and hence %SS_Rdtn data or %SS_Exctn data is not valid NN = p%WAMIT%SS_Rdtn%N + p%WAMIT%SS_Exctn%N @@ -2365,7 +2364,6 @@ subroutine cleanup() call HydroDyn_DestroyContState( x_p, ErrStat2, ErrMsg2 ) call HydroDyn_DestroyContState( x_m, ErrStat2, ErrMsg2 ) call HydroDyn_DestroyInput( u_perturb, ErrStat2, ErrMsg2 ) - m%IgnoreMod = .false. end subroutine cleanup END SUBROUTINE HD_JacobianPInput @@ -2416,7 +2414,6 @@ SUBROUTINE HD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrStat = ErrID_None ErrMsg = '' - m%IgnoreMod = .true. ! to get true perturbations, we can't use the modulo function ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: @@ -2540,7 +2537,6 @@ subroutine cleanup() call HydroDyn_DestroyContState( x_p, ErrStat2, ErrMsg2 ) call HydroDyn_DestroyContState( x_m, ErrStat2, ErrMsg2 ) call HydroDyn_DestroyContState(x_perturb, ErrStat2, ErrMsg2 ) - m%IgnoreMod = .false. end subroutine cleanup END SUBROUTINE HD_JacobianPContState @@ -3158,7 +3154,7 @@ SUBROUTINE HD_Perturb_x( p, n, perturb_sign, x, dx ) x%WAMIT%SS_Exctn%x( indx ) = x%WAMIT%SS_Exctn%x( indx ) + dx * perturb_sign end if - END SUBROUTINE HD_Perturb_x +END SUBROUTINE HD_Perturb_x !---------------------------------------------------------------------------------------------------------------------------------- !> This routine uses values of two output types to compute an array of differences. diff --git a/modules/hydrodyn/src/HydroDyn.txt b/modules/hydrodyn/src/HydroDyn.txt index 7d49e6d159..cf27a46f56 100644 --- a/modules/hydrodyn/src/HydroDyn.txt +++ b/modules/hydrodyn/src/HydroDyn.txt @@ -154,7 +154,6 @@ typedef ^ ^ Morison_Mis typedef ^ ^ WAMIT_InputType u_WAMIT - - - "WAMIT module inputs" - typedef ^ ^ WAMIT2_InputType u_WAMIT2 - - - "WAMIT2 module inputs" - typedef ^ ^ Waves2_InputType u_Waves2 - - - "Waves2 module inputs" - -typedef ^ ^ 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: diff --git a/modules/hydrodyn/src/SS_Radiation.f90 b/modules/hydrodyn/src/SS_Radiation.f90 index 4a2525d1a1..62a9b873d1 100644 --- a/modules/hydrodyn/src/SS_Radiation.f90 +++ b/modules/hydrodyn/src/SS_Radiation.f90 @@ -552,7 +552,7 @@ END SUBROUTINE SS_Rad_CalcConstrStateResidual !! !! For details, see: !! Press, W. H.; Flannery, B. P.; Teukolsky, S. A.; and Vetterling, W. T. "Runge-Kutta Method" and "Adaptive Step Size Control for -!! Runge-Kutta." �16.1 and 16.2 in Numerical Recipes in FORTRAN: The Art of Scientific Computing, 2nd ed. Cambridge, England: +!! Runge-Kutta."Sections 16.1 and 16.2 in Numerical Recipes in FORTRAN: The Art of Scientific Computing, 2nd ed. Cambridge, England: !! Cambridge University Press, pp. 704-716, 1992. !! SUBROUTINE SS_Rad_RK4( t, n, u, utimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) From 15deec07735802efd308251e493d1667ce0e5920 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Fri, 19 Jul 2019 10:22:43 -0600 Subject: [PATCH 03/72] Registry updates (+ corresponding change in NWTC Library) - updated C2F copy routines to allow for skipping the pointers (in case of module initially defining the pointers in Fortran code in instead of C/C++ code) - updated pack/unpack routines to avoid putting entire arrays on the stack (https://github.com/OpenFAST/openfast/issues/99) - updated extrap/interp routines to account for values that have a period of 2pi. This change requires additional routines in NWTC_Num.f90. - this also includes changes that were introduces in a not-yet-merged pull request for 2D airfoil interpolation --- modules/nwtc-library/src/NWTC_Num.f90 | 505 ++++++++++- modules/openfast-registry/src/Makefile | 67 -- modules/openfast-registry/src/data.h | 2 +- modules/openfast-registry/src/gen_c_types.c | 7 +- .../openfast-registry/src/gen_module_files.c | 843 +++++++++--------- modules/openfast-registry/src/reg_parse.c | 31 +- modules/openfast-registry/src/registry.h | 6 +- 7 files changed, 894 insertions(+), 567 deletions(-) delete mode 100644 modules/openfast-registry/src/Makefile diff --git a/modules/nwtc-library/src/NWTC_Num.f90 b/modules/nwtc-library/src/NWTC_Num.f90 index 836fc56e4f..14653edcb5 100644 --- a/modules/nwtc-library/src/NWTC_Num.f90 +++ b/modules/nwtc-library/src/NWTC_Num.f90 @@ -55,6 +55,10 @@ MODULE NWTC_Num REAL(ReKi) :: TwoByPi !< 2/Pi REAL(ReKi) :: TwoPi !< 2*Pi + REAL(SiKi) :: Pi_R4 !< Ratio of a circle's circumference to its diameter in 4-byte precision + REAL(R8Ki) :: Pi_R8 !< Ratio of a circle's circumference to its diameter in 8-byte precision + REAL(QuKi) :: Pi_R16 !< Ratio of a circle's circumference to its diameter in 16-byte precision + !======================================================================= ! Create interfaces for generic routines that use specific routines. @@ -109,10 +113,11 @@ MODULE NWTC_Num MODULE PROCEDURE GetSmllRotAngsR END INTERFACE - !> \copydoc nwtc_num::zero2twopir + !> \copydoc nwtc_num::zero2twopir4 INTERFACE Zero2TwoPi - MODULE PROCEDURE Zero2TwoPiD - MODULE PROCEDURE Zero2TwoPiR + MODULE PROCEDURE Zero2TwoPiR4 + MODULE PROCEDURE Zero2TwoPiR8 + MODULE PROCEDURE Zero2TwoPiR16 END INTERFACE !> \copydoc nwtc_num::twonormr4 @@ -194,57 +199,123 @@ MODULE NWTC_Num MODULE PROCEDURE SkewSymMatR16 END INTERFACE + !> \copydoc nwtc_num::angle_extrapinterp2_r4 + INTERFACE Angles_ExtrapInterp + MODULE PROCEDURE Angles_ExtrapInterp1_R4 + MODULE PROCEDURE Angles_ExtrapInterp1_R8 + MODULE PROCEDURE Angles_ExtrapInterp1_R16 + MODULE PROCEDURE Angles_ExtrapInterp2_R4 + MODULE PROCEDURE Angles_ExtrapInterp2_R8 + MODULE PROCEDURE Angles_ExtrapInterp2_R16 + END INTERFACE + !> \copydoc nwtc_num::addorsub2pi_r4 + INTERFACE AddOrSub2Pi + MODULE PROCEDURE AddOrSub2Pi_R4 + MODULE PROCEDURE AddOrSub2Pi_R8 + MODULE PROCEDURE AddOrSub2Pi_R16 + END INTERFACE CONTAINS !======================================================================= -!> This routine is used to convert NewAngle to an angle within 2*Pi of -!! OldAngle by adding or subtracting 2*Pi accordingly; it then sets -!! OldAngle equal to NewAngle. This routine is useful for converting +!> This routine is used to convert NewAngle to an angle within Pi of +!! OldAngle by adding or subtracting 2*Pi accordingly. +!! This routine is useful for converting !! angles returned from a call to the ATAN2() FUNCTION into angles that may !! exceed the -Pi to Pi limit of ATAN2(). For example, if the nacelle yaw !! angle was 179deg in the previous time step and the yaw angle increased !! by 2deg in the new time step, we want the new yaw angle returned from a !! call to the ATAN2() FUNCTION to be 181deg instead of -179deg. This !! routine assumes that the angle change between calls is not more than -!! 2*Pi in absolute value. OldAngle should be saved in the calling -!! routine. - SUBROUTINE AddOrSub2Pi ( OldAngle, NewAngle ) +!! Pi in absolute value. +!! Use AddOrSub2Pi (nwtc_num::addorsub2pi) instead of directly calling a specific routine in the generic interface. + SUBROUTINE AddOrSub2Pi_R4 ( OldAngle, NewAngle ) + ! Argument declarations: + + REAL(SiKi), INTENT(IN ) :: OldAngle !< Angle from which NewAngle will be converted to within Pi of, rad. + REAL(SiKi), INTENT(INOUT) :: NewAngle !< Angle to be converted to within 2*Pi of OldAngle, rad. + + + ! Local declarations: + + REAL(SiKi) :: DelAngle ! The difference between OldAngle and NewAngle, rad. + + + + ! Add or subtract 2*Pi in order to convert NewAngle two within Pi of OldAngle: + + + DelAngle = OldAngle - NewAngle + + DO WHILE ( ABS( DelAngle ) >= Pi_R4 ) + + NewAngle = NewAngle + Pi_R4 * SIGN( 2.0_SiKi, DelAngle ) + DelAngle = OldAngle - NewAngle + + END DO + + RETURN + END SUBROUTINE AddOrSub2Pi_R4 +!======================================================================= +!> \copydoc nwtc_num::addorsub2pi_r4 + SUBROUTINE AddOrSub2Pi_R8 ( OldAngle, NewAngle ) ! Argument declarations: - REAL(ReKi), INTENT(INOUT) :: OldAngle !< Angle from which NewAngle will be converted to within 2*Pi of, rad. - REAL(ReKi), INTENT(INOUT) :: NewAngle !< Angle to be converted to within 2*Pi of OldAngle, rad. + REAL(R8Ki), INTENT(IN ) :: OldAngle ! Angle from which NewAngle will be converted to within Pi of, rad. + REAL(R8Ki), INTENT(INOUT) :: NewAngle ! Angle to be converted to within Pi of OldAngle, rad. ! Local declarations: - REAL(ReKi) :: DelAngle ! The difference between OldAngle and NewAngle, rad. + REAL(R8Ki) :: DelAngle ! The difference between OldAngle and NewAngle, rad. - ! Add or subtract 2*Pi in order to convert NewAngle two within 2*Pi of - ! OldAngle: + ! Add or subtract 2*Pi in order to convert NewAngle two within Pi of OldAngle: DelAngle = OldAngle - NewAngle - DO WHILE ( ABS( DelAngle ) >= TwoPi ) + DO WHILE ( ABS( DelAngle ) >= Pi_R8 ) - NewAngle = NewAngle + SIGN( TwoPi, DelAngle ) + NewAngle = NewAngle + Pi_R8 * SIGN( 2.0_R8Ki, DelAngle ) DelAngle = OldAngle - NewAngle END DO + RETURN + END SUBROUTINE AddOrSub2Pi_R8 +!======================================================================= +!> \copydoc nwtc_num::addorsub2pi_r4 + SUBROUTINE AddOrSub2Pi_R16 ( OldAngle, NewAngle ) - ! Set OldAngle to equal NewAngle: + ! Argument declarations: - OldAngle = NewAngle + REAL(QuKi), INTENT(IN ) :: OldAngle ! Angle from which NewAngle will be converted to within 2*Pi of, rad. + REAL(QuKi), INTENT(INOUT) :: NewAngle ! Angle to be converted to within 2*Pi of OldAngle, rad. + + + ! Local declarations: + REAL(QuKi) :: DelAngle ! The difference between OldAngle and NewAngle, rad. + + ! Add or subtract 2*Pi in order to convert NewAngle two within Pi of OldAngle: + + + DelAngle = OldAngle - NewAngle + + DO WHILE ( ABS( DelAngle ) >= Pi_R16 ) + + NewAngle = NewAngle + Pi_R16 * SIGN( 2.0_QuKi, DelAngle ) + DelAngle = OldAngle - NewAngle + + END DO + RETURN - END SUBROUTINE AddOrSub2Pi + END SUBROUTINE AddOrSub2Pi_R16 !======================================================================= !> This routine sorts a list of real numbers. It uses the bubble sort algorithm, !! which is only suitable for short lists. @@ -4066,7 +4137,7 @@ END FUNCTION OuterProductR16 !! a change in log map parameters. SUBROUTINE PerturbOrientationMatrix( Orientation, Perturbation, AngleDim ) REAL(R8Ki), INTENT(INOUT) :: Orientation(3,3) - REAL(R8Ki), INTENT(IN) :: Perturbation + REAL(R8Ki), INTENT(IN) :: Perturbation ! angle (radians) of the perturbation INTEGER, INTENT(IN) :: AngleDim ! Local variables @@ -4975,8 +5046,8 @@ FUNCTION GetClockTime(StartClockTime, EndClockTime) ! return the number of seconds between StartClockTime and EndClockTime REAL :: GetClockTime ! Elapsed clock time for the simulation phase of the run. - INTEGER , INTENT(IN) :: StartClockTime (8) ! Start time of simulation (after initialization) - INTEGER , INTENT(IN) :: EndClockTime (8) ! Start time of simulation (after initialization) + INTEGER , INTENT(IN) :: StartClockTime (8) ! Start time of simulation (after initialization) + INTEGER , INTENT(IN) :: EndClockTime (8) ! Start time of simulation (after initialization) !bjj: This calculation will be wrong at certain times (e.g. if it's near midnight on the last day of the month), but to my knowledge, no one has complained... GetClockTime = 0.001*( EndClockTime(8) - StartClockTime(8) ) & ! Is the milliseconds of the second (range 0 to 999) - local time @@ -5054,6 +5125,9 @@ SUBROUTINE SetConstants( ) TwoPi = 2.0_ReKi*Pi Inv2Pi = 0.5_ReKi/Pi ! 1.0/TwoPi + Pi_R4 = ACOS( -1.0_SiKi ) + Pi_R8 = ACOS( -1.0_R8Ki ) + Pi_R16 = ACOS( -1.0_QuKi ) ! IEEE constants: CALL Set_IEEE_Constants( NaN_D, Inf_D, NaN, Inf ) @@ -5193,7 +5267,7 @@ SUBROUTINE SimStatus( PrevSimTime, PrevClockTime, ZTime, TMax, DescStrIn ) PrevSimTime = ZTime RETURN - END SUBROUTINE SimStatus + END SUBROUTINE SimStatus !======================================================================= !> This routine computes the 3x3 transformation matrix, \f$TransMat\f$, !! to a coordinate system \f$x\f$ (with orthogonal axes \f$x_1, x_2, x_3\f$) @@ -5620,7 +5694,12 @@ SUBROUTINE SortUnion ( Ary1, N1, Ary2, N2, Ary, N ) END SUBROUTINE SortUnion ! ( Ary1, N1, Ary2, N2, Ary, N ) !======================================================================= !> This routine calculates the standard deviation of a population contained in Ary. - FUNCTION StdDevFn ( Ary, AryLen, Mean ) +!! +!! This can be calculated as either\n +!! \f$ \sqrt{ \frac{\sum_{i=1}^N \left(x_i -\bar{x}\right)^2 }{N-1} } \f$ \n +!! or \n +!! \f$ \sqrt{ \frac{\sum_{i=1}^N \left(x_i -\bar{x}\right)^2 }{N} } \f$ if `UseN` is true \n + FUNCTION StdDevFn ( Ary, AryLen, Mean, UseN ) ! Function declaration. @@ -5633,6 +5712,7 @@ FUNCTION StdDevFn ( Ary, AryLen, Mean ) REAL(ReKi), INTENT(IN) :: Ary (AryLen) !< Input array. REAL(ReKi), INTENT(IN) :: Mean !< The previously calculated mean of the array. + LOGICAL, OPTIONAL, INTENT(IN) :: UseN !< Use `N` insted of `N-1` in denomenator ! Local declarations. @@ -5640,8 +5720,17 @@ FUNCTION StdDevFn ( Ary, AryLen, Mean ) REAL(DbKi) :: Sum ! A temporary sum. INTEGER :: I ! The index into the array. + INTEGER :: Denom ! Denominator - + IF(PRESENT(UseN)) THEN + IF (UseN) THEN + Denom = AryLen + ELSE + Denom = AryLen-1 + ENDIF + ELSE + Denom = AryLen-1 + ENDIF Sum = 0.0_DbKi @@ -5649,7 +5738,7 @@ FUNCTION StdDevFn ( Ary, AryLen, Mean ) Sum = Sum + ( Ary(I) - Mean )**2 END DO ! I - StdDevFn = SQRT( Sum/( AryLen - 1 ) ) + StdDevFn = SQRT( Sum/( Denom ) ) RETURN @@ -5733,6 +5822,7 @@ FUNCTION SkewSymMatR16 ( x ) RESULT(M) RETURN END FUNCTION SkewSymMatR16 + !======================================================================= !> This routine takes an array of time values such as that returned from !! CALL DATE_AND_TIME ( Values=TimeAry ) @@ -5858,30 +5948,30 @@ FUNCTION TwoNormR16(v) !> This routine is used to convert Angle to an equivalent value !! in the range \f$[0, 2\pi)\f$. \n !! Use Zero2TwoPi (nwtc_num::zero2twopi) instead of directly calling a specific routine in the generic interface. - SUBROUTINE Zero2TwoPiR ( Angle ) + SUBROUTINE Zero2TwoPiR4 ( Angle ) ! Argument declarations: - REAL(ReKi), INTENT(INOUT) :: Angle !< angle that is input and converted to equivalent in range \f$[0, 2\pi)\f$ + REAL(SiKi), INTENT(INOUT) :: Angle !< angle that is input and converted to equivalent in range \f$[0, 2\pi)\f$ ! Get the angle between 0 and 2Pi. - Angle = MODULO( Angle, TwoPi ) + Angle = MODULO( Angle, 2.0_SiKi * Pi_R4 ) ! Check numerical case where Angle == 2Pi. - IF ( Angle == TwoPi ) THEN + IF ( Angle == 2.0_SiKi * Pi_R4 ) THEN Angle = 0.0_ReKi END IF RETURN - END SUBROUTINE Zero2TwoPiR + END SUBROUTINE Zero2TwoPiR4 !======================================================================= -!> \copydoc nwtc_num::zero2twopir - SUBROUTINE Zero2TwoPiD ( Angle ) +!> \copydoc nwtc_num::zero2twopir4 + SUBROUTINE Zero2TwoPiR8 ( Angle ) ! This routine is used to convert Angle to an equivalent value ! in the range [0, 2*pi). @@ -5889,23 +5979,364 @@ SUBROUTINE Zero2TwoPiD ( Angle ) ! Argument declarations: - REAL(DbKi), INTENT(INOUT) :: Angle + REAL(R8Ki), INTENT(INOUT) :: Angle ! Get the angle between 0 and 2Pi. - Angle = MODULO( Angle, TwoPi_D ) + Angle = MODULO( Angle, 2.0_R8Ki * Pi_R8 ) ! Check numerical case where Angle == 2Pi. - IF ( Angle == TwoPi_D ) THEN + IF ( Angle == 2.0_R8Ki * Pi_R8 ) THEN Angle = 0.0_DbKi END IF RETURN - END SUBROUTINE Zero2TwoPiD + END SUBROUTINE Zero2TwoPiR8 +!======================================================================= +!> \copydoc nwtc_num::zero2twopir4 + SUBROUTINE Zero2TwoPiR16 ( Angle ) + + ! This routine is used to convert Angle to an equivalent value + ! in the range [0, 2*pi). + + + ! Argument declarations: + + REAL(QuKi), INTENT(INOUT) :: Angle + + + + ! Get the angle between 0 and 2Pi. + + Angle = MODULO( Angle, 2.0_QuKi * Pi_R16 ) + + + ! Check numerical case where Angle == 2Pi. + + IF ( Angle == 2.0_QuKi * Pi_R16 ) THEN + Angle = 0.0_DbKi + END IF + + + RETURN + END SUBROUTINE Zero2TwoPiR16 +!======================================================================= + !< This routine extrapolates or interpolates between angles + SUBROUTINE Angles_ExtrapInterp1_R4(Angle1, Angle2, tin, Angle_out, tin_out ) + REAL(SiKi), INTENT(IN ) :: Angle1 !< Angle at t1 > t2 + REAL(SiKi), INTENT(IN ) :: Angle2 !< Angle at t2 + REAL(DbKi), INTENT(IN ) :: tin(:) !< Times associated with the inputs + REAL(SiKi), INTENT(INOUT) :: Angle_out !< Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out !< time to be extrap/interp'd to + + ! local variables + INTEGER(IntKi), parameter :: order = 1 ! order of polynomial fit (max 2) + REAL(DbKi) :: t(SIZE(tin)) ! Times associated with the inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + + REAL(DbKi) :: scaleFactor ! temporary for extrapolation/interpolation + REAL(SiKi) :: Angle2_mod + + ! 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) + + ! ! some error checking: + ! + ! if ( size(t) .ne. order+1) then + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp1: size(t) must equal 2.' + ! RETURN + ! end if + ! + !IF ( EqualRealNos( t(1), t(2) ) ) THEN + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp1: t(1) must not equal t(2) to avoid a division-by-zero error.' + ! RETURN + !END IF + + Angle2_mod = Angle2 + call AddOrSub2Pi( Angle1, Angle2_mod ) + + Angle_out = Angle1 + (Angle2_mod - Angle1) * t_out / t(2) + call Zero2TwoPi(Angle_out) + + END SUBROUTINE Angles_ExtrapInterp1_R4 +!======================================================================= + !< This routine extrapolates or interpolates between angles + SUBROUTINE Angles_ExtrapInterp1_R8(Angle1, Angle2, tin, Angle_out, tin_out) + REAL(R8Ki), INTENT(IN ) :: Angle1 !< Angle at t1 > t2 + REAL(R8Ki), INTENT(IN ) :: Angle2 !< Angle at t2 + REAL(DbKi), INTENT(IN ) :: tin(:) !< Times associated with the inputs + REAL(R8Ki), INTENT(INOUT) :: Angle_out !< Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out !< time to be extrap/interp'd to + + ! local variables + INTEGER(IntKi), parameter :: order = 1 ! order of polynomial fit (max 2) + REAL(DbKi) :: t(SIZE(tin)) ! Times associated with the inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + + REAL(DbKi) :: scaleFactor ! temporary for extrapolation/interpolation + REAL(R8Ki) :: Angle2_mod + + ! 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) + + ! ! some error checking: + ! + ! if ( size(t) .ne. order+1) then + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp1: size(t) must equal 2.' + ! RETURN + ! end if + ! + !IF ( EqualRealNos( t(1), t(2) ) ) THEN + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp1: t(1) must not equal t(2) to avoid a division-by-zero error.' + ! RETURN + !END IF + + Angle2_mod = Angle2 + call AddOrSub2Pi( Angle1, Angle2_mod ) + + Angle_out = Angle1 + (Angle2_mod - Angle1) * t_out / t(2) + call Zero2TwoPi(Angle_out) + + END SUBROUTINE Angles_ExtrapInterp1_R8 +!======================================================================= + !< This routine extrapolates or interpolates between angles + SUBROUTINE Angles_ExtrapInterp1_R16(Angle1, Angle2, tin, Angle_out, tin_out) + REAL(QuKi), INTENT(IN ) :: Angle1 !< Angle at t1 > t2 + REAL(QuKi), INTENT(IN ) :: Angle2 !< Angle at t2 + REAL(DbKi), INTENT(IN ) :: tin(:) !< Times associated with the inputs + REAL(QuKi), INTENT(INOUT) :: Angle_out !< Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out !< time to be extrap/interp'd to + + ! local variables + INTEGER(IntKi), parameter :: order = 1 ! order of polynomial fit (max 2) + REAL(DbKi) :: t(SIZE(tin)) ! Times associated with the inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + + REAL(DbKi) :: scaleFactor ! temporary for extrapolation/interpolation + REAL(QuKi) :: Angle2_mod + + ! 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) + + ! ! some error checking: + ! + ! if ( size(t) .ne. order+1) then + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp1: size(t) must equal 2.' + ! RETURN + ! end if + ! + !IF ( EqualRealNos( t(1), t(2) ) ) THEN + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp1: t(1) must not equal t(2) to avoid a division-by-zero error.' + ! RETURN + !END IF + + Angle2_mod = Angle2 + call AddOrSub2Pi( Angle1, Angle2_mod ) + + Angle_out = Angle1 + (Angle2_mod - Angle1) * t_out / t(2) + call Zero2TwoPi(Angle_out) + + END SUBROUTINE Angles_ExtrapInterp1_R16 +!======================================================================= + !< This routine extrapolates or interpolates between angles + SUBROUTINE Angles_ExtrapInterp2_R4(Angle1, Angle2, Angle3, tin, Angle_out, tin_out ) + REAL(SiKi), INTENT(IN ) :: Angle1 !< Angle at t1 > t2 > t3 + REAL(SiKi), INTENT(IN ) :: Angle2 !< Angle at t2 > t3 + REAL(SiKi), INTENT(IN ) :: Angle3 !< Angle at t3 + REAL(DbKi), INTENT(IN ) :: tin(:) !< Times associated with the inputs + REAL(SiKi), INTENT(INOUT) :: Angle_out !< Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out !< time to be extrap/interp'd to + + ! local variables + INTEGER(IntKi), parameter :: order = 2 ! order of polynomial fit (max 2) + REAL(DbKi) :: t(SIZE(tin)) ! Times associated with the inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + + REAL(DbKi) :: scaleFactor ! temporary for extrapolation/interpolation + REAL(SiKi) :: Angle2_mod + REAL(SiKi) :: Angle3_mod + + ! 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) + + ! ! some error checking: + ! + !if ( size(t) .ne. order+1) then + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp2: size(t) must equal 3.' + ! RETURN + !end if + ! + !IF ( EqualRealNos( t(1), t(2) ) ) THEN + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp2: t(1) must not equal t(2) to avoid a division-by-zero error.' + ! RETURN + !END IF + !IF ( EqualRealNos( t(2), t(3) ) ) THEN + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp2: t(2) must not equal t(3) to avoid a division-by-zero error.' + ! RETURN + !END IF + !IF ( EqualRealNos( t(1), t(3) ) ) THEN + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp2: t(1) must not equal t(3) to avoid a division-by-zero error.' + ! RETURN + !END IF + + Angle2_mod = Angle2 + Angle3_mod = Angle3 + call AddOrSub2Pi( Angle1, Angle2_mod ) + call AddOrSub2Pi( Angle2_mod, Angle3_mod ) + + scaleFactor = t_out / ( t(2) * t(3) * (t(2) - t(3)) ) + + Angle_out = Angle1 & + + ( t(3)**2 * (Angle1 - Angle2_mod) + t(2)**2*(-Angle1 + Angle3_mod) ) * scaleFactor & + + ( (t(2)-t(3))*Angle1 + t(3)*Angle2_mod - t(2)*Angle3_mod ) *scaleFactor * t_out + + call Zero2TwoPi(Angle_out) + + END SUBROUTINE Angles_ExtrapInterp2_R4 +!======================================================================= + !< This routine extrapolates or interpolates between angles + SUBROUTINE Angles_ExtrapInterp2_R8(Angle1, Angle2, Angle3, tin, Angle_out, tin_out) + REAL(R8Ki), INTENT(IN ) :: Angle1 !< Angle at t1 > t2 > t3 + REAL(R8Ki), INTENT(IN ) :: Angle2 !< Angle at t2 > t3 + REAL(R8Ki), INTENT(IN ) :: Angle3 !< Angle at t3 + REAL(DbKi), INTENT(IN ) :: tin(:) !< Times associated with the inputs + REAL(R8Ki), INTENT(INOUT) :: Angle_out !< Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out !< time to be extrap/interp'd to + + ! local variables + INTEGER(IntKi), parameter :: order = 2 ! order of polynomial fit (max 2) + REAL(DbKi) :: t(SIZE(tin)) ! Times associated with the inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + + REAL(DbKi) :: scaleFactor ! temporary for extrapolation/interpolation + REAL(R8Ki) :: Angle2_mod + REAL(R8Ki) :: Angle3_mod + + ! 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) + + ! some error checking: + + !if ( size(t) .ne. order+1) then + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp2: size(t) must equal 3.' + ! RETURN + !end if + ! + !IF ( EqualRealNos( t(1), t(2) ) ) THEN + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp2: t(1) must not equal t(2) to avoid a division-by-zero error.' + ! RETURN + !END IF + !IF ( EqualRealNos( t(2), t(3) ) ) THEN + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp2: t(2) must not equal t(3) to avoid a division-by-zero error.' + ! RETURN + !END IF + !IF ( EqualRealNos( t(1), t(3) ) ) THEN + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp2: t(1) must not equal t(3) to avoid a division-by-zero error.' + ! RETURN + !END IF + + Angle2_mod = Angle2 + Angle3_mod = Angle3 + call AddOrSub2Pi( Angle1, Angle2_mod ) + call AddOrSub2Pi( Angle2_mod, Angle3_mod ) + + scaleFactor = t_out / ( t(2) * t(3) * (t(2) - t(3)) ) + + Angle_out = Angle1 & + + ( t(3)**2 * (Angle1 - Angle2_mod) + t(2)**2*(-Angle1 + Angle3_mod) ) * scaleFactor & + + ( (t(2)-t(3))*Angle1 + t(3)*Angle2_mod - t(2)*Angle3_mod ) *scaleFactor * t_out + call Zero2TwoPi(Angle_out) + + END SUBROUTINE Angles_ExtrapInterp2_R8 +!======================================================================= + !< This routine extrapolates or interpolates between angles + SUBROUTINE Angles_ExtrapInterp2_R16(Angle1, Angle2, Angle3, tin, Angle_out, tin_out ) + REAL(QuKi), INTENT(IN ) :: Angle1 !< Angle at t1 > t2 > t3 + REAL(QuKi), INTENT(IN ) :: Angle2 !< Angle at t2 > t3 + REAL(QuKi), INTENT(IN ) :: Angle3 !< Angle at t3 + REAL(DbKi), INTENT(IN ) :: tin(:) !< Times associated with the inputs + REAL(QuKi), INTENT(INOUT) :: Angle_out !< Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out !< time to be extrap/interp'd to + + ! local variables + INTEGER(IntKi), parameter :: order = 2 ! order of polynomial fit (max 2) + REAL(DbKi) :: t(SIZE(tin)) ! Times associated with the inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + + REAL(DbKi) :: scaleFactor ! temporary for extrapolation/interpolation + REAL(QuKi) :: Angle2_mod + REAL(QuKi) :: Angle3_mod + + ! 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) + + ! some error checking: + + !if ( size(t) .ne. order+1) then + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp2: size(t) must equal 3.' + ! RETURN + !end if + ! + !IF ( EqualRealNos( t(1), t(2) ) ) THEN + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp2: t(1) must not equal t(2) to avoid a division-by-zero error.' + ! RETURN + !END IF + !IF ( EqualRealNos( t(2), t(3) ) ) THEN + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp2: t(2) must not equal t(3) to avoid a division-by-zero error.' + ! RETURN + !END IF + !IF ( EqualRealNos( t(1), t(3) ) ) THEN + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp2: t(1) must not equal t(3) to avoid a division-by-zero error.' + ! RETURN + !END IF + + Angle2_mod = Angle2 + Angle3_mod = Angle3 + call AddOrSub2Pi( Angle1, Angle2_mod ) + call AddOrSub2Pi( Angle2_mod, Angle3_mod ) + + scaleFactor = t_out / ( t(2) * t(3) * (t(2) - t(3)) ) + + Angle_out = Angle1 & + + ( t(3)**2 * (Angle1 - Angle2_mod) + t(2)**2*(-Angle1 + Angle3_mod) ) * scaleFactor & + + ( (t(2)-t(3))*Angle1 + t(3)*Angle2_mod - t(2)*Angle3_mod ) *scaleFactor * t_out + call Zero2TwoPi(Angle_out) + + END SUBROUTINE Angles_ExtrapInterp2_R16 !======================================================================= END MODULE NWTC_Num diff --git a/modules/openfast-registry/src/Makefile b/modules/openfast-registry/src/Makefile deleted file mode 100644 index 921149cd0e..0000000000 --- a/modules/openfast-registry/src/Makefile +++ /dev/null @@ -1,67 +0,0 @@ -ifeq ($(OS),Windows_NT) - ifeq ($(OSTYPE),cygwin) - RM=rm -f - else - RM=del - endif -else - RM = rm -f -endif -.SUFFIXES: .c .o - -# i586-mingw32msvc-gcc -#CC_TOOLS = i586-mingw32msvc-gcc -CC_TOOLS = gcc -DEST_DIR = .. -CFLAGS = #-ansi -LDFLAGS = -DEBUG = -g -OBJ = registry.o \ - my_strtok.o \ - reg_parse.o \ - data.o \ - type.o \ - misc.o \ - sym.o \ - symtab_gen.o \ - gen_module_files.o \ - gen_c_types.o - -# marco's: all : $(OBJ) -$(DEST_DIR)/registry.exe : $(OBJ) - $(CC_TOOLS) -o $(DEST_DIR)/registry.exe $(DEBUG) $(LDFLAGS) $(OBJ) - -.c.o : - $(CC_TOOLS) $(CFLAGS) -c $(DEBUG) $< - -clean clena: - $(RM) $(OBJ) gen_comms.c standard.o - -superclean : clean - $(RM) $(DEST_DIR)/registry.exe Registry_tmp.* - -# regenerate this list with "makedepend -Y *.c" - -# DO NOT DELETE THIS LINE -- make depend depends on it. - -gen_module_files.o: protos.h registry.h data.h FAST_preamble.h type.o - -data.o: registry.h protos.h data.h -gen_allocs.o: protos.h registry.h data.h -gen_args.o: protos.h registry.h data.h -gen_scalar_derefs.o: protos.h registry.h data.h -gen_config.o: protos.h registry.h data.h -gen_defs.o: protos.h registry.h data.h -gen_mod_state_descr.o: protos.h registry.h data.h -gen_model_data_ord.o: protos.h registry.h data.h -gen_scalar_indices.o: protos.h registry.h data.h -gen_wrf_io.o: protos.h registry.h data.h -misc.o: protos.h registry.h data.h -my_strtok.o: registry.h protos.h data.h -reg_parse.o: registry.h protos.h data.h -registry.o: protos.h registry.h data.h Template_data.c Template_registry.c -sym.o: sym.h -type.o: registry.h protos.h data.h -gen_interp.o: registry.h protos.h data.h -gen_streams.o: registry.h protos.h data.h -gen_c_types.o: registry.h protos.h data.h diff --git a/modules/openfast-registry/src/data.h b/modules/openfast-registry/src/data.h index 80c0101bd9..bc81980c73 100644 --- a/modules/openfast-registry/src/data.h +++ b/modules/openfast-registry/src/data.h @@ -37,7 +37,7 @@ typedef struct node_struct { /* CTRL */ - int gen_wrapper ; + int gen_periodic ; struct node_struct * next ; /* fields used by rconfig nodes */ diff --git a/modules/openfast-registry/src/gen_c_types.c b/modules/openfast-registry/src/gen_c_types.c index 1e329624ce..74bd14d662 100644 --- a/modules/openfast-registry/src/gen_c_types.c +++ b/modules/openfast-registry/src/gen_c_types.c @@ -377,7 +377,10 @@ gen_c_module( FILE * fph, node_t * ModName ) fprintf(fph," %s * %s ; ",C_type( r->type->mapsto), r->name ) ; fprintf(fph," int %s_Len ;",r->name ) ; } else { - char *p = r->type->mapsto, buf[10]; + char *p = r->type->mapsto; + char buf[10]; +// bjj: this assumes all character strings are defined with numeric lengths +// It should be modified to allow use of parameters, too. (and parameters defined in the registry should also be defined in the .h file) while (*p) { if (isdigit(*p)) { long val = strtol(p, &p, 10); @@ -385,6 +388,8 @@ gen_c_module( FILE * fph, node_t * ModName ) } else { p++; } + + } if (strcmp(C_type(r->type->mapsto), "char") == 0 ){ // if it's a char we need to add the array size if (r->ndims == 0) diff --git a/modules/openfast-registry/src/gen_module_files.c b/modules/openfast-registry/src/gen_module_files.c index 8251772bfc..99834f83b5 100644 --- a/modules/openfast-registry/src/gen_module_files.c +++ b/modules/openfast-registry/src/gen_module_files.c @@ -33,13 +33,20 @@ gen_copy_c2f( FILE *fp , // *.f90 file we are writting to remove_nickname(ModName->nickname,inout,nonick) ; append_nickname((is_a_fast_interface_type(inoutlong))?ModName->nickname:"",inoutlong,addnick) ; - fprintf(fp," SUBROUTINE %s_C2Fary_Copy%s( %sData, ErrStat, ErrMsg )\n", ModName->nickname, nonick,nonick ); + fprintf(fp," SUBROUTINE %s_C2Fary_Copy%s( %sData, ErrStat, ErrMsg, SkipPointers )\n", ModName->nickname, nonick,nonick ); fprintf(fp," TYPE(%s), INTENT(INOUT) :: %sData\n" , addnick, nonick ); fprintf(fp," INTEGER(IntKi), INTENT( OUT) :: ErrStat\n" ); fprintf(fp," CHARACTER(*), INTENT( OUT) :: ErrMsg\n" ); + fprintf(fp," LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers\n" ); fprintf(fp," ! \n" ); + fprintf(fp," LOGICAL :: SkipPointers_local\n"); fprintf(fp," ErrStat = ErrID_None\n" ); - fprintf(fp," ErrMsg = \"\"\n" ); + fprintf(fp," ErrMsg = \"\"\n\n" ); + fprintf(fp," IF (PRESENT(SkipPointers)) THEN\n"); + fprintf(fp," SkipPointers_local = SkipPointers\n"); + fprintf(fp," ELSE\n"); + fprintf(fp," SkipPointers_local = .false.\n"); + fprintf(fp," END IF\n"); sprintf(tmp,"%s",addnick) ; @@ -55,11 +62,13 @@ gen_copy_c2f( FILE *fp , // *.f90 file we are writting to } else { if ( is_pointer(r) ) { fprintf(fp,"\n ! -- %s %s Data fields\n",r->name,nonick) ; - fprintf(fp," IF ( .NOT. C_ASSOCIATED( %sData%%C_obj%%%s ) ) THEN\n",nonick,r->name) ; - fprintf(fp," NULLIFY( %sData%%%s )\n",nonick,r->name) ; - fprintf(fp," ELSE\n") ; - fprintf(fp," CALL C_F_POINTER(%sData%%C_obj%%%s, %sData%%%s, (/%sData%%C_obj%%%s_Len/))\n",nonick,r->name,nonick,r->name,nonick,r->name) ; - fprintf(fp," END IF\n") ; + fprintf(fp," IF ( .NOT. SkipPointers_local ) THEN\n"); + fprintf(fp," IF ( .NOT. C_ASSOCIATED( %sData%%C_obj%%%s ) ) THEN\n",nonick,r->name) ; + fprintf(fp," NULLIFY( %sData%%%s )\n",nonick,r->name) ; + fprintf(fp," ELSE\n") ; + fprintf(fp," CALL C_F_POINTER(%sData%%C_obj%%%s, %sData%%%s, (/%sData%%C_obj%%%s_Len/))\n",nonick,r->name,nonick,r->name,nonick,r->name) ; + fprintf(fp," END IF\n") ; + fprintf(fp, " END IF\n"); } else if (!has_deferred_dim(r, 0)) { if (!strcmp(r->type->mapsto, "REAL(ReKi)") || @@ -86,6 +95,87 @@ gen_copy_c2f( FILE *fp , // *.f90 file we are writting to return(0) ; } +int +gen_copy_f2c(FILE *fp, // *.f90 file we are writting to + const node_t *ModName, // module name + char *inout, // character string written out + char *inoutlong) // not sure what this is used for +{ + node_t *q, *r; + char tmp[NAMELEN]; + char addnick[NAMELEN]; + char nonick[NAMELEN]; + + remove_nickname(ModName->nickname, inout, nonick); + append_nickname((is_a_fast_interface_type(inoutlong)) ? ModName->nickname : "", inoutlong, addnick); + fprintf(fp, " SUBROUTINE %s_F2C_Copy%s( %sData, ErrStat, ErrMsg, SkipPointers )\n", ModName->nickname, nonick, nonick); + fprintf(fp, " TYPE(%s), INTENT(INOUT) :: %sData\n", addnick, nonick); + fprintf(fp, " INTEGER(IntKi), INTENT( OUT) :: ErrStat\n"); + fprintf(fp, " CHARACTER(*), INTENT( OUT) :: ErrMsg\n"); + fprintf(fp, " LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers\n"); + fprintf(fp, " ! \n"); + fprintf(fp, " LOGICAL :: SkipPointers_local\n"); + fprintf(fp, " ErrStat = ErrID_None\n"); + fprintf(fp, " ErrMsg = \"\"\n\n"); + fprintf(fp, " IF (PRESENT(SkipPointers)) THEN\n"); + fprintf(fp, " SkipPointers_local = SkipPointers\n"); + fprintf(fp, " ELSE\n"); + fprintf(fp, " SkipPointers_local = .false.\n"); + fprintf(fp, " END IF\n"); + + sprintf(tmp, "%s", addnick); + + if ((q = get_entry(make_lower_temp(tmp), ModName->module_ddt_list)) == NULL) + { + fprintf(stderr, "Registry warning: generating %s_F2C_Copy%s: cannot find definition for %s\n", ModName->nickname, nonick, tmp); + } + else { + for (r = q->fields; r; r = r->next) + { + if (r->type != NULL) { + if (r->type->type_type == DERIVED) { // && ! r->type->usefrom + fprintf(stderr, "Registry WARNING: derived data type %s of type %s is not passed through F-C interface\n", r->name, r->type->name); + } + else { + if (is_pointer(r)) { + fprintf(fp, "\n ! -- %s %s Data fields\n", r->name, nonick); + fprintf(fp, " IF ( .NOT. SkipPointers_local ) THEN\n"); + fprintf(fp, " IF ( .NOT. %s(%sData%%%s)) THEN \n", assoc_or_allocated(r), nonick, r->name); + fprintf(fp, " %sData%%c_obj%%%s_Len = 0\n", nonick, r->name); + fprintf(fp, " %sData%%c_obj%%%s = C_NULL_PTR\n", nonick, r->name); + fprintf(fp, " ELSE\n"); + fprintf(fp, " %sData%%c_obj%%%s_Len = SIZE(%sData%%%s)\n", nonick, r->name, nonick, r->name); + fprintf(fp, " IF (%sData%%c_obj%%%s_Len > 0) &\n", nonick, r->name); + fprintf(fp, " %sData%%c_obj%%%s = C_LOC( %sData%%%s( LBOUND(%sData%%%s,1) ) ) \n", nonick, r->name, nonick, r->name, nonick, r->name ); + fprintf(fp, " END IF\n"); + fprintf(fp, " END IF\n"); + } + else if (!has_deferred_dim(r, 0)) { + if (!strcmp(r->type->mapsto, "REAL(ReKi)") || + !strcmp(r->type->mapsto, "REAL(SiKi)") || + !strcmp(r->type->mapsto, "REAL(DbKi)") || + !strcmp(r->type->mapsto, "REAL(R8Ki)") || + !strcmp(r->type->mapsto, "INTEGER(IntKi)") || + !strcmp(r->type->mapsto, "LOGICAL")) + { + fprintf(fp, " %sData%%C_obj%%%s = %sData%%%s\n", nonick, r->name, nonick, r->name); + } + else { // characters need to be copied differently + if (r->ndims == 0) { + //fprintf(stderr, "Registry WARNING: character data type %s of type %s is not passed through F-C interface\n", r->name, r->type->name); + fprintf(fp, " %sData%%C_obj%%%s = TRANSFER(%sData%%%s, %sData%%C_obj%%%s )\n", nonick, r->name, nonick, r->name, nonick, r->name); + } + } + } + } + } + } + } + + fprintf(fp, " END SUBROUTINE %s_F2C_Copy%s\n\n", ModName->nickname, nonick); + return(0); +} + int gen_copy( FILE * fp, const node_t * ModName, char * inout, char * inoutlong, const node_t * q_in ) @@ -190,13 +280,14 @@ gen_copy( FILE * fp, const node_t * ModName, char * inout, char * inoutlong, con fprintf(fp, " Dst%sData%%%s = Src%sData%%%s\n",nonick,r->name,nonick,r->name) ; if (sw_ccode && !is_pointer(r)){ - if (!strcmp(r->type->mapsto, "REAL(ReKi)") || - !strcmp(r->type->mapsto, "REAL(SiKi)") || - !strcmp(r->type->mapsto, "REAL(DbKi)") || - !strcmp(r->type->mapsto, "REAL(R8Ki)") || - !strcmp(r->type->mapsto, "INTEGER(IntKi)") || - !strcmp(r->type->mapsto, "LOGICAL") || - r->ndims == 0) + //if (!strcmp(r->type->mapsto, "REAL(ReKi)") || + // !strcmp(r->type->mapsto, "REAL(SiKi)") || + // !strcmp(r->type->mapsto, "REAL(DbKi)") || + // !strcmp(r->type->mapsto, "REAL(R8Ki)") || + // !strcmp(r->type->mapsto, "INTEGER(IntKi)") || + // !strcmp(r->type->mapsto, "LOGICAL") || + // r->ndims == 0) + if ( r->ndims == 0 ) // scalar of any type OR a character array { // fprintf(fp, " Dst%sData%%C_obj%%%s = Dst%sData%%%s\n", nonick, r->name, nonick, r->name); fprintf(fp, " Dst%sData%%C_obj%%%s = Src%sData%%C_obj%%%s\n", nonick, r->name, nonick, r->name); @@ -221,10 +312,10 @@ void gen_pack( FILE * fp, const node_t * ModName, char * inout, char *inoutlong ) { - char tmp[NAMELEN], tmp2[NAMELEN], tmp3[NAMELEN], addnick[NAMELEN], nonick[NAMELEN] ; - char nonick2[NAMELEN]; + char tmp[NAMELEN], tmp2[NAMELEN], addnick[NAMELEN], nonick[NAMELEN] ; + char nonick2[NAMELEN], indent[NAMELEN], mainIndent[6]; node_t *q, * r ; - int frst, d; + int frst, d, i; remove_nickname(ModName->nickname,inout,nonick) ; append_nickname((is_a_fast_interface_type(inoutlong))?ModName->nickname:"",inoutlong,addnick) ; @@ -416,26 +507,26 @@ gen_pack( FILE * fp, const node_t * ModName, char * inout, char *inoutlong ) for ( r = q->fields ; r ; r = r->next ) { - if (has_deferred_dim(r, 0)){ - // store whether the data type is allocated and the bounds of each dimension - fprintf(fp, " IF ( .NOT. %s(InData%%%s) ) THEN\n", assoc_or_allocated(r), r->name); - fprintf(fp, " IntKiBuf( Int_Xferred ) = 0\n"); // not allocated - fprintf(fp, " Int_Xferred = Int_Xferred + 1\n"); - //fprintf(fp, " IntKiBuf( Int_Xferred:Int_Xferred+2*%d-1 ) = 0\n", r->ndims, r->name); - //fprintf(fp, " Int_Xferred = Int_Xferred + 2*%d\n", r->ndims); - fprintf(fp, " ELSE\n"); - fprintf(fp, " IntKiBuf( Int_Xferred ) = 1\n"); // allocated - fprintf(fp, " Int_Xferred = Int_Xferred + 1\n"); - for (d = 1; d <= r->ndims; d++) { - fprintf(fp, " IntKiBuf( Int_Xferred ) = LBOUND(InData%%%s,%d)\n", r->name, d); - fprintf(fp, " IntKiBuf( Int_Xferred + 1) = UBOUND(InData%%%s,%d)\n", r->name, d); - fprintf(fp, " Int_Xferred = Int_Xferred + 2\n"); - } - fprintf(fp, "\n"); - sprintf(tmp3, " IF (SIZE(InData%%%s)>0)", r->name); - } - else{ - sprintf(tmp3, " "); + if (has_deferred_dim(r, 0)) { + // store whether the data type is allocated and the bounds of each dimension + fprintf(fp, " IF ( .NOT. %s(InData%%%s) ) THEN\n", assoc_or_allocated(r), r->name); + fprintf(fp, " IntKiBuf( Int_Xferred ) = 0\n"); // not allocated + fprintf(fp, " Int_Xferred = Int_Xferred + 1\n"); + //fprintf(fp, " IntKiBuf( Int_Xferred:Int_Xferred+2*%d-1 ) = 0\n", r->ndims, r->name); + //fprintf(fp, " Int_Xferred = Int_Xferred + 2*%d\n", r->ndims); + fprintf(fp, " ELSE\n"); + fprintf(fp, " IntKiBuf( Int_Xferred ) = 1\n"); // allocated + fprintf(fp, " Int_Xferred = Int_Xferred + 1\n"); + for (d = 1; d <= r->ndims; d++) { + fprintf(fp, " IntKiBuf( Int_Xferred ) = LBOUND(InData%%%s,%d)\n", r->name, d); + fprintf(fp, " IntKiBuf( Int_Xferred + 1) = UBOUND(InData%%%s,%d)\n", r->name, d); + fprintf(fp, " Int_Xferred = Int_Xferred + 2\n"); + } + fprintf(fp, "\n"); + strcpy(mainIndent, " "); + } + else { + strcpy(mainIndent, ""); } @@ -500,63 +591,55 @@ gen_pack( FILE * fp, const node_t * ModName, char * inout, char *inoutlong ) } } - else { // intrinsic data types + else { + // intrinsic data types // do all dimensions of arrays (no need for loop over i%d) - sprintf(tmp2, "SIZE(InData%%%s)", r->name); + strcpy(indent, " "); + strcat(indent, mainIndent); + for (d = r->ndims; d >= 1; d--) { + fprintf(fp, "%s DO i%d = LBOUND(InData%%%s,%d), UBOUND(InData%%%s,%d)\n", indent, d, r->name, d, r->name, d); + strcat(indent, " "); //create an indent + } + if (!strcmp(r->type->mapsto, "REAL(ReKi)") || !strcmp(r->type->mapsto, "REAL(SiKi)")) { - fprintf(fp, " %s ReKiBuf ( Re_Xferred:Re_Xferred+(%s)-1 ) = %sInData%%%s%s\n", - tmp3, (r->ndims>0) ? tmp2 : "1", (r->ndims>0) ? "PACK(" : "", r->name, (r->ndims>0) ? ",.TRUE.)" : ""); - fprintf(fp, " Re_Xferred = Re_Xferred + %s\n", (r->ndims>0) ? tmp2 : "1"); + fprintf(fp, "%s ReKiBuf(Re_Xferred) = InData%%%s%s\n", indent, r->name, dimstr(r->ndims)); + fprintf(fp, "%s Re_Xferred = Re_Xferred + 1\n", indent); } else if (!strcmp(r->type->mapsto, "REAL(DbKi)") || !strcmp(r->type->mapsto, "REAL(R8Ki)")) { - fprintf(fp, " %s DbKiBuf ( Db_Xferred:Db_Xferred+(%s)-1 ) = %sInData%%%s%s\n", - tmp3, (r->ndims>0) ? tmp2 : "1", (r->ndims>0) ? "PACK(" : "", r->name, (r->ndims>0) ? ",.TRUE.)" : ""); - fprintf(fp, " Db_Xferred = Db_Xferred + %s\n", (r->ndims>0) ? tmp2 : "1"); + fprintf(fp, "%s DbKiBuf(Db_Xferred) = InData%%%s%s\n", indent, r->name, dimstr(r->ndims)); + fprintf(fp, "%s Db_Xferred = Db_Xferred + 1\n", indent); } else if (!strcmp(r->type->mapsto, "INTEGER(IntKi)") ) { - fprintf(fp, " %s IntKiBuf ( Int_Xferred:Int_Xferred+(%s)-1 ) = %sInData%%%s%s\n", - tmp3, (r->ndims>0) ? tmp2 : "1", (r->ndims>0) ? "PACK(" : "", r->name, (r->ndims>0) ? ",.TRUE.)" : ""); - fprintf(fp, " Int_Xferred = Int_Xferred + %s\n", (r->ndims>0) ? tmp2 : "1"); + fprintf(fp, "%s IntKiBuf(Int_Xferred) = InData%%%s%s\n", indent, r->name, dimstr(r->ndims)); + fprintf(fp, "%s Int_Xferred = Int_Xferred + 1\n", indent); } else if (!strcmp(r->type->mapsto, "LOGICAL") ) { - fprintf(fp, " %s IntKiBuf ( Int_Xferred:Int_Xferred+%s-1 ) = TRANSFER(%s InData%%%s %s, IntKiBuf(1), %s)\n", - tmp3, (r->ndims>0) ? tmp2 : "1", (r->ndims>0) ? "PACK(" : "", r->name, (r->ndims>0) ? ",.TRUE.)" : "", - (r->ndims>0) ? tmp2 : "1"); - fprintf(fp, " Int_Xferred = Int_Xferred + %s\n", (r->ndims>0) ? tmp2 : "1"); + fprintf(fp, "%s IntKiBuf(Int_Xferred) = TRANSFER(InData%%%s%s, IntKiBuf(1))\n", indent, r->name, dimstr(r->ndims)); + fprintf(fp, "%s Int_Xferred = Int_Xferred + 1\n", indent); } else /*if (!strcmp(r->type->mapsto, "CHARACTER")) */{ - for (d = r->ndims; d >= 1; d--) { - fprintf(fp, " DO i%d = LBOUND(InData%%%s,%d), UBOUND(InData%%%s,%d)\n", d, r->name, d, r->name, d); - } + fprintf(fp, "%s DO I = 1, LEN(InData%%%s)\n", indent, r->name); + fprintf(fp, "%s IntKiBuf(Int_Xferred) = ICHAR(InData%%%s%s(I:I), IntKi)\n", indent, r->name, dimstr(r->ndims)); + fprintf(fp, "%s Int_Xferred = Int_Xferred + 1\n", indent); + fprintf(fp, "%s END DO ! I\n", indent); - fprintf(fp, " DO I = 1, LEN(InData%%%s)\n", r->name); - fprintf(fp, " IntKiBuf(Int_Xferred) = ICHAR(InData%%%s%s(I:I), IntKi)\n", r->name, dimstr(r->ndims)); - fprintf(fp, " Int_Xferred = Int_Xferred + 1\n"); - fprintf(fp, " END DO ! I\n"); + } - for (d = r->ndims; d >= 1; d--) { - fprintf(fp, " END DO !i%d\n",d); + for (d = r->ndims; d >= 1; d--) { + strcpy(indent, " "); + strcat(indent, mainIndent); + for (i = 1; i < d; i++) { + strcat(indent, " "); } + fprintf(fp, "%s END DO\n", indent); + } -// bjj: this works, but will produce errors about the source being smaller than the result, thus leaving garbage in some bytes -#if 0 - fprintf(fp, " IntKiBuf ( Int_Xferred:Int_Xferred+%s*LEN(InData%%%s)-1 ) = TRANSFER(%s InData%%%s %s, IntKiBuf(1), %s*LEN(InData%%%s))\n", - (r->ndims>0) ? tmp2 : "1", r->name, - (r->ndims>0) ? "PACK(" : "", r->name, (r->ndims>0) ? ",.TRUE.)" : "", - (r->ndims>0) ? tmp2 : "1", r->name); - fprintf(fp, " Int_Xferred = Int_Xferred + %s*LEN(InData%%%s)\n", (r->ndims>0) ? tmp2 : "1", r->name); -#endif - } /* - else - { - fprintf(fp, "! missing buffer for %s\n", r->name); - }*/ } if (has_deferred_dim(r, 0)){ @@ -571,9 +654,9 @@ gen_pack( FILE * fp, const node_t * ModName, char * inout, char *inoutlong ) void gen_unpack( FILE * fp, const node_t * ModName, char * inout, char * inoutlong ) { - char tmp[NAMELEN], tmp2[NAMELEN], tmp3[NAMELEN], addnick[NAMELEN], nonick[NAMELEN], nonick2[NAMELEN]; + char tmp[NAMELEN], tmp2[NAMELEN], indent[NAMELEN], addnick[NAMELEN], nonick[NAMELEN], nonick2[NAMELEN], mainIndent[6]; node_t *q, * r ; - int d ; + int d, i ; remove_nickname(ModName->nickname,inout,nonick) ; append_nickname((is_a_fast_interface_type(inoutlong))?ModName->nickname:"",inoutlong,addnick) ; @@ -599,12 +682,6 @@ gen_unpack( FILE * fp, const node_t * ModName, char * inout, char * inoutlong ) fprintf(fp," INTEGER(IntKi) :: Db_Xferred\n") ; fprintf(fp," INTEGER(IntKi) :: Int_Xferred\n") ; fprintf(fp," INTEGER(IntKi) :: i\n") ; - fprintf(fp," LOGICAL :: mask0\n"); - fprintf(fp," LOGICAL, ALLOCATABLE :: mask1(:)\n"); - fprintf(fp," LOGICAL, ALLOCATABLE :: mask2(:,:)\n"); - fprintf(fp," LOGICAL, ALLOCATABLE :: mask3(:,:,:)\n") ; - fprintf(fp," LOGICAL, ALLOCATABLE :: mask4(:,:,:,:)\n") ; - fprintf(fp," LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:)\n") ; for (d = 1; d <= q->max_ndims; d++){ fprintf(fp," INTEGER(IntKi) :: i%d, i%d_l, i%d_u ! bounds (upper/lower) for an array dimension %d\n", d, d, d, d); } @@ -659,18 +736,16 @@ gen_unpack( FILE * fp, const node_t * ModName, char * inout, char * inoutlong ) fprintf(fp, " IF (OutData%%c_obj%%%s_Len > 0) &\n", r->name); fprintf(fp, " OutData%%c_obj%%%s = C_LOC( OutData%%%s(i1_l) ) \n", r->name, r->name); } - - sprintf(tmp3, " IF (SIZE(OutData%%%s)>0)", r->name); + strcpy(mainIndent, " "); } else{ - sprintf(tmp3, " "); - for (d = 1; d <= r->ndims; d++) { fprintf(fp, " i%d_l = LBOUND(OutData%%%s,%d)\n", d, r->name, d); fprintf(fp, " i%d_u = UBOUND(OutData%%%s,%d)\n", d, r->name, d); sprintf(tmp2, ",i%d_l:i%d_u", d, d); strcat(tmp, tmp2); } + strcpy(mainIndent, ""); } if (!strcmp(r->type->name, "meshtype") || @@ -751,122 +826,73 @@ gen_unpack( FILE * fp, const node_t * ModName, char * inout, char * inoutlong ) } } - else if (r->ndims > 0){ //non-scalar intrinsic data types (arrays) - fprintf(fp, " ALLOCATE(mask%d(%s),STAT=ErrStat2)\n", r->ndims, (char*)&(tmp[1])); - fprintf(fp, " IF (ErrStat2 /= 0) THEN \n"); - fprintf(fp, " CALL SetErrStat(ErrID_Fatal, 'Error allocating mask%d.', ErrStat, ErrMsg,RoutineName)\n", r->ndims); - fprintf(fp, " RETURN\n"); - fprintf(fp, " END IF\n"); - fprintf(fp, " mask%d = .TRUE. \n", r->ndims); + else + { + strcpy(indent, " "); + strcat(indent, mainIndent); + for (d = r->ndims; d >= 1; d--) { + fprintf(fp, "%s DO i%d = LBOUND(OutData%%%s,%d), UBOUND(OutData%%%s,%d)\n", indent, d, r->name, d, r->name, d); + strcat(indent, " "); //create an indent + } - // do all dimensions of arrays (no need for loop over i%d) - sprintf(tmp2, "SIZE(OutData%%%s)", r->name); - if (!strcmp(r->type->mapsto, "REAL(ReKi)")) { - if (is_pointer(r)) { // bjj: this isn't very generic, but it's quick and will work for all current cases - fprintf(fp, " %s OutData%%%s = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(%s)-1 ), mask%d, 0.0_ReKi ), C_FLOAT)\n", - tmp3, r->name, tmp2, r->ndims); + if (!strcmp(r->type->mapsto, "REAL(ReKi)") || + !strcmp(r->type->mapsto, "REAL(SiKi)")) { + if (sw_ccode && is_pointer(r)) { + fprintf(fp, "%s OutData%%%s%s = REAL(ReKiBuf(Re_Xferred), C_FLOAT)\n", indent, r->name, dimstr(r->ndims)); + } + else if (!strcmp(r->type->mapsto, "REAL(SiKi)")) { + fprintf(fp, "%s OutData%%%s%s = REAL(ReKiBuf(Re_Xferred), SiKi)\n", indent, r->name, dimstr(r->ndims)); } else { - fprintf(fp, " %s OutData%%%s = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(%s)-1 ), mask%d, 0.0_ReKi )\n", - tmp3, r->name, tmp2, r->ndims); + fprintf(fp, "%s OutData%%%s%s = ReKiBuf(Re_Xferred)\n", indent, r->name, dimstr(r->ndims)); } - fprintf(fp, " Re_Xferred = Re_Xferred + %s\n", tmp2); - } - else if (!strcmp(r->type->mapsto, "REAL(SiKi)")) - { - fprintf(fp, " %s OutData%%%s = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(%s)-1 ), mask%d, 0.0_ReKi ), SiKi)\n", - tmp3, r->name, tmp2, r->ndims); - fprintf(fp, " Re_Xferred = Re_Xferred + %s\n", tmp2); + fprintf(fp, "%s Re_Xferred = Re_Xferred + 1\n", indent); } - else if (!strcmp(r->type->mapsto, "REAL(DbKi)")) { - if (is_pointer(r)) { // bjj: this isn't very generic, but it's quick and will work for all current cases - fprintf(fp, " %s OutData%%%s = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(%s)-1 ), mask%d, 0.0_DbKi ), C_DOUBLE)\n", - tmp3, r->name, tmp2, r->ndims); + else if (!strcmp(r->type->mapsto, "REAL(DbKi)") || + !strcmp(r->type->mapsto, "REAL(R8Ki)")) { + if (sw_ccode && is_pointer(r)) { + fprintf(fp, "%s OutData%%%s%s = REAL(DbKiBuf(Db_Xferred), C_DOUBLE)\n", indent, r->name, dimstr(r->ndims)); + } + else if (!strcmp(r->type->mapsto, "REAL(R8Ki)")) { + fprintf(fp, "%s OutData%%%s%s = REAL(DbKiBuf(Db_Xferred), R8Ki)\n", indent, r->name, dimstr(r->ndims)); } else { - fprintf(fp, " %s OutData%%%s = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(%s)-1 ), mask%d, 0.0_DbKi )\n", - tmp3, r->name, (r->ndims > 0) ? tmp2 : "1", r->ndims); + fprintf(fp, "%s OutData%%%s%s = DbKiBuf(Db_Xferred)\n", indent, r->name, dimstr(r->ndims)); } - fprintf(fp, " Db_Xferred = Db_Xferred + %s\n", tmp2); - } - else if (!strcmp(r->type->mapsto, "REAL(R8Ki)")) - { - fprintf(fp, " %s OutData%%%s = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(%s)-1 ), mask%d, 0.0_DbKi ), R8Ki)\n", - tmp3, r->name, tmp2, r->ndims); - fprintf(fp, " Db_Xferred = Db_Xferred + %s\n", tmp2); + fprintf(fp, "%s Db_Xferred = Db_Xferred + 1\n", indent); } else if (!strcmp(r->type->mapsto, "INTEGER(IntKi)")) { - fprintf(fp, " %s OutData%%%s = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(%s)-1 ), mask%d, 0_IntKi )\n", - tmp3, r->name, (r->ndims>0) ? tmp2 : "1", r->ndims); - fprintf(fp, " Int_Xferred = Int_Xferred + %s\n", tmp2); + fprintf(fp, "%s OutData%%%s%s = IntKiBuf(Int_Xferred)\n", indent, r->name, dimstr(r->ndims)); + fprintf(fp, "%s Int_Xferred = Int_Xferred + 1\n", indent); } else if (!strcmp(r->type->mapsto, "LOGICAL")) { - //fprintf(fp, " %s OutData%%%s = TRANSFER( UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(%s)-1 ), mask%d, 0 ), OutData%%%s)\n", - fprintf(fp, " %s OutData%%%s = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(%s)-1 ), OutData%%%s), mask%d,.TRUE.)\n", - tmp3, r->name, (r->ndims>0) ? tmp2 : "1", r->name, r->ndims); - fprintf(fp, " Int_Xferred = Int_Xferred + %s\n", tmp2); + fprintf(fp, "%s OutData%%%s%s = TRANSFER(IntKiBuf(Int_Xferred), OutData%%%s%s)\n", indent, r->name, dimstr(r->ndims), r->name, dimstr(r->ndims)); + fprintf(fp, "%s Int_Xferred = Int_Xferred + 1\n", indent); } - else /*if (!strcmp(r->type->mapsto, "CHARACTER")) */{ - - for (d = r->ndims; d >= 1; d--) { - fprintf(fp, " DO i%d = LBOUND(OutData%%%s,%d), UBOUND(OutData%%%s,%d)\n", d, r->name, d, r->name, d); - } + else /*if (!strcmp(r->type->mapsto, "CHARACTER")) */ { - fprintf(fp, " DO I = 1, LEN(OutData%%%s)\n", r->name); - fprintf(fp, " OutData%%%s%s(I:I) = CHAR(IntKiBuf(Int_Xferred))\n", r->name, dimstr(r->ndims)); - fprintf(fp, " Int_Xferred = Int_Xferred + 1\n"); - fprintf(fp, " END DO ! I\n"); + fprintf(fp, "%s DO I = 1, LEN(OutData%%%s)\n", indent, r->name); + fprintf(fp, "%s OutData%%%s%s(I:I) = CHAR(IntKiBuf(Int_Xferred))\n", indent, r->name, dimstr(r->ndims)); + fprintf(fp, "%s Int_Xferred = Int_Xferred + 1\n", indent); + fprintf(fp, "%s END DO ! I\n", indent); - for (d = r->ndims; d >= 1; d--) { - fprintf(fp, " END DO !i%d\n", d); - } - } - - fprintf(fp, " DEALLOCATE(mask%d)\n", r->ndims); - - } - else { - // scalar intrinsic data types - // do all dimensions of arrays (no need for loop over i%d) - if (!strcmp(r->type->mapsto, "REAL(ReKi)")) { - fprintf(fp, " OutData%%%s = ReKiBuf( Re_Xferred )\n", r->name); - fprintf(fp, " Re_Xferred = Re_Xferred + 1\n"); - } - else if (!strcmp(r->type->mapsto, "REAL(SiKi)")) - { - fprintf(fp, " OutData%%%s = REAL( ReKiBuf( Re_Xferred ), SiKi) \n", r->name); - fprintf(fp, " Re_Xferred = Re_Xferred + 1\n"); - } - else if (!strcmp(r->type->mapsto, "REAL(DbKi)")) { - fprintf(fp, " OutData%%%s = DbKiBuf( Db_Xferred ) \n", r->name); - fprintf(fp, " Db_Xferred = Db_Xferred + 1\n"); - } - else if (!strcmp(r->type->mapsto, "REAL(R8Ki)")) { - fprintf(fp, " OutData%%%s = REAL( DbKiBuf( Db_Xferred ), R8Ki) \n", r->name); - fprintf(fp, " Db_Xferred = Db_Xferred + 1\n"); - } - else if (!strcmp(r->type->mapsto, "INTEGER(IntKi)")) { - fprintf(fp, " OutData%%%s = IntKiBuf( Int_Xferred ) \n", r->name); - fprintf(fp, " Int_Xferred = Int_Xferred + 1\n"); } - else if (!strcmp(r->type->mapsto, "LOGICAL")) { - fprintf(fp, " OutData%%%s = TRANSFER( IntKiBuf( Int_Xferred ), mask0 )\n", r->name); - fprintf(fp, " Int_Xferred = Int_Xferred + 1\n"); - } - - else /*if (!strcmp(r->type->mapsto, "CHARACTER")) */{ - fprintf(fp, " DO I = 1, LEN(OutData%%%s)\n", r->name); - fprintf(fp, " OutData%%%s(I:I) = CHAR(IntKiBuf(Int_Xferred))\n", r->name); - fprintf(fp, " Int_Xferred = Int_Xferred + 1\n"); - fprintf(fp, " END DO ! I\n"); + for (d = r->ndims; d >= 1; d--) { + strcpy(indent, " "); + strcat(indent, mainIndent); + for (i = 1; i < d; i++) { + strcat(indent, " "); + } + fprintf(fp, "%s END DO\n", indent); } -// need to move this (scalars and strings) to the %c_obj% type, too! +// need to move scalars and strings to the %c_obj% type, too! // compare with copy routine - if (sw_ccode && !has_deferred_dim(r, 0)) { + + if (sw_ccode && !is_pointer(r) && r->ndims == 0) { if (!strcmp(r->type->mapsto, "REAL(ReKi)") || !strcmp(r->type->mapsto, "REAL(SiKi)") || !strcmp(r->type->mapsto, "REAL(DbKi)") || @@ -877,9 +903,7 @@ gen_unpack( FILE * fp, const node_t * ModName, char * inout, char * inoutlong ) fprintf(fp, " OutData%%C_obj%%%s = OutData%%%s\n", r->name, r->name); } else { // characters need to be copied differently - if (r->ndims == 0){ - fprintf(fp, " OutData%%C_obj%%%s = TRANSFER(OutData%%%s, OutData%%C_obj%%%s )\n", r->name, r->name, r->name); - } + fprintf(fp, " OutData%%C_obj%%%s = TRANSFER(OutData%%%s, OutData%%C_obj%%%s )\n", r->name, r->name, r->name); } } @@ -1000,7 +1024,7 @@ void gen_extint_order(FILE *fp, const node_t *ModName, char * typnm, char * uy, node_t *q, *r1 ; int j ; int mesh = 0 ; - char derefrecurse[NAMELEN],dex[NAMELEN],tmp[NAMELEN] ; + char derefrecurse[NAMELEN],tmp[NAMELEN] ; if ( recurselevel > MAXRECURSE ) { fprintf(stderr,"REGISTRY ERROR: too many levels of array subtypes\n") ; exit(9) ; @@ -1028,24 +1052,19 @@ void gen_extint_order(FILE *fp, const node_t *ModName, char * typnm, char * uy, } } } else if ( !strcmp( r->type->mapsto, "MeshType" ) ) { - strcpy(dex,"") ; for ( j = r->ndims ; j > 0 ; j-- ) { - fprintf(fp, " DO i%d%d = LBOUND(%s_out%s%%%s,%d),UBOUND(%s_out%s%%%s,%d)\n", 0, 1, uy, deref, r->name, j, uy, deref, r->name, j); - if ( j == r->ndims ) strcat(dex,"(") ; - sprintf(tmp,"i%d%d",0,j) ; - if ( j == 1 ) strcat(tmp,")") ; else strcat(tmp,",") ; - strcat(dex,tmp) ; + fprintf(fp, " DO i%d%d = LBOUND(%s_out%s%%%s,%d),UBOUND(%s_out%s%%%s,%d)\n", 0, j, uy, deref, r->name, j, uy, deref, r->name, j); } if ( order == 0 ) { - fprintf(fp, " CALL MeshCopy(%s(1)%s%%%s%s, %s_out%s%%%s%s, MESH_UPDATECOPY, ErrStat2, ErrMsg2 )\n", uy, deref, r->name, dex - , uy, deref, r->name, dex); + fprintf(fp, " CALL MeshCopy(%s(1)%s%%%s%s, %s_out%s%%%s%s, MESH_UPDATECOPY, ErrStat2, ErrMsg2 )\n", uy, deref, r->name, dimstr(r->ndims) + , uy, deref, r->name, dimstr(r->ndims)); } else if ( order == 1 ) { fprintf(fp," CALL MeshExtrapInterp1(%s(1)%s%%%s%s, %s(2)%s%%%s%s, tin, %s_out%s%%%s%s, tin_out, ErrStat2, ErrMsg2 )\n" - , uy, deref, r->name, dex, uy, deref, r->name, dex, uy, deref, r->name, dex); + , uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); } else if ( order == 2 ) { fprintf(fp," CALL MeshExtrapInterp2(%s(1)%s%%%s%s, %s(2)%s%%%s%s, %s(3)%s%%%s%s, tin, %s_out%s%%%s%s, tin_out, ErrStat2, ErrMsg2 )\n" - , uy, deref, r->name, dex, uy, deref, r->name, dex, uy, deref, r->name, dex, uy, deref, r->name, dex); + , uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); } fprintf(fp, " CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName)\n"); fprintf(fp, " IF (ErrStat>=AbortErrLev) RETURN\n"); @@ -1058,19 +1077,19 @@ void gen_extint_order(FILE *fp, const node_t *ModName, char * typnm, char * uy, char nonick2[NAMELEN] ; remove_nickname(r->type->module->nickname,r->type->name,nonick2) ; - strcpy(dex,"") ; + strcpy(dimstr(r->ndims),"") ; for ( j = r->ndims ; j >= 1 ; j-- ) { - fprintf(fp, " DO i%d%d = LBOUND(%s_out%s%%%s,%d), UBOUND(%s_out%s%%%s,%d)\n", 0, 1, uy, deref, r->name, j, uy, deref, r->name, j); - if ( j == r->ndims ) strcat(dex,"(") ; + fprintf(fp, " DO i%d%d = LBOUND(%s_out%s%%%s,%d), UBOUND(%s_out%s%%%s,%d)\n", 0, j, uy, deref, r->name, j, uy, deref, r->name, j); + if ( j == r->ndims ) strcat(dimstr(r->ndims),"(") ; sprintf(tmp,"i%d%d",0,j) ; if ( j == 1 ) strcat(tmp,")") ; else strcat(tmp,",") ; - strcat(dex,tmp) ; + strcat(dimstr(r->ndims),tmp) ; } fprintf(fp," CALL %s_%s_ExtrapInterp( %s%s%%%s%s, tin, %s_out%s%%%s%s, tin_out, ErrStat2, ErrMsg2 )\n", r->type->module->nickname,fast_interface_type_shortname(nonick2) - , uy, deref, r->name, dex, uy, deref, r->name, dex); + , uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); fprintf(fp," CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName)\n"); fprintf(fp," IF (ErrStat>=AbortErrLev) RETURN\n"); @@ -1139,9 +1158,9 @@ void gen_extint_order(FILE *fp, const node_t *ModName, char * typnm, char * uy, #endif void gen_extint_order(FILE *fp, const node_t *ModName, char * typnm, char * uy, const int order, node_t *r, char * deref, int recurselevel) { node_t *q, *r1; - int j; + int i, j; int mesh = 0; - char derefrecurse[NAMELEN], dex[NAMELEN], tmp[NAMELEN]; + char derefrecurse[NAMELEN], indent[NAMELEN]; if (recurselevel > MAXRECURSE) { fprintf(stderr, "REGISTRY ERROR: too many levels of array subtypes\n"); exit(9); @@ -1155,8 +1174,6 @@ void gen_extint_order(FILE *fp, const node_t *ModName, char * typnm, char * uy, } if (r->type->type_type == DERIVED) { - - if ((q = get_entry(make_lower_temp(r->type->name), ModName->module_ddt_list)) != NULL) { for (r1 = q->fields; r1; r1 = r1->next) { @@ -1175,27 +1192,22 @@ void gen_extint_order(FILE *fp, const node_t *ModName, char * typnm, char * uy, else { - strcpy(dex, ""); for (j = r->ndims; j > 0; j--) { - fprintf(fp, " DO i%d%d = LBOUND(%s_out%s%%%s,%d),UBOUND(%s_out%s%%%s,%d)\n", 0, 1, uy, deref, r->name, j, uy, deref, r->name, j); - if (j == r->ndims) strcat(dex, "("); - sprintf(tmp, "i%d%d", 0, j); - if (j == 1) strcat(tmp, ")"); else strcat(tmp, ","); - strcat(dex, tmp); + fprintf(fp, " DO i%d = LBOUND(%s_out%s%%%s,%d),UBOUND(%s_out%s%%%s,%d)\n", j, uy, deref, r->name, j, uy, deref, r->name, j); } if (!strcmp(r->type->mapsto, "MeshType")) { if (order == 0) { - fprintf(fp, " CALL MeshCopy(%s1%s%%%s%s, %s_out%s%%%s%s, MESH_UPDATECOPY, ErrStat2, ErrMsg2 )\n", uy, deref, r->name, dex - , uy, deref, r->name, dex); + fprintf(fp, " CALL MeshCopy(%s1%s%%%s%s, %s_out%s%%%s%s, MESH_UPDATECOPY, ErrStat2, ErrMsg2 )\n", uy, deref, r->name, dimstr(r->ndims) + , uy, deref, r->name, dimstr(r->ndims)); } else if (order == 1) { fprintf(fp, " CALL MeshExtrapInterp1(%s1%s%%%s%s, %s2%s%%%s%s, tin, %s_out%s%%%s%s, tin_out, ErrStat2, ErrMsg2 )\n" - , uy, deref, r->name, dex, uy, deref, r->name, dex, uy, deref, r->name, dex); + , uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); } else if (order == 2) { fprintf(fp, " CALL MeshExtrapInterp2(%s1%s%%%s%s, %s2%s%%%s%s, %s3%s%%%s%s, tin, %s_out%s%%%s%s, tin_out, ErrStat2, ErrMsg2 )\n" - , uy, deref, r->name, dex, uy, deref, r->name, dex, uy, deref, r->name, dex, uy, deref, r->name, dex); + , uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); } } else { @@ -1204,17 +1216,17 @@ void gen_extint_order(FILE *fp, const node_t *ModName, char * typnm, char * uy, if (order == 0) { fprintf(fp, " CALL %s_Copy%s(%s1%s%%%s%s, %s_out%s%%%s%s, MESH_UPDATECOPY, ErrStat2, ErrMsg2 )\n", r->type->module->nickname, fast_interface_type_shortname(nonick2) - , uy, deref, r->name, dex, uy, deref, r->name, dex); + , uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); } else if (order == 1) { fprintf(fp, " CALL %s_%s_ExtrapInterp1( %s1%s%%%s%s, %s2%s%%%s%s, tin, %s_out%s%%%s%s, tin_out, ErrStat2, ErrMsg2 )\n", r->type->module->nickname, fast_interface_type_shortname(nonick2) - , uy, deref, r->name, dex, uy, deref, r->name, dex, uy, deref, r->name, dex); + , uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); } else if (order == 2) { fprintf(fp, " CALL %s_%s_ExtrapInterp2( %s1%s%%%s%s, %s2%s%%%s%s, %s3%s%%%s%s, tin, %s_out%s%%%s%s, tin_out, ErrStat2, ErrMsg2 )\n", r->type->module->nickname, fast_interface_type_shortname(nonick2) - , uy, deref, r->name, dex, uy, deref, r->name, dex, uy, deref, r->name, dex, uy, deref, r->name, dex); + , uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); } } @@ -1230,67 +1242,59 @@ void gen_extint_order(FILE *fp, const node_t *ModName, char * typnm, char * uy, !strcmp(r->type->mapsto, "REAL(SiKi)") || !strcmp(r->type->mapsto, "REAL(R8Ki)") || !strcmp(r->type->mapsto, "REAL(DbKi)")) { - if (r->ndims == 0) { - } - else if (r->ndims == 1 && order > 0) { - fprintf(fp, " ALLOCATE(b1(SIZE(%s_out%s%%%s,1)))\n", uy, deref, r->name); - fprintf(fp, " ALLOCATE(c1(SIZE(%s_out%s%%%s,1)))\n", uy, deref, r->name); - } - else if (r->ndims == 2 && order > 0) { - fprintf(fp, " ALLOCATE(b2(SIZE(%s_out%s%%%s,1),SIZE(%s_out%s%%%s,2) ))\n", uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " ALLOCATE(c2(SIZE(%s_out%s%%%s,1),SIZE(%s_out%s%%%s,2) ))\n", uy, deref, r->name, uy, deref, r->name); - } - else if (r->ndims == 3 && order > 0) { - fprintf(fp, " ALLOCATE(b3(SIZE(%s_out%s%%%s,1),SIZE(%s_out%s%%%s,2), &\n", uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " SIZE(%s_out%s%%%s,3) ))\n", uy, deref, r->name); - fprintf(fp, " ALLOCATE(c3(SIZE(%s_out%s%%%s,1),SIZE(%s_out%s%%%s,2), &\n", uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " SIZE(%s_out%s%%%s,3) ))\n", uy, deref, r->name); - } - else if (r->ndims == 4 && order > 0) { - fprintf(fp, " ALLOCATE(b4(SIZE(%s_out%s%%%s,1),SIZE(%s_out%s%%%s,2), &\n", uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " SIZE(%s_out%s%%%s,3),SIZE(%s_out%s%%%s,4) ))\n", uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " ALLOCATE(c4(SIZE(%s_out%s%%%s,1),SIZE(%s_out%s%%%s,2), &\n", uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " SIZE(%s_out%s%%%s,3),SIZE(%s_out%s%%%s,4) ))\n", uy, deref, r->name, uy, deref, r->name); - } - else if (r->ndims == 5 && order > 0) { - fprintf(fp, " ALLOCATE(b5(SIZE(%s_out%s%%%s,1),SIZE(%s_out%s%%%s,2), &\n", uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " SIZE(%s_out%s%%%s,3),SIZE(%s_out%s%%%s,4), &\n", uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " SIZE(%s_out%s%%%s,5) ))\n", uy, deref, r->name); - fprintf(fp, " ALLOCATE(c5(SIZE(%s_out%s%%%s,1),SIZE(%s_out%s%%%s,2), &\n", uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " SIZE(%s_out%s%%%s,3),SIZE(%s_out%s%%%s,4), &\n", uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " SIZE(%s_out%s%%%s,5) ))\n", uy, deref, r->name); - } - else { - if (order > 0) fprintf(stderr, "Registry WARNING: too many dimensions for %s%%%s\n", deref, r->name); - } + if (order == 0) { + //bjj: this should probably have some "IF ALLOCATED" statements around it, but we're just calling + // the copy routine fprintf(fp, " %s_out%s%%%s = %s1%s%%%s\n", uy, deref, r->name, uy, deref, r->name); } - else if (order == 1) { - fprintf(fp, " b%d = -(%s1%s%%%s - %s2%s%%%s)/t(2)\n", r->ndims, uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " %s_out%s%%%s = %s1%s%%%s + b%d * t_out\n", uy, deref, r->name, uy, deref, r->name, r->ndims); - } - else if (order == 2) { - fprintf(fp, " b%d = (t(3)**2*(%s1%s%%%s - %s2%s%%%s) + t(2)**2*(-%s1%s%%%s + %s3%s%%%s))/(t(2)*t(3)*(t(2) - t(3)))\n", - r->ndims, uy, deref, r->name, uy, deref, r->name, uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " c%d = ( (t(2)-t(3))*%s1%s%%%s + t(3)*%s2%s%%%s - t(2)*%s3%s%%%s ) / (t(2)*t(3)*(t(2) - t(3)))\n", - r->ndims, uy, deref, r->name, uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " %s_out%s%%%s = %s1%s%%%s + b%d * t_out + c%d * t_out**2\n" - , uy, deref, r->name, uy, deref, r->name, r->ndims, r->ndims); - } - if (r->ndims >= 1 && order > 0) { - fprintf(fp, " DEALLOCATE(b%d)\n", r->ndims); - fprintf(fp, " DEALLOCATE(c%d)\n", r->ndims); + else + strcpy(indent, ""); + for (j = r->ndims; j > 0; j--) { + fprintf(fp, "%s DO i%d = LBOUND(%s_out%s%%%s,%d),UBOUND(%s_out%s%%%s,%d)\n", indent, j, uy, deref, r->name, j, uy, deref, r->name, j); + strcat(indent, " "); //create an indent + } + + if (order == 1) { + if (r->gen_periodic) { + fprintf(fp, "%s CALL Angles_ExtrapInterp( %s1%s%%%s%s, %s2%s%%%s%s, tin, %s_out%s%%%s%s, tin_out )\n", + indent, uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); + } + else { + fprintf(fp, "%s b = -(%s1%s%%%s%s - %s2%s%%%s%s)\n", indent, uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); + fprintf(fp, "%s %s_out%s%%%s%s = %s1%s%%%s%s + b * ScaleFactor\n", indent, uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); + }; + } + if (order == 2) { + if (r->gen_periodic) { + fprintf(fp, "%s CALL Angles_ExtrapInterp( %s1%s%%%s%s, %s2%s%%%s%s, %s3%s%%%s%s, tin, %s_out%s%%%s%s, tin_out )\n", + indent, uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); + } + else { + fprintf(fp, "%s b = (t(3)**2*(%s1%s%%%s%s - %s2%s%%%s%s) + t(2)**2*(-%s1%s%%%s%s + %s3%s%%%s%s))* scaleFactor\n", + indent, uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); + fprintf(fp, "%s c = ( (t(2)-t(3))*%s1%s%%%s%s + t(3)*%s2%s%%%s%s - t(2)*%s3%s%%%s%s ) * scaleFactor\n", + indent, uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); + fprintf(fp, "%s %s_out%s%%%s%s = %s1%s%%%s%s + b + c * t_out\n", + indent, uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); + } + } + for (j = r->ndims; j >= 1; j--) { + strcpy(indent, ""); + for (i = 1; i < j; i++) { + strcat(indent, " "); + } + fprintf(fp, "%s END DO\n", indent); + } } - } // check if this is an allocatable array: if (r->ndims > 0 && has_deferred_dim(r, 0)) { fprintf(fp, "END IF ! check if allocated\n"); } - } -} + +} // gen_extint_order void calc_extint_order(FILE *fp, const node_t *ModName, node_t *r, int recurselevel, int *max_ndims, int *max_nrecurs, int *max_alloc_ndims) { node_t *q, *r1 ; @@ -1327,6 +1331,7 @@ void calc_extint_order(FILE *fp, const node_t *ModName, node_t *r, int recursele !strcmp(r->type->mapsto, "REAL(R8Ki)") || !strcmp(r->type->mapsto, "REAL(DbKi)")) { if (/*order > 0 &&*/ r->ndims > *max_alloc_ndims) *max_alloc_ndims = r->ndims; + if (r->ndims > *max_ndims)* max_ndims = r->ndims; } @@ -1541,11 +1546,9 @@ fprintf(fp," END IF\n") ; #endif void -gen_ExtrapInterp1(FILE *fp, const node_t * ModName, char * typnm, char * typnmlong, char * uy, const int max_ndims, const int max_nrecurs, const int max_alloc_ndims) +gen_ExtrapInterp1(FILE *fp, const node_t * ModName, char * typnm, char * typnmlong, char * xtypnm, char * uy, const int max_ndims, const int max_nrecurs, const int max_alloc_ndims, const node_t *q) { - char nonick[NAMELEN]; - char *ddtname; - node_t *q, *r; + node_t *r; int i, j; fprintf(fp, "\n"); @@ -1563,43 +1566,21 @@ gen_ExtrapInterp1(FILE *fp, const node_t * ModName, char * typnm, char * typnmlo fprintf(fp, "\n"); - fprintf(fp, " TYPE(%s_%s), INTENT(INOUT) :: %s1 ! %s at t1 > t2\n", ModName->nickname, typnmlong, uy, typnm); - fprintf(fp, " TYPE(%s_%s), INTENT(INOUT) :: %s2 ! %s at t2 \n", ModName->nickname, typnmlong, uy, typnm); - fprintf(fp, " REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the %ss\n", typnm); + fprintf(fp, " TYPE(%s_%s), INTENT(%s) :: %s1 ! %s at t1 > t2\n", ModName->nickname, typnmlong, (q->containsPtr == 1) ? "INOUT" : "IN", uy, typnm); + fprintf(fp, " TYPE(%s_%s), INTENT(%s) :: %s2 ! %s at t2 \n", ModName->nickname, typnmlong, (q->containsPtr == 1) ? "INOUT" : "IN", uy, typnm); + fprintf(fp, " REAL(%s), INTENT(IN ) :: tin(2) ! Times associated with the %ss\n", xtypnm, typnm); fprintf(fp, " TYPE(%s_%s), INTENT(INOUT) :: %s_out ! %s at tin_out\n", ModName->nickname, typnmlong, uy, typnm); - fprintf(fp, " REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to\n"); + fprintf(fp, " REAL(%s), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to\n", xtypnm); fprintf(fp, " INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation\n"); fprintf(fp, " CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None\n"); fprintf(fp, " ! local variables\n"); - fprintf(fp, " REAL(DbKi) :: t(2) ! Times associated with the %ss\n", typnm); - fprintf(fp, " REAL(DbKi) :: t_out ! Time to which to be extrap/interpd\n"); + fprintf(fp, " REAL(%s) :: t(2) ! Times associated with the %ss\n", xtypnm, typnm); + fprintf(fp, " REAL(%s) :: t_out ! Time to which to be extrap/interpd\n", xtypnm); fprintf(fp, " CHARACTER(*), PARAMETER :: RoutineName = '%s_%s_ExtrapInterp1'\n", ModName->nickname, typnm); - if (max_alloc_ndims >= 0){ - fprintf(fp, " REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation\n"); - fprintf(fp, " REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation\n"); - if (max_alloc_ndims >= 1){ - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation\n"); - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation\n"); - if (max_alloc_ndims >= 2){ - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation\n"); - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation\n"); - if (max_alloc_ndims >= 3){ - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: b3 ! temporary for extrapolation/interpolation\n"); - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: c3 ! temporary for extrapolation/interpolation\n"); - if (max_alloc_ndims >= 4){ - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:,:) :: b4 ! temporary for extrapolation/interpolation\n"); - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:,:) :: c4 ! temporary for extrapolation/interpolation\n"); - if (max_alloc_ndims >= 5){ - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:,:,:):: b5 ! temporary for extrapolation/interpolation\n"); - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:,:,:):: c5 ! temporary for extrapolation/interpolation\n"); - } // 5 - } // 4 - } // 3 - } // 2 - } // 1 - } // 0 + fprintf(fp, " REAL(DbKi) :: b ! temporary for extrapolation/interpolation\n"); + fprintf(fp, " REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation\n"); fprintf(fp, " INTEGER(IntKi) :: ErrStat2 ! local errors\n"); fprintf(fp, " CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors\n"); for (j = 1; j <= max_ndims; j++) { @@ -1607,6 +1588,9 @@ gen_ExtrapInterp1(FILE *fp, const node_t * ModName, char * typnm, char * typnmlo fprintf(fp, " INTEGER :: i%d%d ! dim%d level %d counter variable for arrays of ddts\n", i, j, j, i); } } + for (j = 1; j <= max_ndims; j++) { + fprintf(fp, " INTEGER :: i%d ! dim%d counter variable for arrays\n", j, j); + } fprintf(fp, " ! Initialize ErrStat\n"); fprintf(fp, " ErrStat = ErrID_None\n"); @@ -1620,37 +1604,27 @@ gen_ExtrapInterp1(FILE *fp, const node_t * ModName, char * typnm, char * typnmlo fprintf(fp, " IF ( EqualRealNos( t(1), t(2) ) ) THEN\n"); fprintf(fp, " CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName)\n"); fprintf(fp, " RETURN\n"); - fprintf(fp, " END IF\n"); + fprintf(fp, " END IF\n\n"); + fprintf(fp, " ScaleFactor = t_out / t(2)\n"); - for (q = ModName->module_ddt_list; q; q = q->next) + for (r = q->fields; r; r = r->next) { - if (q->usefrom == 0) { - ddtname = q->name; - remove_nickname(ModName->nickname, ddtname, nonick); - if (!strcmp(nonick, make_lower_temp(typnmlong))) { - for (r = q->fields; r; r = r->next) - { - // recursive - gen_extint_order(fp, ModName, typnm, uy, 1, r, "", 0); - } - } - } + // recursive + gen_extint_order(fp, ModName, typnm, uy, 1, r, "", 0); } + fprintf(fp, " END SUBROUTINE %s_%s_ExtrapInterp1\n", ModName->nickname, typnm); fprintf(fp, "\n"); } void -gen_ExtrapInterp2(FILE *fp, const node_t * ModName, char * typnm, char * typnmlong, char * uy, const int max_ndims, const int max_nrecurs, const int max_alloc_ndims) +gen_ExtrapInterp2(FILE *fp, const node_t * ModName, char * typnm, char * typnmlong, char * xtypnm, char * uy, const int max_ndims, const int max_nrecurs, const int max_alloc_ndims, const node_t *q) { - char nonick[NAMELEN]; - char *ddtname; - node_t *q, *r; + node_t *r; int i, j; - fprintf(fp, "\n"); fprintf(fp, " SUBROUTINE %s_%s_ExtrapInterp2(%s1, %s2, %s3, tin, %s_out, tin_out, ErrStat, ErrMsg )\n", ModName->nickname, typnm, uy, uy, uy, uy); fprintf(fp, "!\n"); @@ -1667,45 +1641,23 @@ gen_ExtrapInterp2(FILE *fp, const node_t * ModName, char * typnm, char * typnmlo fprintf(fp, "!..................................................................................................................................\n"); fprintf(fp, "\n"); - - fprintf(fp, " TYPE(%s_%s), INTENT(INOUT) :: %s1 ! %s at t1 > t2 > t3\n", ModName->nickname, typnmlong, uy, typnm); - fprintf(fp, " TYPE(%s_%s), INTENT(INOUT) :: %s2 ! %s at t2 > t3\n", ModName->nickname, typnmlong, uy, typnm); - fprintf(fp, " TYPE(%s_%s), INTENT(INOUT) :: %s3 ! %s at t3\n", ModName->nickname, typnmlong, uy, typnm); - fprintf(fp, " REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the %ss\n", typnm); + fprintf(fp, " TYPE(%s_%s), INTENT(%s) :: %s1 ! %s at t1 > t2 > t3\n", ModName->nickname, typnmlong, (q->containsPtr == 1) ? "INOUT" : "IN", uy, typnm); + fprintf(fp, " TYPE(%s_%s), INTENT(%s) :: %s2 ! %s at t2 > t3\n", ModName->nickname, typnmlong, (q->containsPtr == 1) ? "INOUT" : "IN", uy, typnm); + fprintf(fp, " TYPE(%s_%s), INTENT(%s) :: %s3 ! %s at t3\n", ModName->nickname, typnmlong, (q->containsPtr == 1) ? "INOUT" : "IN", uy, typnm); + fprintf(fp, " REAL(%s), INTENT(IN ) :: tin(3) ! Times associated with the %ss\n", xtypnm, typnm); fprintf(fp, " TYPE(%s_%s), INTENT(INOUT) :: %s_out ! %s at tin_out\n", ModName->nickname, typnmlong, uy, typnm); - fprintf(fp, " REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to\n"); - fprintf(fp, " INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation\n"); + fprintf(fp, " REAL(%s), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to\n", xtypnm); + + fprintf(fp, " INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation\n" ); fprintf(fp, " CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None\n"); fprintf(fp, " ! local variables\n"); - fprintf(fp, " REAL(DbKi) :: t(3) ! Times associated with the %ss\n", typnm); - fprintf(fp, " REAL(DbKi) :: t_out ! Time to which to be extrap/interpd\n"); + fprintf(fp, " REAL(%s) :: t(3) ! Times associated with the %ss\n", xtypnm, typnm); + fprintf(fp, " REAL(%s) :: t_out ! Time to which to be extrap/interpd\n", xtypnm); fprintf(fp, " INTEGER(IntKi) :: order ! order of polynomial fit (max 2)\n"); - - if (max_alloc_ndims >= 0){ - fprintf(fp, " REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation\n"); - fprintf(fp, " REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation\n"); - if (max_alloc_ndims >= 1){ - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation\n"); - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation\n"); - if (max_alloc_ndims >= 2){ - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation\n"); - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation\n"); - if (max_alloc_ndims >= 3){ - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: b3 ! temporary for extrapolation/interpolation\n"); - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: c3 ! temporary for extrapolation/interpolation\n"); - if (max_alloc_ndims >= 4){ - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:,:) :: b4 ! temporary for extrapolation/interpolation\n"); - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:,:) :: c4 ! temporary for extrapolation/interpolation\n"); - if (max_alloc_ndims >= 5){ - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:,:,:):: b5 ! temporary for extrapolation/interpolation\n"); - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:,:,:):: c5 ! temporary for extrapolation/interpolation\n"); - } // 5 - } // 4 - } // 3 - } // 2 - } // 1 - } // 0 + fprintf(fp, " REAL(DbKi) :: b ! temporary for extrapolation/interpolation\n"); + fprintf(fp, " REAL(DbKi) :: c ! temporary for extrapolation/interpolation\n"); + fprintf(fp, " REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation\n"); fprintf(fp, " INTEGER(IntKi) :: ErrStat2 ! local errors\n"); fprintf(fp, " CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors\n"); fprintf(fp, " CHARACTER(*), PARAMETER :: RoutineName = '%s_%s_ExtrapInterp2'\n", ModName->nickname, typnm); @@ -1714,6 +1666,9 @@ gen_ExtrapInterp2(FILE *fp, const node_t * ModName, char * typnm, char * typnmlo fprintf(fp, " INTEGER :: i%d%d ! dim%d level %d counter variable for arrays of ddts\n", i, j, j, i); } } + for (j = 1; j <= max_ndims; j++) { + fprintf(fp, " INTEGER :: i%d ! dim%d counter variable for arrays\n", j, j); + } fprintf(fp, " ! Initialize ErrStat\n"); fprintf(fp, " ErrStat = ErrID_None\n"); fprintf(fp, " ErrMsg = \"\"\n"); @@ -1733,21 +1688,16 @@ gen_ExtrapInterp2(FILE *fp, const node_t * ModName, char * typnm, char * typnmlo fprintf(fp, " ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN\n"); fprintf(fp, " CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName)\n"); fprintf(fp, " RETURN\n"); - fprintf(fp, " END IF\n"); + fprintf(fp, " END IF\n\n"); - for (q = ModName->module_ddt_list; q; q = q->next) + fprintf(fp, " ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3)))\n"); + + + + for (r = q->fields; r; r = r->next) { - if (q->usefrom == 0) { - ddtname = q->name; - remove_nickname(ModName->nickname, ddtname, nonick); - if (!strcmp(nonick, make_lower_temp(typnmlong))) { - for (r = q->fields; r; r = r->next) - { - // recursive - gen_extint_order(fp, ModName, typnm, uy, 2, r, "", 0); - } - } - } + // recursive + gen_extint_order(fp, ModName, typnm, uy, 2, r, "", 0); } @@ -1757,7 +1707,7 @@ gen_ExtrapInterp2(FILE *fp, const node_t * ModName, char * typnm, char * typnmlo void -gen_ExtrapInterp(FILE *fp, const node_t * ModName, char * typnm, char * typnmlong) +gen_ExtrapInterp(FILE *fp, const node_t * ModName, char * typnm, char * typnmlong, char * xtypnm) { char nonick[NAMELEN]; char *ddtname; char uy[2]; @@ -1771,88 +1721,91 @@ gen_ExtrapInterp(FILE *fp, const node_t * ModName, char * typnm, char * typnmlon strcpy(uy, "u"); } - fprintf(fp, "\n"); - fprintf(fp, " SUBROUTINE %s_%s_ExtrapInterp(%s, t, %s_out, t_out, ErrStat, ErrMsg )\n", ModName->nickname, typnm, uy, uy); - fprintf(fp, "!\n"); - fprintf(fp, "! This subroutine calculates a extrapolated (or interpolated) %s %s_out at time t_out, from previous/future time\n", typnm, uy); - fprintf(fp, "! values of %s (which has values associated with times in t). Order of the interpolation is given by the size of %s\n", uy, uy); - fprintf(fp, "!\n"); - fprintf(fp, "! expressions below based on either\n"); - fprintf(fp, "!\n"); - fprintf(fp, "! f(t) = a\n"); - fprintf(fp, "! f(t) = a + b * t, or\n"); - fprintf(fp, "! f(t) = a + b * t + c * t**2\n"); - fprintf(fp, "!\n"); - fprintf(fp, "! where a, b and c are determined as the solution to\n"); - fprintf(fp, "! f(t1) = %s1, f(t2) = %s2, f(t3) = %s3 (as appropriate)\n", uy, uy, uy); - fprintf(fp, "!\n"); - fprintf(fp, "!..................................................................................................................................\n"); - fprintf(fp, "\n"); - - - fprintf(fp, " TYPE(%s_%s), INTENT(INOUT) :: %s(:) ! %s at t1 > t2 > t3\n", ModName->nickname, typnmlong, uy, typnm); - fprintf(fp, " REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the %ss\n", typnm); - //jm Modified from INTENT( OUT) to INTENT(INOUT) to prevent ALLOCATABLE array arguments in the DDT - //jm from being maliciously deallocated through the call.See Sec. 5.1.2.7 of bonehead Fortran 2003 standard - fprintf(fp, " TYPE(%s_%s), INTENT(INOUT) :: %s_out ! %s at tin_out\n", ModName->nickname, typnmlong, uy, typnm); - fprintf(fp, " REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to\n"); - fprintf(fp, " INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation\n"); - fprintf(fp, " CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None\n"); - fprintf(fp, " ! local variables\n"); - fprintf(fp, " INTEGER(IntKi) :: order ! order of polynomial fit (max 2)\n"); - fprintf(fp, " INTEGER(IntKi) :: ErrStat2 ! local errors\n"); - fprintf(fp, " CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors\n"); - fprintf(fp, " CHARACTER(*), PARAMETER :: RoutineName = '%s_%s_ExtrapInterp'\n", ModName->nickname, typnm); - fprintf(fp, " ! Initialize ErrStat\n"); - fprintf(fp, " ErrStat = ErrID_None\n"); - fprintf(fp, " ErrMsg = \"\"\n"); - fprintf(fp, " if ( size(t) .ne. size(%s)) then\n", uy); - fprintf(fp, " CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(%s)',ErrStat,ErrMsg,RoutineName)\n",uy); - fprintf(fp, " RETURN\n"); - fprintf(fp, " endif\n"); - - fprintf(fp, " order = SIZE(%s) - 1\n", uy); - - fprintf(fp, " IF ( order .eq. 0 ) THEN\n"); - fprintf(fp, " CALL %s_Copy%s(%s(1), %s_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 )\n", ModName->nickname, typnm, uy, uy); - fprintf(fp, " CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName)\n"); - fprintf(fp, " ELSE IF ( order .eq. 1 ) THEN\n"); - fprintf(fp, " CALL %s_%s_ExtrapInterp1(%s(1), %s(2), t, %s_out, t_out, ErrStat2, ErrMsg2 )\n", ModName->nickname, typnm, uy, uy, uy); - fprintf(fp, " CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName)\n"); - fprintf(fp, " ELSE IF ( order .eq. 2 ) THEN\n"); - fprintf(fp, " CALL %s_%s_ExtrapInterp2(%s(1), %s(2), %s(3), t, %s_out, t_out, ErrStat2, ErrMsg2 )\n", ModName->nickname, typnm, uy, uy, uy, uy); - fprintf(fp, " CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName)\n"); - fprintf(fp, " ELSE \n"); - fprintf(fp, " CALL SetErrStat(ErrID_Fatal,'size(%s) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName)\n", uy); - fprintf(fp, " RETURN\n"); - fprintf(fp, " ENDIF \n"); - - fprintf(fp, " END SUBROUTINE %s_%s_ExtrapInterp\n", ModName->nickname, typnm); - fprintf(fp, "\n"); - - - max_ndims = 0; // ModName->module_ddt_list->max_ndims; //bjj: this is max for module, not for typnmlong - max_nrecurs = 0; // MAXRECURSE; - max_alloc_ndims = 0; - for (q = ModName->module_ddt_list; q; q = q->next) { if (q->usefrom == 0) { ddtname = q->name; remove_nickname(ModName->nickname, ddtname, nonick); if (!strcmp(nonick, make_lower_temp(typnmlong))) { + + fprintf(fp, "\n"); + fprintf(fp, " SUBROUTINE %s_%s_ExtrapInterp(%s, t, %s_out, t_out, ErrStat, ErrMsg )\n", ModName->nickname, typnm, uy, uy); + fprintf(fp, "!\n"); + fprintf(fp, "! This subroutine calculates a extrapolated (or interpolated) %s %s_out at time t_out, from previous/future time\n", typnm, uy); + fprintf(fp, "! values of %s (which has values associated with times in t). Order of the interpolation is given by the size of %s\n", uy, uy); + fprintf(fp, "!\n"); + fprintf(fp, "! expressions below based on either\n"); + fprintf(fp, "!\n"); + fprintf(fp, "! f(t) = a\n"); + fprintf(fp, "! f(t) = a + b * t, or\n"); + fprintf(fp, "! f(t) = a + b * t + c * t**2\n"); + fprintf(fp, "!\n"); + fprintf(fp, "! where a, b and c are determined as the solution to\n"); + fprintf(fp, "! f(t1) = %s1, f(t2) = %s2, f(t3) = %s3 (as appropriate)\n", uy, uy, uy); + fprintf(fp, "!\n"); + fprintf(fp, "!..................................................................................................................................\n"); + fprintf(fp, "\n"); + + + fprintf(fp, " TYPE(%s_%s), INTENT(%s) :: %s(:) ! %s at t1 > t2 > t3\n", ModName->nickname, typnmlong, (q->containsPtr == 1) ? "INOUT" : "IN", uy, typnm); + fprintf(fp, " REAL(%s), INTENT(IN ) :: t(:) ! Times associated with the %ss\n", xtypnm, typnm); + //jm Modified from INTENT( OUT) to INTENT(INOUT) to prevent ALLOCATABLE array arguments in the DDT + //jm from being maliciously deallocated through the call.See Sec. 5.1.2.7 of bonehead Fortran 2003 standard + fprintf(fp, " TYPE(%s_%s), INTENT(INOUT) :: %s_out ! %s at tin_out\n", ModName->nickname, typnmlong, uy, typnm); + fprintf(fp, " REAL(%s), INTENT(IN ) :: t_out ! time to be extrap/interp'd to\n", xtypnm); + fprintf(fp, " INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation\n"); + fprintf(fp, " CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None\n"); + fprintf(fp, " ! local variables\n"); + fprintf(fp, " INTEGER(IntKi) :: order ! order of polynomial fit (max 2)\n"); + fprintf(fp, " INTEGER(IntKi) :: ErrStat2 ! local errors\n"); + fprintf(fp, " CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors\n"); + fprintf(fp, " CHARACTER(*), PARAMETER :: RoutineName = '%s_%s_ExtrapInterp'\n", ModName->nickname, typnm); + fprintf(fp, " ! Initialize ErrStat\n"); + fprintf(fp, " ErrStat = ErrID_None\n"); + fprintf(fp, " ErrMsg = \"\"\n"); + fprintf(fp, " if ( size(t) .ne. size(%s)) then\n", uy); + fprintf(fp, " CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(%s)',ErrStat,ErrMsg,RoutineName)\n",uy); + fprintf(fp, " RETURN\n"); + fprintf(fp, " endif\n"); + + fprintf(fp, " order = SIZE(%s) - 1\n", uy); + + fprintf(fp, " IF ( order .eq. 0 ) THEN\n"); + fprintf(fp, " CALL %s_Copy%s(%s(1), %s_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 )\n", ModName->nickname, typnm, uy, uy); + fprintf(fp, " CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName)\n"); + fprintf(fp, " ELSE IF ( order .eq. 1 ) THEN\n"); + fprintf(fp, " CALL %s_%s_ExtrapInterp1(%s(1), %s(2), t, %s_out, t_out, ErrStat2, ErrMsg2 )\n", ModName->nickname, typnm, uy, uy, uy); + fprintf(fp, " CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName)\n"); + fprintf(fp, " ELSE IF ( order .eq. 2 ) THEN\n"); + fprintf(fp, " CALL %s_%s_ExtrapInterp2(%s(1), %s(2), %s(3), t, %s_out, t_out, ErrStat2, ErrMsg2 )\n", ModName->nickname, typnm, uy, uy, uy, uy); + fprintf(fp, " CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName)\n"); + fprintf(fp, " ELSE \n"); + fprintf(fp, " CALL SetErrStat(ErrID_Fatal,'size(%s) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName)\n", uy); + fprintf(fp, " RETURN\n"); + fprintf(fp, " ENDIF \n"); + + fprintf(fp, " END SUBROUTINE %s_%s_ExtrapInterp\n", ModName->nickname, typnm); + fprintf(fp, "\n"); + + + max_ndims = 0; // ModName->module_ddt_list->max_ndims; //bjj: this is max for module, not for typnmlong + max_nrecurs = 0; // MAXRECURSE; + max_alloc_ndims = 0; + for (r = q->fields; r; r = r->next) { // recursive calc_extint_order(fp, ModName, r, 0, &max_ndims, &max_nrecurs, &max_alloc_ndims); } + + gen_ExtrapInterp1(fp, ModName, typnm, typnmlong, xtypnm, uy, max_ndims, max_nrecurs, max_alloc_ndims, q); + gen_ExtrapInterp2(fp, ModName, typnm, typnmlong, xtypnm, uy, max_ndims, max_nrecurs, max_alloc_ndims, q); + } } } - gen_ExtrapInterp1(fp, ModName, typnm, typnmlong, uy, max_ndims, max_nrecurs, max_alloc_ndims); - gen_ExtrapInterp2(fp, ModName, typnm, typnmlong, uy, max_ndims, max_nrecurs, max_alloc_ndims); } @@ -2146,13 +2099,13 @@ gen_module( FILE * fp , node_t * ModName, char * prog_ver ) // bjj: we need to make sure these types map to reals, too tmp[0] = '\0' ; - if (*q->mapsto) remove_nickname( ModName->nickname, make_lower_temp(q->mapsto) , tmp ) ; + if (*q->mapsto ) remove_nickname( ModName->nickname, make_lower_temp(q->mapsto) , tmp ) ; if ( must_have_real_or_double(tmp) ) checkOnlyReals( q->mapsto, r ); } else { tmp[0] = '\0' ; - if (*q->mapsto) remove_nickname( ModName->nickname, make_lower_temp(q->mapsto) , tmp ) ; + if (*q->mapsto ) remove_nickname( ModName->nickname, make_lower_temp(q->mapsto) , tmp ) ; if ( must_have_real_or_double(tmp) ) { if ( strncmp(r->type->mapsto,"REAL",4) ) { fprintf(stderr,"Registry warning: %s contains a field (%s) whose type is not real or double: %s\n", @@ -2275,6 +2228,7 @@ gen_module( FILE * fp , node_t * ModName, char * prog_ver ) gen_unpack( fp, ModName, ddtname, ddtnamelong ) ; if ( sw_ccode ) { gen_copy_c2f( fp, ModName, ddtname, ddtnamelong ) ; + gen_copy_f2c(fp, ModName, ddtname, ddtnamelong); } } @@ -2283,9 +2237,13 @@ gen_module( FILE * fp , node_t * ModName, char * prog_ver ) // gen_modname_pack( fp, ModName ) ; // gen_modname_unpack( fp, ModName ) ; // gen_rk4( fp, ModName ) ; - if (!sw_noextrap){ - gen_ExtrapInterp( fp, ModName, "Input", "InputType" ) ; - gen_ExtrapInterp( fp, ModName, "Output", "OutputType" ) ; + + if (strcmp(make_lower_temp(ModName->name), "airfoilinfo") == 0) { // make interpolation routines for AirfoilInfo module + gen_ExtrapInterp(fp, ModName, "Output", "OutputType","ReKi"); + gen_ExtrapInterp(fp, ModName, "UA_BL_Type", "UA_BL_Type", "ReKi"); + } else if (!sw_noextrap) { + gen_ExtrapInterp(fp, ModName, "Input", "InputType", "DbKi"); + gen_ExtrapInterp(fp, ModName, "Output", "OutputType", "DbKi"); } fprintf(fp,"END MODULE %s_Types\n",ModName->name ) ; @@ -2406,6 +2364,15 @@ char * dimstr( int d ) retval = " REGISTRY ERROR TOO MANY DIMS " ; } return(retval) ; + + //strcpy(dex, ""); + //strcat(dex, "("); + //for (j = 1; j <= d; j++) { + // sprintf(tmp, "i%d%d", 0, j); + // strcat(dex, tmp); + // if (j == d) strcat(dex, ")"); else strcat(dex, ","); + //} + } char * dimstr_c( int d ) diff --git a/modules/openfast-registry/src/reg_parse.c b/modules/openfast-registry/src/reg_parse.c index 0ec9f3c7db..37d457abc2 100644 --- a/modules/openfast-registry/src/reg_parse.c +++ b/modules/openfast-registry/src/reg_parse.c @@ -95,7 +95,7 @@ pre_parse( char * dir, FILE * infile, FILE * outfile, int usefrom_sw ) // See if it might be in the current directory sprintf( include_file_name , "%s", p ) ; // first name in line from registry file, without the include or usefrom for ( p2 = include_file_name ; !( *p2 == ' ' || *p2 == '\t' || *p2 == '\n' ) && *p2 != '\0' ; p2++ ) {} - *p2 = '\0' ; // drop tailing white space + *p2 = '\0' ; // drop tailing white space if ( (q=index(include_file_name,'\n')) != NULL ) *q = '\0' ; if (( include_fp = fopen( include_file_name , "r" )) != NULL ) { foundit = 1 ; goto gotit ; } @@ -269,7 +269,7 @@ pre_parse( char * dir, FILE * infile, FILE * outfile, int usefrom_sw ) -normal: +//normal: /* otherwise output the line as is */ fprintf(outfile,"%s\n",parseline_save) ; parseline[0] = '\0' ; /* reset parseline */ @@ -284,8 +284,8 @@ reg_parse( FILE * infile ) /* Had to increase size for SOA from 4096 to 7000, Manish Shrivastava 2010 */ char inln[INLN_SIZE], parseline[PARSELINE_SIZE] ; char *p ; - char *tokens[MAXTOKENS], *ditto[MAXTOKENS] ; - int i ; + char *tokens[MAXTOKENS],*ditto[MAXTOKENS] ; + int i ; int defining_state_field, defining_rconfig_field, defining_i1_field ; parseline[0] = '\0' ; @@ -449,7 +449,6 @@ reg_parse( FILE * infile ) strcpy(field_struct->units,"-") ; if ( strcmp( tokens[FIELD_UNITS], "-" ) ) /* that is, if not equal "-" */ { strcpy( field_struct->units , tokens[FIELD_UNITS] ) ; } - #ifdef OVERSTRICT if ( field_struct->type != NULL ) if ( field_struct->type->type_type == DERIVED && field_struct->ndims > 0 ) @@ -615,27 +614,19 @@ set_dim_len ( char * dimspec , node_t * dim_entry ) int set_ctrl( char *ctrl , node_t * field_struct ) -// process CTRL keys -- only 'h' (hidden) and 'e' (exposed). Default is not to generate a wrapper, -// so something must be specified, either h or e +// process CTRL keys -- only '2pi' (interpolation of values with 2pi period). Default is no special interpolation. { - char prev = '\0' ; - char x ; char tmp[NAMELEN] ; char *p ; - int i ; strcpy(tmp,ctrl) ; if (( p = index(tmp,'=') ) != NULL ) { *p = '\0' ; } - for ( i = 0 ; i < strlen(tmp) ; i++ ) - { - x = tolower(tmp[i]) ; - if ( x == 'h' ) { - field_struct->gen_wrapper = WRAP_HIDDEN_FIELD ; - } else if ( x == 'e' ) { - field_struct->gen_wrapper = WRAP_EXPOSED_FIELD ; - } else { - field_struct->gen_wrapper = WRAP_NONE ; /* default */ - } + if (!strcmp(make_lower_temp(tmp), "2pi")) { + field_struct->gen_periodic = PERIOD_2PI; + } + else { + field_struct->gen_periodic = PERIOD_NONE; } + return(0) ; } diff --git a/modules/openfast-registry/src/registry.h b/modules/openfast-registry/src/registry.h index 0356025fb2..524bbe7e1a 100644 --- a/modules/openfast-registry/src/registry.h +++ b/modules/openfast-registry/src/registry.h @@ -23,9 +23,9 @@ enum type_type { SIMPLE , DERIVED } ; enum proc_orient { ALL_Z_ON_PROC , ALL_X_ON_PROC , ALL_Y_ON_PROC } ; /* wrapping options */ -#define WRAP_HIDDEN_FIELD 2 -#define WRAP_EXPOSED_FIELD 1 -#define WRAP_NONE 0 +#define PERIOD_2PI 2 +#define PERIOD_OTHER 1 +#define PERIOD_NONE 0 /* node_kind mask settings */ From 2cd45dd8ca1cfeb2e0a62743fb37476c6ff6a1a3 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Tue, 12 Nov 2019 10:43:20 -0700 Subject: [PATCH 04/72] fix syntax in UnsteadyAero.vfproj file --- vs-build/UnsteadyAero/UnsteadyAero.vfproj | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vs-build/UnsteadyAero/UnsteadyAero.vfproj b/vs-build/UnsteadyAero/UnsteadyAero.vfproj index 7e4cfda8f0..93f686c979 100644 --- a/vs-build/UnsteadyAero/UnsteadyAero.vfproj +++ b/vs-build/UnsteadyAero/UnsteadyAero.vfproj @@ -111,7 +111,7 @@ - + From 118db2dd03266c72d1a02386e1ecd401c30da3b6 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Thu, 14 Nov 2019 21:51:31 -0700 Subject: [PATCH 05/72] Update Registry and NWTC Library - Use less stack space in interpolation/extrapolation, pack, and unpack routines (fixes https://github.com/OpenFAST/openfast/issues/99). - update auto-generated types files - update interp/extrap routines work on angles (over 2pi boundaries); this requires Angles_ExtrapInterp routines added to NWTC Library - NWTC Library + when reading real variables from file, check that they aren't Inf or NaN + remove unused code + add error handling to VTK read routines + check that size of scalars matches between meshes in transfer of data + add an (optional) reference node to mesh data structures --- modules/aerodyn/src/AeroDyn_Types.f90 | 2016 ++- modules/aerodyn/src/AirfoilInfo_Types.f90 | 1078 +- modules/aerodyn/src/BEMT_Types.f90 | 1884 ++- modules/aerodyn/src/DBEMT_Types.f90 | 598 +- modules/aerodyn/src/UnsteadyAero_Types.f90 | 1985 ++- modules/aerodyn14/src/AeroDyn14_Types.f90 | 5097 ++++--- modules/aerodyn14/src/DWM_Types.f90 | 2850 ++-- modules/beamdyn/src/BeamDyn_Types.f90 | 4091 +++--- modules/elastodyn/src/ElastoDyn_Types.f90 | 11488 ++++++++-------- modules/extptfm/src/ExtPtfm_MCKF_Types.f90 | 459 +- modules/feamooring/src/FEAMooring_Types.f90 | 2654 ++-- modules/hydrodyn/src/Conv_Radiation_Types.f90 | 451 +- modules/hydrodyn/src/Current_Types.f90 | 355 +- modules/hydrodyn/src/HydroDyn_Types.f90 | 1267 +- modules/hydrodyn/src/Morison_Types.f90 | 3361 +++-- modules/hydrodyn/src/SS_Excitation_Types.f90 | 523 +- modules/hydrodyn/src/SS_Radiation_Types.f90 | 473 +- modules/hydrodyn/src/WAMIT2_Types.f90 | 870 +- modules/hydrodyn/src/WAMIT_Types.f90 | 823 +- modules/hydrodyn/src/Waves2_Types.f90 | 1094 +- modules/hydrodyn/src/Waves_Types.f90 | 1083 +- modules/icedyn/src/IceDyn_Types.f90 | 1513 +- modules/icefloe/src/icefloe/IceFloe_Types.f90 | 469 +- modules/inflowwind/src/IfW_4Dext_Types.f90 | 181 +- .../inflowwind/src/IfW_BladedFFWind_Types.f90 | 309 +- modules/inflowwind/src/IfW_HAWCWind_Types.f90 | 443 +- modules/inflowwind/src/IfW_TSFFWind_Types.f90 | 282 +- .../inflowwind/src/IfW_UniformWind_Types.f90 | 353 +- modules/inflowwind/src/IfW_UserWind_Types.f90 | 56 +- modules/inflowwind/src/InflowWind_Types.f90 | 1483 +- modules/inflowwind/src/Lidar_Types.f90 | 519 +- modules/map/src/MAP_Fortran_Types.f90 | 122 +- modules/map/src/MAP_Types.f90 | 2018 +-- modules/moordyn/src/MoorDyn_Types.f90 | 1535 +-- modules/nwtc-library/src/ModMesh.f90 | 67 +- modules/nwtc-library/src/ModMesh_Mapping.f90 | 29 +- modules/nwtc-library/src/ModMesh_Types.f90 | 1 + modules/nwtc-library/src/NWTC_IO.f90 | 286 +- modules/nwtc-library/src/NWTC_Num.f90 | 600 +- modules/openfast-library/src/FAST_Types.f90 | 2578 ++-- modules/openfast-registry/src/Makefile | 67 - modules/openfast-registry/src/data.h | 2 +- modules/openfast-registry/src/gen_c_types.c | 7 +- .../openfast-registry/src/gen_module_files.c | 613 +- modules/openfast-registry/src/reg_parse.c | 31 +- modules/openfast-registry/src/registry.h | 6 +- modules/openfoam/src/OpenFOAM_Types.f90 | 1838 +-- .../src/OrcaFlexInterface_Types.f90 | 459 +- modules/servodyn/src/ServoDyn_Types.f90 | 3321 +++-- modules/servodyn/src/TMD_Types.f90 | 969 +- modules/subdyn/src/SubDyn_Types.f90 | 2833 ++-- .../src/SuperController_Types.f90 | 360 +- 52 files changed, 32683 insertions(+), 35167 deletions(-) delete mode 100644 modules/openfast-registry/src/Makefile diff --git a/modules/aerodyn/src/AeroDyn_Types.f90 b/modules/aerodyn/src/AeroDyn_Types.f90 index 223b9724fc..4fc49e4e75 100644 --- a/modules/aerodyn/src/AeroDyn_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Types.f90 @@ -391,24 +391,30 @@ SUBROUTINE AD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Linearize , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumBlades - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%HubPosition))-1 ) = PACK(InData%HubPosition,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%HubPosition) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%HubOrientation))-1 ) = PACK(InData%HubOrientation,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%HubOrientation) + DO I = 1, LEN(InData%InputFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%Linearize, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumBlades + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Gravity + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO i1 = LBOUND(InData%HubPosition,1), UBOUND(InData%HubPosition,1) + ReKiBuf(Re_Xferred) = InData%HubPosition(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i2 = LBOUND(InData%HubOrientation,2), UBOUND(InData%HubOrientation,2) + DO i1 = LBOUND(InData%HubOrientation,1), UBOUND(InData%HubOrientation,1) + DbKiBuf(Db_Xferred) = InData%HubOrientation(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO IF ( .NOT. ALLOCATED(InData%BladeRootPosition) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -422,8 +428,12 @@ SUBROUTINE AD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootPosition,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BladeRootPosition)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BladeRootPosition))-1 ) = PACK(InData%BladeRootPosition,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BladeRootPosition) + DO i2 = LBOUND(InData%BladeRootPosition,2), UBOUND(InData%BladeRootPosition,2) + DO i1 = LBOUND(InData%BladeRootPosition,1), UBOUND(InData%BladeRootPosition,1) + ReKiBuf(Re_Xferred) = InData%BladeRootPosition(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%BladeRootOrientation) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -441,8 +451,14 @@ SUBROUTINE AD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootOrientation,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BladeRootOrientation)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%BladeRootOrientation))-1 ) = PACK(InData%BladeRootOrientation,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%BladeRootOrientation) + DO i3 = LBOUND(InData%BladeRootOrientation,3), UBOUND(InData%BladeRootOrientation,3) + DO i2 = LBOUND(InData%BladeRootOrientation,2), UBOUND(InData%BladeRootOrientation,2) + DO i1 = LBOUND(InData%BladeRootOrientation,1), UBOUND(InData%BladeRootOrientation,1) + DbKiBuf(Db_Xferred) = InData%BladeRootOrientation(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF END SUBROUTINE AD_PackInitInput @@ -459,12 +475,6 @@ SUBROUTINE AD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -482,44 +492,36 @@ SUBROUTINE AD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%Linearize = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NumBlades = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%Gravity = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%InputFile) + OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%Linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%Linearize) + Int_Xferred = Int_Xferred + 1 + OutData%NumBlades = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Gravity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I i1_l = LBOUND(OutData%HubPosition,1) i1_u = UBOUND(OutData%HubPosition,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%HubPosition = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%HubPosition))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%HubPosition) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%HubPosition,1), UBOUND(OutData%HubPosition,1) + OutData%HubPosition(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%HubOrientation,1) i1_u = UBOUND(OutData%HubOrientation,1) i2_l = LBOUND(OutData%HubOrientation,2) i2_u = UBOUND(OutData%HubOrientation,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%HubOrientation = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%HubOrientation))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%HubOrientation) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%HubOrientation,2), UBOUND(OutData%HubOrientation,2) + DO i1 = LBOUND(OutData%HubOrientation,1), UBOUND(OutData%HubOrientation,1) + OutData%HubOrientation(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeRootPosition not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -536,15 +538,12 @@ SUBROUTINE AD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootPosition.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%BladeRootPosition)>0) OutData%BladeRootPosition = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BladeRootPosition))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BladeRootPosition) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%BladeRootPosition,2), UBOUND(OutData%BladeRootPosition,2) + DO i1 = LBOUND(OutData%BladeRootPosition,1), UBOUND(OutData%BladeRootPosition,1) + OutData%BladeRootPosition(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeRootOrientation not allocated Int_Xferred = Int_Xferred + 1 @@ -565,15 +564,14 @@ SUBROUTINE AD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootOrientation.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%BladeRootOrientation)>0) OutData%BladeRootOrientation = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%BladeRootOrientation))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%BladeRootOrientation) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%BladeRootOrientation,3), UBOUND(OutData%BladeRootOrientation,3) + DO i2 = LBOUND(OutData%BladeRootOrientation,2), UBOUND(OutData%BladeRootOrientation,2) + DO i1 = LBOUND(OutData%BladeRootOrientation,1), UBOUND(OutData%BladeRootOrientation,1) + OutData%BladeRootOrientation(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF END SUBROUTINE AD_UnPackInitInput @@ -809,8 +807,8 @@ SUBROUTINE AD_PackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumBlNds - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumBlNds + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%BlSpn) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -821,8 +819,10 @@ SUBROUTINE AD_PackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlSpn,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BlSpn)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlSpn))-1 ) = PACK(InData%BlSpn,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlSpn) + DO i1 = LBOUND(InData%BlSpn,1), UBOUND(InData%BlSpn,1) + ReKiBuf(Re_Xferred) = InData%BlSpn(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%BlCrvAC) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -834,8 +834,10 @@ SUBROUTINE AD_PackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlCrvAC,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BlCrvAC)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlCrvAC))-1 ) = PACK(InData%BlCrvAC,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlCrvAC) + DO i1 = LBOUND(InData%BlCrvAC,1), UBOUND(InData%BlCrvAC,1) + ReKiBuf(Re_Xferred) = InData%BlCrvAC(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%BlSwpAC) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -847,8 +849,10 @@ SUBROUTINE AD_PackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlSwpAC,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BlSwpAC)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlSwpAC))-1 ) = PACK(InData%BlSwpAC,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlSwpAC) + DO i1 = LBOUND(InData%BlSwpAC,1), UBOUND(InData%BlSwpAC,1) + ReKiBuf(Re_Xferred) = InData%BlSwpAC(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%BlCrvAng) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -860,8 +864,10 @@ SUBROUTINE AD_PackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlCrvAng,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BlCrvAng)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlCrvAng))-1 ) = PACK(InData%BlCrvAng,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlCrvAng) + DO i1 = LBOUND(InData%BlCrvAng,1), UBOUND(InData%BlCrvAng,1) + ReKiBuf(Re_Xferred) = InData%BlCrvAng(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%BlTwist) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -873,8 +879,10 @@ SUBROUTINE AD_PackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlTwist,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BlTwist)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlTwist))-1 ) = PACK(InData%BlTwist,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlTwist) + DO i1 = LBOUND(InData%BlTwist,1), UBOUND(InData%BlTwist,1) + ReKiBuf(Re_Xferred) = InData%BlTwist(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%BlChord) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -886,8 +894,10 @@ SUBROUTINE AD_PackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlChord,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BlChord)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlChord))-1 ) = PACK(InData%BlChord,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlChord) + DO i1 = LBOUND(InData%BlChord,1), UBOUND(InData%BlChord,1) + ReKiBuf(Re_Xferred) = InData%BlChord(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%BlAFID) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -899,8 +909,10 @@ SUBROUTINE AD_PackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlAFID,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BlAFID)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%BlAFID))-1 ) = PACK(InData%BlAFID,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%BlAFID) + DO i1 = LBOUND(InData%BlAFID,1), UBOUND(InData%BlAFID,1) + IntKiBuf(Int_Xferred) = InData%BlAFID(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF END SUBROUTINE AD_PackBladePropsType @@ -917,12 +929,6 @@ SUBROUTINE AD_UnPackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -937,8 +943,8 @@ SUBROUTINE AD_UnPackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%NumBlNds = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NumBlNds = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlSpn not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -952,15 +958,10 @@ SUBROUTINE AD_UnPackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlSpn.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BlSpn)>0) OutData%BlSpn = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlSpn))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlSpn) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BlSpn,1), UBOUND(OutData%BlSpn,1) + OutData%BlSpn(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlCrvAC not allocated Int_Xferred = Int_Xferred + 1 @@ -975,15 +976,10 @@ SUBROUTINE AD_UnPackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlCrvAC.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BlCrvAC)>0) OutData%BlCrvAC = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlCrvAC))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlCrvAC) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BlCrvAC,1), UBOUND(OutData%BlCrvAC,1) + OutData%BlCrvAC(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlSwpAC not allocated Int_Xferred = Int_Xferred + 1 @@ -998,15 +994,10 @@ SUBROUTINE AD_UnPackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlSwpAC.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BlSwpAC)>0) OutData%BlSwpAC = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlSwpAC))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlSwpAC) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BlSwpAC,1), UBOUND(OutData%BlSwpAC,1) + OutData%BlSwpAC(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlCrvAng not allocated Int_Xferred = Int_Xferred + 1 @@ -1021,15 +1012,10 @@ SUBROUTINE AD_UnPackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlCrvAng.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BlCrvAng)>0) OutData%BlCrvAng = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlCrvAng))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlCrvAng) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BlCrvAng,1), UBOUND(OutData%BlCrvAng,1) + OutData%BlCrvAng(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlTwist not allocated Int_Xferred = Int_Xferred + 1 @@ -1044,15 +1030,10 @@ SUBROUTINE AD_UnPackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlTwist.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BlTwist)>0) OutData%BlTwist = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlTwist))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlTwist) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BlTwist,1), UBOUND(OutData%BlTwist,1) + OutData%BlTwist(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlChord not allocated Int_Xferred = Int_Xferred + 1 @@ -1067,15 +1048,10 @@ SUBROUTINE AD_UnPackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlChord.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BlChord)>0) OutData%BlChord = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlChord))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlChord) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BlChord,1), UBOUND(OutData%BlChord,1) + OutData%BlChord(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlAFID not allocated Int_Xferred = Int_Xferred + 1 @@ -1090,15 +1066,10 @@ SUBROUTINE AD_UnPackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlAFID.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BlAFID)>0) OutData%BlAFID = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%BlAFID))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%BlAFID) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BlAFID,1), UBOUND(OutData%BlAFID,1) + OutData%BlAFID(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF END SUBROUTINE AD_UnPackBladePropsType @@ -1234,8 +1205,14 @@ SUBROUTINE AD_PackBladeShape( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AirfoilCoords,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AirfoilCoords)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AirfoilCoords))-1 ) = PACK(InData%AirfoilCoords,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AirfoilCoords) + DO i3 = LBOUND(InData%AirfoilCoords,3), UBOUND(InData%AirfoilCoords,3) + DO i2 = LBOUND(InData%AirfoilCoords,2), UBOUND(InData%AirfoilCoords,2) + DO i1 = LBOUND(InData%AirfoilCoords,1), UBOUND(InData%AirfoilCoords,1) + ReKiBuf(Re_Xferred) = InData%AirfoilCoords(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF END SUBROUTINE AD_PackBladeShape @@ -1252,12 +1229,6 @@ SUBROUTINE AD_UnPackBladeShape( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -1293,15 +1264,14 @@ SUBROUTINE AD_UnPackBladeShape( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AirfoilCoords.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%AirfoilCoords)>0) OutData%AirfoilCoords = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AirfoilCoords))-1 ), mask3, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%AirfoilCoords) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%AirfoilCoords,3), UBOUND(OutData%AirfoilCoords,3) + DO i2 = LBOUND(OutData%AirfoilCoords,2), UBOUND(OutData%AirfoilCoords,2) + DO i1 = LBOUND(OutData%AirfoilCoords,1), UBOUND(OutData%AirfoilCoords,1) + OutData%AirfoilCoords(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF END SUBROUTINE AD_UnPackBladeShape @@ -1739,12 +1709,12 @@ SUBROUTINE AD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) + DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) DO I = 1, LEN(InData%WriteOutputHdr) IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdr(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1756,12 +1726,12 @@ SUBROUTINE AD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) + DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) DO I = 1, LEN(InData%WriteOutputUnt) IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUnt(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1791,8 +1761,8 @@ SUBROUTINE AD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AirDens - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AirDens + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%BladeShape) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1844,12 +1814,12 @@ SUBROUTINE AD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_y,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%LinNames_y,1), UBOUND(InData%LinNames_y,1) + DO i1 = LBOUND(InData%LinNames_y,1), UBOUND(InData%LinNames_y,1) DO I = 1, LEN(InData%LinNames_y) IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_y(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LinNames_z) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1861,12 +1831,12 @@ SUBROUTINE AD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_z,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%LinNames_z,1), UBOUND(InData%LinNames_z,1) + DO i1 = LBOUND(InData%LinNames_z,1), UBOUND(InData%LinNames_z,1) DO I = 1, LEN(InData%LinNames_z) IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_z(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LinNames_u) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1878,12 +1848,12 @@ SUBROUTINE AD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_u,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%LinNames_u,1), UBOUND(InData%LinNames_u,1) + DO i1 = LBOUND(InData%LinNames_u,1), UBOUND(InData%LinNames_u,1) DO I = 1, LEN(InData%LinNames_u) IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_u(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%RotFrame_y) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1895,8 +1865,10 @@ SUBROUTINE AD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_y,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RotFrame_y)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%RotFrame_y)-1 ) = TRANSFER(PACK( InData%RotFrame_y ,.TRUE.), IntKiBuf(1), SIZE(InData%RotFrame_y)) - Int_Xferred = Int_Xferred + SIZE(InData%RotFrame_y) + DO i1 = LBOUND(InData%RotFrame_y,1), UBOUND(InData%RotFrame_y,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_y(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%RotFrame_z) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1908,8 +1880,10 @@ SUBROUTINE AD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_z,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RotFrame_z)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%RotFrame_z)-1 ) = TRANSFER(PACK( InData%RotFrame_z ,.TRUE.), IntKiBuf(1), SIZE(InData%RotFrame_z)) - Int_Xferred = Int_Xferred + SIZE(InData%RotFrame_z) + DO i1 = LBOUND(InData%RotFrame_z,1), UBOUND(InData%RotFrame_z,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_z(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%RotFrame_u) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1921,8 +1895,10 @@ SUBROUTINE AD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_u,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RotFrame_u)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%RotFrame_u)-1 ) = TRANSFER(PACK( InData%RotFrame_u ,.TRUE.), IntKiBuf(1), SIZE(InData%RotFrame_u)) - Int_Xferred = Int_Xferred + SIZE(InData%RotFrame_u) + DO i1 = LBOUND(InData%RotFrame_u,1), UBOUND(InData%RotFrame_u,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_u(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%IsLoad_u) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1934,8 +1910,10 @@ SUBROUTINE AD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IsLoad_u,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%IsLoad_u)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%IsLoad_u)-1 ) = TRANSFER(PACK( InData%IsLoad_u ,.TRUE.), IntKiBuf(1), SIZE(InData%IsLoad_u)) - Int_Xferred = Int_Xferred + SIZE(InData%IsLoad_u) + DO i1 = LBOUND(InData%IsLoad_u,1), UBOUND(InData%IsLoad_u,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%IsLoad_u(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%BladeProps) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1988,8 +1966,10 @@ SUBROUTINE AD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrElev,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwrElev)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwrElev))-1 ) = PACK(InData%TwrElev,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwrElev) + DO i1 = LBOUND(InData%TwrElev,1), UBOUND(InData%TwrElev,1) + ReKiBuf(Re_Xferred) = InData%TwrElev(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TwrDiam) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2001,8 +1981,10 @@ SUBROUTINE AD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrDiam,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwrDiam)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwrDiam))-1 ) = PACK(InData%TwrDiam,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwrDiam) + DO i1 = LBOUND(InData%TwrDiam,1), UBOUND(InData%TwrDiam,1) + ReKiBuf(Re_Xferred) = InData%TwrDiam(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE AD_PackInitOutput @@ -2019,12 +2001,6 @@ SUBROUTINE AD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -2052,19 +2028,12 @@ SUBROUTINE AD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) DO I = 1, LEN(OutData%WriteOutputHdr) OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated Int_Xferred = Int_Xferred + 1 @@ -2079,19 +2048,12 @@ SUBROUTINE AD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) DO I = 1, LEN(OutData%WriteOutputUnt) OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -2133,8 +2095,8 @@ SUBROUTINE AD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%AirDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%AirDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeShape not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2204,19 +2166,12 @@ SUBROUTINE AD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%LinNames_y,1), UBOUND(OutData%LinNames_y,1) + DO i1 = LBOUND(OutData%LinNames_y,1), UBOUND(OutData%LinNames_y,1) DO I = 1, LEN(OutData%LinNames_y) OutData%LinNames_y(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_z not allocated Int_Xferred = Int_Xferred + 1 @@ -2231,19 +2186,12 @@ SUBROUTINE AD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_z.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%LinNames_z,1), UBOUND(OutData%LinNames_z,1) + DO i1 = LBOUND(OutData%LinNames_z,1), UBOUND(OutData%LinNames_z,1) DO I = 1, LEN(OutData%LinNames_z) OutData%LinNames_z(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_u not allocated Int_Xferred = Int_Xferred + 1 @@ -2258,19 +2206,12 @@ SUBROUTINE AD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%LinNames_u,1), UBOUND(OutData%LinNames_u,1) + DO i1 = LBOUND(OutData%LinNames_u,1), UBOUND(OutData%LinNames_u,1) DO I = 1, LEN(OutData%LinNames_u) OutData%LinNames_u(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_y not allocated Int_Xferred = Int_Xferred + 1 @@ -2285,15 +2226,10 @@ SUBROUTINE AD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RotFrame_y)>0) OutData%RotFrame_y = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%RotFrame_y))-1 ), OutData%RotFrame_y), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%RotFrame_y) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%RotFrame_y,1), UBOUND(OutData%RotFrame_y,1) + OutData%RotFrame_y(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_y(i1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_z not allocated Int_Xferred = Int_Xferred + 1 @@ -2308,15 +2244,10 @@ SUBROUTINE AD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_z.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RotFrame_z)>0) OutData%RotFrame_z = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%RotFrame_z))-1 ), OutData%RotFrame_z), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%RotFrame_z) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%RotFrame_z,1), UBOUND(OutData%RotFrame_z,1) + OutData%RotFrame_z(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_z(i1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_u not allocated Int_Xferred = Int_Xferred + 1 @@ -2331,15 +2262,10 @@ SUBROUTINE AD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RotFrame_u)>0) OutData%RotFrame_u = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%RotFrame_u))-1 ), OutData%RotFrame_u), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%RotFrame_u) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%RotFrame_u,1), UBOUND(OutData%RotFrame_u,1) + OutData%RotFrame_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_u(i1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IsLoad_u not allocated Int_Xferred = Int_Xferred + 1 @@ -2354,15 +2280,10 @@ SUBROUTINE AD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%IsLoad_u)>0) OutData%IsLoad_u = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%IsLoad_u))-1 ), OutData%IsLoad_u), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%IsLoad_u) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%IsLoad_u,1), UBOUND(OutData%IsLoad_u,1) + OutData%IsLoad_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsLoad_u(i1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeProps not allocated Int_Xferred = Int_Xferred + 1 @@ -2433,15 +2354,10 @@ SUBROUTINE AD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrElev.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwrElev)>0) OutData%TwrElev = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwrElev))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwrElev) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwrElev,1), UBOUND(OutData%TwrElev,1) + OutData%TwrElev(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrDiam not allocated Int_Xferred = Int_Xferred + 1 @@ -2456,15 +2372,10 @@ SUBROUTINE AD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrDiam.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwrDiam)>0) OutData%TwrDiam = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwrDiam))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwrDiam) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwrDiam,1), UBOUND(OutData%TwrDiam,1) + OutData%TwrDiam(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE AD_UnPackInitOutput @@ -2788,70 +2699,70 @@ SUBROUTINE AD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DTAero - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WakeMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%AFAeroMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TwrPotent - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TwrShadow , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TwrAero , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%FrozenWake , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%CavitCheck , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AirDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%KinVisc - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Patm - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Pvap - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FluidDepth - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SpdSound - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%SkewMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SkewModFactor - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TipLoss , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%HubLoss , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TanInd , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%AIDrag , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TIDrag , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%IndToler - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MaxIter - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UAMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%FLookup , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%InCol_Alfa - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%InCol_Cl - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%InCol_Cd - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%InCol_Cm - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%InCol_Cpmin - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%AFTabMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumAFfiles - Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DTAero + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WakeMod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%AFAeroMod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TwrPotent + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TwrShadow, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TwrAero, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%FrozenWake, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%CavitCheck, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AirDens + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%KinVisc + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Patm + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Pvap + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FluidDepth + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SpdSound + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%SkewMod + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SkewModFactor + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TipLoss, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%HubLoss, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TanInd, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%AIDrag, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TIDrag, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%IndToler + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MaxIter + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%UAMod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%FLookup, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%InCol_Alfa + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%InCol_Cl + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%InCol_Cd + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%InCol_Cm + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%InCol_Cpmin + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%AFTabMod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumAFfiles + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%AFNames) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2862,15 +2773,15 @@ SUBROUTINE AD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFNames,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%AFNames,1), UBOUND(InData%AFNames,1) + DO i1 = LBOUND(InData%AFNames,1), UBOUND(InData%AFNames,1) DO I = 1, LEN(InData%AFNames) IntKiBuf(Int_Xferred) = ICHAR(InData%AFNames(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%UseBlCm , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%UseBlCm, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%BladeProps) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2912,8 +2823,8 @@ SUBROUTINE AD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumTwrNds - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumTwrNds + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%TwrElev) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2924,8 +2835,10 @@ SUBROUTINE AD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrElev,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwrElev)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwrElev))-1 ) = PACK(InData%TwrElev,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwrElev) + DO i1 = LBOUND(InData%TwrElev,1), UBOUND(InData%TwrElev,1) + ReKiBuf(Re_Xferred) = InData%TwrElev(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TwrDiam) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2937,8 +2850,10 @@ SUBROUTINE AD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrDiam,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwrDiam)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwrDiam))-1 ) = PACK(InData%TwrDiam,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwrDiam) + DO i1 = LBOUND(InData%TwrDiam,1), UBOUND(InData%TwrDiam,1) + ReKiBuf(Re_Xferred) = InData%TwrDiam(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TwrCd) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2950,21 +2865,27 @@ SUBROUTINE AD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrCd,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwrCd)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwrCd))-1 ) = PACK(InData%TwrCd,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwrCd) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%SumPrint , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NBlOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%BlOutNd))-1 ) = PACK(InData%BlOutNd,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%BlOutNd) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NTwOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%TwOutNd))-1 ) = PACK(InData%TwOutNd,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%TwOutNd) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%TwrCd,1), UBOUND(InData%TwrCd,1) + ReKiBuf(Re_Xferred) = InData%TwrCd(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = TRANSFER(InData%SumPrint, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NBlOuts + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%BlOutNd,1), UBOUND(InData%BlOutNd,1) + IntKiBuf(Int_Xferred) = InData%BlOutNd(i1) + Int_Xferred = Int_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%NTwOuts + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%TwOutNd,1), UBOUND(InData%TwOutNd,1) + IntKiBuf(Int_Xferred) = InData%TwOutNd(i1) + Int_Xferred = Int_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%OutList) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2975,17 +2896,17 @@ SUBROUTINE AD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutList,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) + DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) DO I = 1, LEN(InData%OutList) IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%tau1_const - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DBEMT_Mod - Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%tau1_const + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DBEMT_Mod + Int_Xferred = Int_Xferred + 1 END SUBROUTINE AD_PackInputFile SUBROUTINE AD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -3001,12 +2922,6 @@ SUBROUTINE AD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -3021,70 +2936,70 @@ SUBROUTINE AD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DTAero = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%WakeMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%AFAeroMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TwrPotent = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TwrShadow = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%TwrAero = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%FrozenWake = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%CavitCheck = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%AirDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%KinVisc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Patm = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Pvap = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%FluidDepth = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SpdSound = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SkewMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%SkewModFactor = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TipLoss = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%HubLoss = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%TanInd = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%AIDrag = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%TIDrag = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%IndToler = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MaxIter = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%UAMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%FLookup = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%InCol_Alfa = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%InCol_Cl = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%InCol_Cd = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%InCol_Cm = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%InCol_Cpmin = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%AFTabMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumAFfiles = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%DTAero = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%WakeMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%AFAeroMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TwrPotent = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TwrShadow = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwrShadow) + Int_Xferred = Int_Xferred + 1 + OutData%TwrAero = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwrAero) + Int_Xferred = Int_Xferred + 1 + OutData%FrozenWake = TRANSFER(IntKiBuf(Int_Xferred), OutData%FrozenWake) + Int_Xferred = Int_Xferred + 1 + OutData%CavitCheck = TRANSFER(IntKiBuf(Int_Xferred), OutData%CavitCheck) + Int_Xferred = Int_Xferred + 1 + OutData%AirDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%KinVisc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Patm = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Pvap = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%FluidDepth = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SpdSound = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SkewMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%SkewModFactor = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TipLoss = TRANSFER(IntKiBuf(Int_Xferred), OutData%TipLoss) + Int_Xferred = Int_Xferred + 1 + OutData%HubLoss = TRANSFER(IntKiBuf(Int_Xferred), OutData%HubLoss) + Int_Xferred = Int_Xferred + 1 + OutData%TanInd = TRANSFER(IntKiBuf(Int_Xferred), OutData%TanInd) + Int_Xferred = Int_Xferred + 1 + OutData%AIDrag = TRANSFER(IntKiBuf(Int_Xferred), OutData%AIDrag) + Int_Xferred = Int_Xferred + 1 + OutData%TIDrag = TRANSFER(IntKiBuf(Int_Xferred), OutData%TIDrag) + Int_Xferred = Int_Xferred + 1 + OutData%IndToler = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MaxIter = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%UAMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%FLookup = TRANSFER(IntKiBuf(Int_Xferred), OutData%FLookup) + Int_Xferred = Int_Xferred + 1 + OutData%InCol_Alfa = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%InCol_Cl = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%InCol_Cd = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%InCol_Cm = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%InCol_Cpmin = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AFTabMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumAFfiles = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AFNames not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3098,22 +3013,15 @@ SUBROUTINE AD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFNames.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%AFNames,1), UBOUND(OutData%AFNames,1) + DO i1 = LBOUND(OutData%AFNames,1), UBOUND(OutData%AFNames,1) DO I = 1, LEN(OutData%AFNames) OutData%AFNames(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF - OutData%UseBlCm = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%UseBlCm = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseBlCm) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeProps not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3170,8 +3078,8 @@ SUBROUTINE AD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%NumTwrNds = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NumTwrNds = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrElev not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3185,15 +3093,10 @@ SUBROUTINE AD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrElev.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwrElev)>0) OutData%TwrElev = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwrElev))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwrElev) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwrElev,1), UBOUND(OutData%TwrElev,1) + OutData%TwrElev(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrDiam not allocated Int_Xferred = Int_Xferred + 1 @@ -3208,15 +3111,10 @@ SUBROUTINE AD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrDiam.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwrDiam)>0) OutData%TwrDiam = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwrDiam))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwrDiam) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwrDiam,1), UBOUND(OutData%TwrDiam,1) + OutData%TwrDiam(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrCd not allocated Int_Xferred = Int_Xferred + 1 @@ -3231,46 +3129,31 @@ SUBROUTINE AD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrCd.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwrCd)>0) OutData%TwrCd = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwrCd))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwrCd) - DEALLOCATE(mask1) - END IF - OutData%SumPrint = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NBlOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%TwrCd,1), UBOUND(OutData%TwrCd,1) + OutData%TwrCd(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%SumPrint = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumPrint) + Int_Xferred = Int_Xferred + 1 + OutData%NBlOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%BlOutNd,1) i1_u = UBOUND(OutData%BlOutNd,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%BlOutNd = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%BlOutNd))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%BlOutNd) - DEALLOCATE(mask1) - OutData%NTwOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%BlOutNd,1), UBOUND(OutData%BlOutNd,1) + OutData%BlOutNd(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + OutData%NTwOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%TwOutNd,1) i1_u = UBOUND(OutData%TwOutNd,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%TwOutNd = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%TwOutNd))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%TwOutNd) - DEALLOCATE(mask1) - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%TwOutNd,1), UBOUND(OutData%TwOutNd,1) + OutData%TwOutNd(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutList not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3284,24 +3167,17 @@ SUBROUTINE AD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) + DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) DO I = 1, LEN(OutData%OutList) OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF - OutData%tau1_const = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%DBEMT_Mod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%tau1_const = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%DBEMT_Mod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE AD_UnPackInputFile SUBROUTINE AD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) @@ -3458,12 +3334,6 @@ SUBROUTINE AD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD_UnPackContState' @@ -3673,12 +3543,6 @@ SUBROUTINE AD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD_UnPackDiscState' @@ -3888,12 +3752,6 @@ SUBROUTINE AD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD_UnPackConstrState' @@ -4103,12 +3961,6 @@ SUBROUTINE AD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD_UnPackOtherState' @@ -4807,8 +4659,14 @@ SUBROUTINE AD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DisturbedInflow,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DisturbedInflow)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DisturbedInflow))-1 ) = PACK(InData%DisturbedInflow,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DisturbedInflow) + DO i3 = LBOUND(InData%DisturbedInflow,3), UBOUND(InData%DisturbedInflow,3) + DO i2 = LBOUND(InData%DisturbedInflow,2), UBOUND(InData%DisturbedInflow,2) + DO i1 = LBOUND(InData%DisturbedInflow,1), UBOUND(InData%DisturbedInflow,1) + ReKiBuf(Re_Xferred) = InData%DisturbedInflow(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WithoutSweepPitchTwist) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4829,8 +4687,16 @@ SUBROUTINE AD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WithoutSweepPitchTwist,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WithoutSweepPitchTwist)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WithoutSweepPitchTwist))-1 ) = PACK(InData%WithoutSweepPitchTwist,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WithoutSweepPitchTwist) + DO i4 = LBOUND(InData%WithoutSweepPitchTwist,4), UBOUND(InData%WithoutSweepPitchTwist,4) + DO i3 = LBOUND(InData%WithoutSweepPitchTwist,3), UBOUND(InData%WithoutSweepPitchTwist,3) + DO i2 = LBOUND(InData%WithoutSweepPitchTwist,2), UBOUND(InData%WithoutSweepPitchTwist,2) + DO i1 = LBOUND(InData%WithoutSweepPitchTwist,1), UBOUND(InData%WithoutSweepPitchTwist,1) + ReKiBuf(Re_Xferred) = InData%WithoutSweepPitchTwist(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%AllOuts) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4842,8 +4708,10 @@ SUBROUTINE AD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AllOuts,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AllOuts)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AllOuts))-1 ) = PACK(InData%AllOuts,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AllOuts) + DO i1 = LBOUND(InData%AllOuts,1), UBOUND(InData%AllOuts,1) + ReKiBuf(Re_Xferred) = InData%AllOuts(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%W_Twr) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4855,8 +4723,10 @@ SUBROUTINE AD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%W_Twr,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%W_Twr)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%W_Twr))-1 ) = PACK(InData%W_Twr,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%W_Twr) + DO i1 = LBOUND(InData%W_Twr,1), UBOUND(InData%W_Twr,1) + ReKiBuf(Re_Xferred) = InData%W_Twr(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%X_Twr) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4868,8 +4738,10 @@ SUBROUTINE AD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X_Twr,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%X_Twr)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%X_Twr))-1 ) = PACK(InData%X_Twr,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%X_Twr) + DO i1 = LBOUND(InData%X_Twr,1), UBOUND(InData%X_Twr,1) + ReKiBuf(Re_Xferred) = InData%X_Twr(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%Y_Twr) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4881,8 +4753,10 @@ SUBROUTINE AD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Y_Twr,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Y_Twr)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Y_Twr))-1 ) = PACK(InData%Y_Twr,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Y_Twr) + DO i1 = LBOUND(InData%Y_Twr,1), UBOUND(InData%Y_Twr,1) + ReKiBuf(Re_Xferred) = InData%Y_Twr(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%Curve) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4897,8 +4771,12 @@ SUBROUTINE AD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Curve,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Curve)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Curve))-1 ) = PACK(InData%Curve,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Curve) + DO i2 = LBOUND(InData%Curve,2), UBOUND(InData%Curve,2) + DO i1 = LBOUND(InData%Curve,1), UBOUND(InData%Curve,1) + ReKiBuf(Re_Xferred) = InData%Curve(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%TwrClrnc) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4913,8 +4791,12 @@ SUBROUTINE AD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrClrnc,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwrClrnc)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwrClrnc))-1 ) = PACK(InData%TwrClrnc,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwrClrnc) + DO i2 = LBOUND(InData%TwrClrnc,2), UBOUND(InData%TwrClrnc,2) + DO i1 = LBOUND(InData%TwrClrnc,1), UBOUND(InData%TwrClrnc,1) + ReKiBuf(Re_Xferred) = InData%TwrClrnc(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%X) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4929,8 +4811,12 @@ SUBROUTINE AD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%X)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%X))-1 ) = PACK(InData%X,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%X) + DO i2 = LBOUND(InData%X,2), UBOUND(InData%X,2) + DO i1 = LBOUND(InData%X,1), UBOUND(InData%X,1) + ReKiBuf(Re_Xferred) = InData%X(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Y) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4945,8 +4831,12 @@ SUBROUTINE AD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Y,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Y)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Y))-1 ) = PACK(InData%Y,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Y) + DO i2 = LBOUND(InData%Y,2), UBOUND(InData%Y,2) + DO i1 = LBOUND(InData%Y,1), UBOUND(InData%Y,1) + ReKiBuf(Re_Xferred) = InData%Y(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%M) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4961,15 +4851,23 @@ SUBROUTINE AD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%M)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%M))-1 ) = PACK(InData%M,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%M) + DO i2 = LBOUND(InData%M,2), UBOUND(InData%M,2) + DO i1 = LBOUND(InData%M,1), UBOUND(InData%M,1) + ReKiBuf(Re_Xferred) = InData%M(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%V_DiskAvg))-1 ) = PACK(InData%V_DiskAvg,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%V_DiskAvg) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%hub_theta_x_root))-1 ) = PACK(InData%hub_theta_x_root,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%hub_theta_x_root) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%V_dot_x - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%V_DiskAvg,1), UBOUND(InData%V_DiskAvg,1) + ReKiBuf(Re_Xferred) = InData%V_DiskAvg(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%hub_theta_x_root,1), UBOUND(InData%hub_theta_x_root,1) + ReKiBuf(Re_Xferred) = InData%hub_theta_x_root(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%V_dot_x + Re_Xferred = Re_Xferred + 1 CALL MeshPack( InData%HubLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! HubLoad CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -5052,8 +4950,12 @@ SUBROUTINE AD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SigmaCavitCrit,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%SigmaCavitCrit)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SigmaCavitCrit))-1 ) = PACK(InData%SigmaCavitCrit,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SigmaCavitCrit) + DO i2 = LBOUND(InData%SigmaCavitCrit,2), UBOUND(InData%SigmaCavitCrit,2) + DO i1 = LBOUND(InData%SigmaCavitCrit,1), UBOUND(InData%SigmaCavitCrit,1) + ReKiBuf(Re_Xferred) = InData%SigmaCavitCrit(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%SigmaCavit) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5068,8 +4970,12 @@ SUBROUTINE AD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SigmaCavit,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%SigmaCavit)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SigmaCavit))-1 ) = PACK(InData%SigmaCavit,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SigmaCavit) + DO i2 = LBOUND(InData%SigmaCavit,2), UBOUND(InData%SigmaCavit,2) + DO i1 = LBOUND(InData%SigmaCavit,1), UBOUND(InData%SigmaCavit,1) + ReKiBuf(Re_Xferred) = InData%SigmaCavit(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%CavitWarnSet) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5084,8 +4990,12 @@ SUBROUTINE AD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CavitWarnSet,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CavitWarnSet)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%CavitWarnSet)-1 ) = TRANSFER(PACK( InData%CavitWarnSet ,.TRUE.), IntKiBuf(1), SIZE(InData%CavitWarnSet)) - Int_Xferred = Int_Xferred + SIZE(InData%CavitWarnSet) + DO i2 = LBOUND(InData%CavitWarnSet,2), UBOUND(InData%CavitWarnSet,2) + DO i1 = LBOUND(InData%CavitWarnSet,1), UBOUND(InData%CavitWarnSet,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%CavitWarnSet(i1,i2), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF END SUBROUTINE AD_PackMisc @@ -5102,12 +5012,6 @@ SUBROUTINE AD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -5268,15 +5172,14 @@ SUBROUTINE AD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DisturbedInflow.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%DisturbedInflow)>0) OutData%DisturbedInflow = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DisturbedInflow))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DisturbedInflow) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%DisturbedInflow,3), UBOUND(OutData%DisturbedInflow,3) + DO i2 = LBOUND(OutData%DisturbedInflow,2), UBOUND(OutData%DisturbedInflow,2) + DO i1 = LBOUND(OutData%DisturbedInflow,1), UBOUND(OutData%DisturbedInflow,1) + OutData%DisturbedInflow(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 ! WithoutSweepPitchTwist not allocated Int_Xferred = Int_Xferred + 1 @@ -5300,15 +5203,16 @@ SUBROUTINE AD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WithoutSweepPitchTwist.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%WithoutSweepPitchTwist)>0) OutData%WithoutSweepPitchTwist = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WithoutSweepPitchTwist))-1 ), mask4, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WithoutSweepPitchTwist) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%WithoutSweepPitchTwist,4), UBOUND(OutData%WithoutSweepPitchTwist,4) + DO i3 = LBOUND(OutData%WithoutSweepPitchTwist,3), UBOUND(OutData%WithoutSweepPitchTwist,3) + DO i2 = LBOUND(OutData%WithoutSweepPitchTwist,2), UBOUND(OutData%WithoutSweepPitchTwist,2) + DO i1 = LBOUND(OutData%WithoutSweepPitchTwist,1), UBOUND(OutData%WithoutSweepPitchTwist,1) + OutData%WithoutSweepPitchTwist(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AllOuts not allocated Int_Xferred = Int_Xferred + 1 @@ -5323,15 +5227,10 @@ SUBROUTINE AD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOuts.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%AllOuts)>0) OutData%AllOuts = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AllOuts))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AllOuts) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AllOuts,1), UBOUND(OutData%AllOuts,1) + OutData%AllOuts(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! W_Twr not allocated Int_Xferred = Int_Xferred + 1 @@ -5346,15 +5245,10 @@ SUBROUTINE AD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%W_Twr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%W_Twr)>0) OutData%W_Twr = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%W_Twr))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%W_Twr) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%W_Twr,1), UBOUND(OutData%W_Twr,1) + OutData%W_Twr(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! X_Twr not allocated Int_Xferred = Int_Xferred + 1 @@ -5369,15 +5263,10 @@ SUBROUTINE AD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%X_Twr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%X_Twr)>0) OutData%X_Twr = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%X_Twr))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%X_Twr) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%X_Twr,1), UBOUND(OutData%X_Twr,1) + OutData%X_Twr(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Y_Twr not allocated Int_Xferred = Int_Xferred + 1 @@ -5392,15 +5281,10 @@ SUBROUTINE AD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y_Twr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Y_Twr)>0) OutData%Y_Twr = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Y_Twr))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Y_Twr) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Y_Twr,1), UBOUND(OutData%Y_Twr,1) + OutData%Y_Twr(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Curve not allocated Int_Xferred = Int_Xferred + 1 @@ -5418,15 +5302,12 @@ SUBROUTINE AD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Curve.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Curve)>0) OutData%Curve = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Curve))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Curve) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Curve,2), UBOUND(OutData%Curve,2) + DO i1 = LBOUND(OutData%Curve,1), UBOUND(OutData%Curve,1) + OutData%Curve(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrClrnc not allocated Int_Xferred = Int_Xferred + 1 @@ -5444,15 +5325,12 @@ SUBROUTINE AD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrClrnc.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%TwrClrnc)>0) OutData%TwrClrnc = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwrClrnc))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwrClrnc) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%TwrClrnc,2), UBOUND(OutData%TwrClrnc,2) + DO i1 = LBOUND(OutData%TwrClrnc,1), UBOUND(OutData%TwrClrnc,1) + OutData%TwrClrnc(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! X not allocated Int_Xferred = Int_Xferred + 1 @@ -5470,15 +5348,12 @@ SUBROUTINE AD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%X.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%X)>0) OutData%X = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%X))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%X) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%X,2), UBOUND(OutData%X,2) + DO i1 = LBOUND(OutData%X,1), UBOUND(OutData%X,1) + OutData%X(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Y not allocated Int_Xferred = Int_Xferred + 1 @@ -5496,15 +5371,12 @@ SUBROUTINE AD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Y)>0) OutData%Y = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Y))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Y) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Y,2), UBOUND(OutData%Y,2) + DO i1 = LBOUND(OutData%Y,1), UBOUND(OutData%Y,1) + OutData%Y(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! M not allocated Int_Xferred = Int_Xferred + 1 @@ -5522,40 +5394,27 @@ SUBROUTINE AD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%M.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%M)>0) OutData%M = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%M))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%M) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%M,2), UBOUND(OutData%M,2) + DO i1 = LBOUND(OutData%M,1), UBOUND(OutData%M,1) + OutData%M(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF i1_l = LBOUND(OutData%V_DiskAvg,1) i1_u = UBOUND(OutData%V_DiskAvg,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%V_DiskAvg = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%V_DiskAvg))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%V_DiskAvg) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%V_DiskAvg,1), UBOUND(OutData%V_DiskAvg,1) + OutData%V_DiskAvg(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%hub_theta_x_root,1) i1_u = UBOUND(OutData%hub_theta_x_root,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%hub_theta_x_root = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%hub_theta_x_root))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%hub_theta_x_root) - DEALLOCATE(mask1) - OutData%V_dot_x = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%hub_theta_x_root,1), UBOUND(OutData%hub_theta_x_root,1) + OutData%hub_theta_x_root(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%V_dot_x = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -5668,15 +5527,12 @@ SUBROUTINE AD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SigmaCavitCrit.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%SigmaCavitCrit)>0) OutData%SigmaCavitCrit = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SigmaCavitCrit))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SigmaCavitCrit) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%SigmaCavitCrit,2), UBOUND(OutData%SigmaCavitCrit,2) + DO i1 = LBOUND(OutData%SigmaCavitCrit,1), UBOUND(OutData%SigmaCavitCrit,1) + OutData%SigmaCavitCrit(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SigmaCavit not allocated Int_Xferred = Int_Xferred + 1 @@ -5694,15 +5550,12 @@ SUBROUTINE AD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SigmaCavit.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%SigmaCavit)>0) OutData%SigmaCavit = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SigmaCavit))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SigmaCavit) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%SigmaCavit,2), UBOUND(OutData%SigmaCavit,2) + DO i1 = LBOUND(OutData%SigmaCavit,1), UBOUND(OutData%SigmaCavit,1) + OutData%SigmaCavit(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CavitWarnSet not allocated Int_Xferred = Int_Xferred + 1 @@ -5720,15 +5573,12 @@ SUBROUTINE AD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CavitWarnSet.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%CavitWarnSet)>0) OutData%CavitWarnSet = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%CavitWarnSet))-1 ), OutData%CavitWarnSet), mask2,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%CavitWarnSet) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%CavitWarnSet,2), UBOUND(OutData%CavitWarnSet,2) + DO i1 = LBOUND(OutData%CavitWarnSet,1), UBOUND(OutData%CavitWarnSet,1) + OutData%CavitWarnSet(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%CavitWarnSet(i1,i2)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF END SUBROUTINE AD_UnPackMisc @@ -6065,26 +5915,26 @@ SUBROUTINE AD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WakeMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TwrPotent - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TwrShadow , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TwrAero , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%FrozenWake , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%CavitCheck , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumBlades - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumBlNds - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumTwrNds - Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WakeMod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TwrPotent + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TwrShadow, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TwrAero, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%FrozenWake, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%CavitCheck, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumBlades + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumBlNds + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumTwrNds + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%TwrDiam) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -6095,8 +5945,10 @@ SUBROUTINE AD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrDiam,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwrDiam)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwrDiam))-1 ) = PACK(InData%TwrDiam,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwrDiam) + DO i1 = LBOUND(InData%TwrDiam,1), UBOUND(InData%TwrDiam,1) + ReKiBuf(Re_Xferred) = InData%TwrDiam(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TwrCd) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6108,23 +5960,25 @@ SUBROUTINE AD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrCd,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwrCd)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwrCd))-1 ) = PACK(InData%TwrCd,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwrCd) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AirDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%KinVisc - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SpdSound - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Patm - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Pvap - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FluidDepth - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%TwrCd,1), UBOUND(InData%TwrCd,1) + ReKiBuf(Re_Xferred) = InData%TwrCd(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%AirDens + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%KinVisc + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SpdSound + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Gravity + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Patm + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Pvap + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FluidDepth + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%AFI) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -6194,12 +6048,12 @@ SUBROUTINE AD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -6241,14 +6095,18 @@ SUBROUTINE AD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NBlOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%BlOutNd))-1 ) = PACK(InData%BlOutNd,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%BlOutNd) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NTwOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%TwOutNd))-1 ) = PACK(InData%TwOutNd,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%TwOutNd) + IntKiBuf(Int_Xferred) = InData%NBlOuts + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%BlOutNd,1), UBOUND(InData%BlOutNd,1) + IntKiBuf(Int_Xferred) = InData%BlOutNd(i1) + Int_Xferred = Int_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%NTwOuts + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%TwOutNd,1), UBOUND(InData%TwOutNd,1) + IntKiBuf(Int_Xferred) = InData%TwOutNd(i1) + Int_Xferred = Int_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%Jac_u_indx) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -6262,8 +6120,12 @@ SUBROUTINE AD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Jac_u_indx)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%Jac_u_indx))-1 ) = PACK(InData%Jac_u_indx,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%Jac_u_indx) + DO i2 = LBOUND(InData%Jac_u_indx,2), UBOUND(InData%Jac_u_indx,2) + DO i1 = LBOUND(InData%Jac_u_indx,1), UBOUND(InData%Jac_u_indx,1) + IntKiBuf(Int_Xferred) = InData%Jac_u_indx(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%du) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6275,11 +6137,13 @@ SUBROUTINE AD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%du,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%du)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%du))-1 ) = PACK(InData%du,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%du) + DO i1 = LBOUND(InData%du,1), UBOUND(InData%du,1) + ReKiBuf(Re_Xferred) = InData%du(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Jac_ny - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Jac_ny + Int_Xferred = Int_Xferred + 1 END SUBROUTINE AD_PackParam SUBROUTINE AD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -6295,12 +6159,6 @@ SUBROUTINE AD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -6316,26 +6174,26 @@ SUBROUTINE AD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%WakeMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TwrPotent = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TwrShadow = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%TwrAero = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%FrozenWake = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%CavitCheck = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NumBlades = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumBlNds = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumTwrNds = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%WakeMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TwrPotent = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TwrShadow = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwrShadow) + Int_Xferred = Int_Xferred + 1 + OutData%TwrAero = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwrAero) + Int_Xferred = Int_Xferred + 1 + OutData%FrozenWake = TRANSFER(IntKiBuf(Int_Xferred), OutData%FrozenWake) + Int_Xferred = Int_Xferred + 1 + OutData%CavitCheck = TRANSFER(IntKiBuf(Int_Xferred), OutData%CavitCheck) + Int_Xferred = Int_Xferred + 1 + OutData%NumBlades = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumBlNds = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumTwrNds = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrDiam not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -6349,15 +6207,10 @@ SUBROUTINE AD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrDiam.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwrDiam)>0) OutData%TwrDiam = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwrDiam))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwrDiam) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwrDiam,1), UBOUND(OutData%TwrDiam,1) + OutData%TwrDiam(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrCd not allocated Int_Xferred = Int_Xferred + 1 @@ -6372,30 +6225,25 @@ SUBROUTINE AD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrCd.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwrCd)>0) OutData%TwrCd = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwrCd))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwrCd) - DEALLOCATE(mask1) - END IF - OutData%AirDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%KinVisc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SpdSound = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Gravity = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Patm = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Pvap = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%FluidDepth = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%TwrCd,1), UBOUND(OutData%TwrCd,1) + OutData%TwrCd(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%AirDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%KinVisc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SpdSound = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Gravity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Patm = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Pvap = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%FluidDepth = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AFI not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -6492,12 +6340,12 @@ SUBROUTINE AD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -6554,32 +6402,22 @@ SUBROUTINE AD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%NBlOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NBlOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%BlOutNd,1) i1_u = UBOUND(OutData%BlOutNd,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%BlOutNd = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%BlOutNd))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%BlOutNd) - DEALLOCATE(mask1) - OutData%NTwOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%BlOutNd,1), UBOUND(OutData%BlOutNd,1) + OutData%BlOutNd(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + OutData%NTwOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%TwOutNd,1) i1_u = UBOUND(OutData%TwOutNd,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%TwOutNd = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%TwOutNd))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%TwOutNd) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwOutNd,1), UBOUND(OutData%TwOutNd,1) + OutData%TwOutNd(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_u_indx not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -6596,15 +6434,12 @@ SUBROUTINE AD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Jac_u_indx)>0) OutData%Jac_u_indx = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%Jac_u_indx))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%Jac_u_indx) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Jac_u_indx,2), UBOUND(OutData%Jac_u_indx,2) + DO i1 = LBOUND(OutData%Jac_u_indx,1), UBOUND(OutData%Jac_u_indx,1) + OutData%Jac_u_indx(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! du not allocated Int_Xferred = Int_Xferred + 1 @@ -6619,18 +6454,13 @@ SUBROUTINE AD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%du.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%du)>0) OutData%du = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%du))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%du) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%du,1), UBOUND(OutData%du,1) + OutData%du(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%Jac_ny = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%Jac_ny = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE AD_UnPackParam SUBROUTINE AD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -7080,8 +6910,14 @@ SUBROUTINE AD_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InflowOnBlade,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%InflowOnBlade)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%InflowOnBlade))-1 ) = PACK(InData%InflowOnBlade,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%InflowOnBlade) + DO i3 = LBOUND(InData%InflowOnBlade,3), UBOUND(InData%InflowOnBlade,3) + DO i2 = LBOUND(InData%InflowOnBlade,2), UBOUND(InData%InflowOnBlade,2) + DO i1 = LBOUND(InData%InflowOnBlade,1), UBOUND(InData%InflowOnBlade,1) + ReKiBuf(Re_Xferred) = InData%InflowOnBlade(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%InflowOnTower) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7096,8 +6932,12 @@ SUBROUTINE AD_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InflowOnTower,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%InflowOnTower)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%InflowOnTower))-1 ) = PACK(InData%InflowOnTower,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%InflowOnTower) + DO i2 = LBOUND(InData%InflowOnTower,2), UBOUND(InData%InflowOnTower,2) + DO i1 = LBOUND(InData%InflowOnTower,1), UBOUND(InData%InflowOnTower,1) + ReKiBuf(Re_Xferred) = InData%InflowOnTower(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%UserProp) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7112,8 +6952,12 @@ SUBROUTINE AD_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UserProp,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%UserProp)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%UserProp))-1 ) = PACK(InData%UserProp,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%UserProp) + DO i2 = LBOUND(InData%UserProp,2), UBOUND(InData%UserProp,2) + DO i1 = LBOUND(InData%UserProp,1), UBOUND(InData%UserProp,1) + ReKiBuf(Re_Xferred) = InData%UserProp(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE AD_PackInput @@ -7130,12 +6974,6 @@ SUBROUTINE AD_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -7363,15 +7201,14 @@ SUBROUTINE AD_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InflowOnBlade.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%InflowOnBlade)>0) OutData%InflowOnBlade = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%InflowOnBlade))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%InflowOnBlade) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%InflowOnBlade,3), UBOUND(OutData%InflowOnBlade,3) + DO i2 = LBOUND(OutData%InflowOnBlade,2), UBOUND(OutData%InflowOnBlade,2) + DO i1 = LBOUND(OutData%InflowOnBlade,1), UBOUND(OutData%InflowOnBlade,1) + OutData%InflowOnBlade(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 ! InflowOnTower not allocated Int_Xferred = Int_Xferred + 1 @@ -7389,15 +7226,12 @@ SUBROUTINE AD_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InflowOnTower.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%InflowOnTower)>0) OutData%InflowOnTower = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%InflowOnTower))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%InflowOnTower) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%InflowOnTower,2), UBOUND(OutData%InflowOnTower,2) + DO i1 = LBOUND(OutData%InflowOnTower,1), UBOUND(OutData%InflowOnTower,1) + OutData%InflowOnTower(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 @@ -7415,15 +7249,12 @@ SUBROUTINE AD_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UserProp.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%UserProp)>0) OutData%UserProp = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%UserProp))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%UserProp) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%UserProp,2), UBOUND(OutData%UserProp,2) + DO i1 = LBOUND(OutData%UserProp,1), UBOUND(OutData%UserProp,1) + OutData%UserProp(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE AD_UnPackInput @@ -7683,8 +7514,10 @@ SUBROUTINE AD_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WriteOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE AD_PackOutput @@ -7701,12 +7534,6 @@ SUBROUTINE AD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -7830,15 +7657,10 @@ SUBROUTINE AD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WriteOutput)>0) OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE AD_UnPackOutput @@ -7917,17 +7739,16 @@ SUBROUTINE AD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'AD_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: b3 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: c3 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! 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 :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + INTEGER :: i3 ! dim3 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -7940,47 +7761,49 @@ SUBROUTINE AD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(u1%TowerMotion, u2%TowerMotion, tin, u_out%TowerMotion, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL MeshExtrapInterp1(u1%HubMotion, u2%HubMotion, tin, u_out%HubMotion, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(u_out%BladeRootMotion) .AND. ALLOCATED(u1%BladeRootMotion)) THEN - DO i01 = LBOUND(u_out%BladeRootMotion,1),UBOUND(u_out%BladeRootMotion,1) - CALL MeshExtrapInterp1(u1%BladeRootMotion(i01), u2%BladeRootMotion(i01), tin, u_out%BladeRootMotion(i01), tin_out, ErrStat2, ErrMsg2 ) + 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) ENDDO END IF ! check if allocated IF (ALLOCATED(u_out%BladeMotion) .AND. ALLOCATED(u1%BladeMotion)) THEN - DO i01 = LBOUND(u_out%BladeMotion,1),UBOUND(u_out%BladeMotion,1) - CALL MeshExtrapInterp1(u1%BladeMotion(i01), u2%BladeMotion(i01), tin, u_out%BladeMotion(i01), tin_out, ErrStat2, ErrMsg2 ) + 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) ENDDO END IF ! check if allocated IF (ALLOCATED(u_out%InflowOnBlade) .AND. ALLOCATED(u1%InflowOnBlade)) THEN - ALLOCATE(b3(SIZE(u_out%InflowOnBlade,1),SIZE(u_out%InflowOnBlade,2), & - SIZE(u_out%InflowOnBlade,3) )) - ALLOCATE(c3(SIZE(u_out%InflowOnBlade,1),SIZE(u_out%InflowOnBlade,2), & - SIZE(u_out%InflowOnBlade,3) )) - b3 = -(u1%InflowOnBlade - u2%InflowOnBlade)/t(2) - u_out%InflowOnBlade = u1%InflowOnBlade + b3 * t_out - DEALLOCATE(b3) - DEALLOCATE(c3) + DO i3 = LBOUND(u_out%InflowOnBlade,3),UBOUND(u_out%InflowOnBlade,3) + DO i2 = LBOUND(u_out%InflowOnBlade,2),UBOUND(u_out%InflowOnBlade,2) + DO i1 = LBOUND(u_out%InflowOnBlade,1),UBOUND(u_out%InflowOnBlade,1) + b = -(u1%InflowOnBlade(i1,i2,i3) - u2%InflowOnBlade(i1,i2,i3)) + u_out%InflowOnBlade(i1,i2,i3) = u1%InflowOnBlade(i1,i2,i3) + b * ScaleFactor + END DO + END DO + END DO END IF ! check if allocated IF (ALLOCATED(u_out%InflowOnTower) .AND. ALLOCATED(u1%InflowOnTower)) THEN - ALLOCATE(b2(SIZE(u_out%InflowOnTower,1),SIZE(u_out%InflowOnTower,2) )) - ALLOCATE(c2(SIZE(u_out%InflowOnTower,1),SIZE(u_out%InflowOnTower,2) )) - b2 = -(u1%InflowOnTower - u2%InflowOnTower)/t(2) - u_out%InflowOnTower = u1%InflowOnTower + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%InflowOnTower,2),UBOUND(u_out%InflowOnTower,2) + DO i1 = LBOUND(u_out%InflowOnTower,1),UBOUND(u_out%InflowOnTower,1) + b = -(u1%InflowOnTower(i1,i2) - u2%InflowOnTower(i1,i2)) + u_out%InflowOnTower(i1,i2) = u1%InflowOnTower(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated IF (ALLOCATED(u_out%UserProp) .AND. ALLOCATED(u1%UserProp)) THEN - ALLOCATE(b2(SIZE(u_out%UserProp,1),SIZE(u_out%UserProp,2) )) - ALLOCATE(c2(SIZE(u_out%UserProp,1),SIZE(u_out%UserProp,2) )) - b2 = -(u1%UserProp - u2%UserProp)/t(2) - u_out%UserProp = u1%UserProp + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%UserProp,2),UBOUND(u_out%UserProp,2) + DO i1 = LBOUND(u_out%UserProp,1),UBOUND(u_out%UserProp,1) + b = -(u1%UserProp(i1,i2) - u2%UserProp(i1,i2)) + u_out%UserProp(i1,i2) = u1%UserProp(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated END SUBROUTINE AD_Input_ExtrapInterp1 @@ -8011,18 +7834,18 @@ SUBROUTINE AD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: b3 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: c3 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'AD_Input_ExtrapInterp2' INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + INTEGER :: i3 ! dim3 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -8041,50 +7864,52 @@ SUBROUTINE AD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(u1%TowerMotion, u2%TowerMotion, u3%TowerMotion, tin, u_out%TowerMotion, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL MeshExtrapInterp2(u1%HubMotion, u2%HubMotion, u3%HubMotion, tin, u_out%HubMotion, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(u_out%BladeRootMotion) .AND. ALLOCATED(u1%BladeRootMotion)) THEN - DO i01 = LBOUND(u_out%BladeRootMotion,1),UBOUND(u_out%BladeRootMotion,1) - CALL MeshExtrapInterp2(u1%BladeRootMotion(i01), u2%BladeRootMotion(i01), u3%BladeRootMotion(i01), tin, u_out%BladeRootMotion(i01), tin_out, ErrStat2, ErrMsg2 ) + 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) ENDDO END IF ! check if allocated IF (ALLOCATED(u_out%BladeMotion) .AND. ALLOCATED(u1%BladeMotion)) THEN - DO i01 = LBOUND(u_out%BladeMotion,1),UBOUND(u_out%BladeMotion,1) - CALL MeshExtrapInterp2(u1%BladeMotion(i01), u2%BladeMotion(i01), u3%BladeMotion(i01), tin, u_out%BladeMotion(i01), tin_out, ErrStat2, ErrMsg2 ) + 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) ENDDO END IF ! check if allocated IF (ALLOCATED(u_out%InflowOnBlade) .AND. ALLOCATED(u1%InflowOnBlade)) THEN - ALLOCATE(b3(SIZE(u_out%InflowOnBlade,1),SIZE(u_out%InflowOnBlade,2), & - SIZE(u_out%InflowOnBlade,3) )) - ALLOCATE(c3(SIZE(u_out%InflowOnBlade,1),SIZE(u_out%InflowOnBlade,2), & - SIZE(u_out%InflowOnBlade,3) )) - b3 = (t(3)**2*(u1%InflowOnBlade - u2%InflowOnBlade) + t(2)**2*(-u1%InflowOnBlade + u3%InflowOnBlade))/(t(2)*t(3)*(t(2) - t(3))) - c3 = ( (t(2)-t(3))*u1%InflowOnBlade + t(3)*u2%InflowOnBlade - t(2)*u3%InflowOnBlade ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%InflowOnBlade = u1%InflowOnBlade + b3 * t_out + c3 * t_out**2 - DEALLOCATE(b3) - DEALLOCATE(c3) + DO i3 = LBOUND(u_out%InflowOnBlade,3),UBOUND(u_out%InflowOnBlade,3) + DO i2 = LBOUND(u_out%InflowOnBlade,2),UBOUND(u_out%InflowOnBlade,2) + DO i1 = LBOUND(u_out%InflowOnBlade,1),UBOUND(u_out%InflowOnBlade,1) + b = (t(3)**2*(u1%InflowOnBlade(i1,i2,i3) - u2%InflowOnBlade(i1,i2,i3)) + t(2)**2*(-u1%InflowOnBlade(i1,i2,i3) + u3%InflowOnBlade(i1,i2,i3)))* scaleFactor + c = ( (t(2)-t(3))*u1%InflowOnBlade(i1,i2,i3) + t(3)*u2%InflowOnBlade(i1,i2,i3) - t(2)*u3%InflowOnBlade(i1,i2,i3) ) * scaleFactor + u_out%InflowOnBlade(i1,i2,i3) = u1%InflowOnBlade(i1,i2,i3) + b + c * t_out + END DO + END DO + END DO END IF ! check if allocated IF (ALLOCATED(u_out%InflowOnTower) .AND. ALLOCATED(u1%InflowOnTower)) THEN - ALLOCATE(b2(SIZE(u_out%InflowOnTower,1),SIZE(u_out%InflowOnTower,2) )) - ALLOCATE(c2(SIZE(u_out%InflowOnTower,1),SIZE(u_out%InflowOnTower,2) )) - b2 = (t(3)**2*(u1%InflowOnTower - u2%InflowOnTower) + t(2)**2*(-u1%InflowOnTower + u3%InflowOnTower))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%InflowOnTower + t(3)*u2%InflowOnTower - t(2)*u3%InflowOnTower ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%InflowOnTower = u1%InflowOnTower + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%InflowOnTower,2),UBOUND(u_out%InflowOnTower,2) + DO i1 = LBOUND(u_out%InflowOnTower,1),UBOUND(u_out%InflowOnTower,1) + b = (t(3)**2*(u1%InflowOnTower(i1,i2) - u2%InflowOnTower(i1,i2)) + t(2)**2*(-u1%InflowOnTower(i1,i2) + u3%InflowOnTower(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%InflowOnTower(i1,i2) + t(3)*u2%InflowOnTower(i1,i2) - t(2)*u3%InflowOnTower(i1,i2) ) * scaleFactor + u_out%InflowOnTower(i1,i2) = u1%InflowOnTower(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated IF (ALLOCATED(u_out%UserProp) .AND. ALLOCATED(u1%UserProp)) THEN - ALLOCATE(b2(SIZE(u_out%UserProp,1),SIZE(u_out%UserProp,2) )) - ALLOCATE(c2(SIZE(u_out%UserProp,1),SIZE(u_out%UserProp,2) )) - b2 = (t(3)**2*(u1%UserProp - u2%UserProp) + t(2)**2*(-u1%UserProp + u3%UserProp))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%UserProp + t(3)*u2%UserProp - t(2)*u3%UserProp ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%UserProp = u1%UserProp + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%UserProp,2),UBOUND(u_out%UserProp,2) + DO i1 = LBOUND(u_out%UserProp,1),UBOUND(u_out%UserProp,1) + b = (t(3)**2*(u1%UserProp(i1,i2) - u2%UserProp(i1,i2)) + t(2)**2*(-u1%UserProp(i1,i2) + u3%UserProp(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%UserProp(i1,i2) + t(3)*u2%UserProp(i1,i2) - t(2)*u3%UserProp(i1,i2) ) * scaleFactor + u_out%UserProp(i1,i2) = u1%UserProp(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated END SUBROUTINE AD_Input_ExtrapInterp2 @@ -8163,13 +7988,12 @@ SUBROUTINE AD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'AD_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! 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 :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -8182,21 +8006,21 @@ SUBROUTINE AD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) 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 i01 = LBOUND(y_out%BladeLoad,1),UBOUND(y_out%BladeLoad,1) - CALL MeshExtrapInterp1(y1%BladeLoad(i01), y2%BladeLoad(i01), tin, y_out%BladeLoad(i01), tin_out, ErrStat2, ErrMsg2 ) + 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) ENDDO END IF ! check if allocated IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END IF ! check if allocated END SUBROUTINE AD_Output_ExtrapInterp1 @@ -8227,14 +8051,14 @@ SUBROUTINE AD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'AD_Output_ExtrapInterp2' INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -8253,22 +8077,22 @@ SUBROUTINE AD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) 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 i01 = LBOUND(y_out%BladeLoad,1),UBOUND(y_out%BladeLoad,1) - CALL MeshExtrapInterp2(y1%BladeLoad(i01), y2%BladeLoad(i01), y3%BladeLoad(i01), tin, y_out%BladeLoad(i01), tin_out, ErrStat2, ErrMsg2 ) + 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) ENDDO END IF ! check if allocated IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END IF ! check if allocated END SUBROUTINE AD_Output_ExtrapInterp2 diff --git a/modules/aerodyn/src/AirfoilInfo_Types.f90 b/modules/aerodyn/src/AirfoilInfo_Types.f90 index 0e78d0faf9..b278b1e95b 100644 --- a/modules/aerodyn/src/AirfoilInfo_Types.f90 +++ b/modules/aerodyn/src/AirfoilInfo_Types.f90 @@ -292,70 +292,70 @@ SUBROUTINE AFI_PackUA_BL_Type( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%alpha0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%alpha1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%alpha2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%eta_e - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%C_nalpha - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%T_f0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%T_V0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%T_p - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%T_VL - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%b1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%b2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%b5 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%A1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%A2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%A5 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%S1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%S2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%S3 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%S4 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cn1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cn2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%St_sh - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cd0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cm0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%k0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%k1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%k2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%k3 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%k1_hat - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%x_cp_bar - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%UACutout - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%filtCutOff - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%alpha0 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%alpha1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%alpha2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%eta_e + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%C_nalpha + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%T_f0 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%T_V0 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%T_p + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%T_VL + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%b1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%b2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%b5 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%A1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%A2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%A5 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%S1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%S2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%S3 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%S4 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cn1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cn2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%St_sh + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cd0 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cm0 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k0 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k3 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k1_hat + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%x_cp_bar + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%UACutout + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%filtCutOff + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AFI_PackUA_BL_Type SUBROUTINE AFI_UnPackUA_BL_Type( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -371,12 +371,6 @@ SUBROUTINE AFI_UnPackUA_BL_Type( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -393,70 +387,70 @@ SUBROUTINE AFI_UnPackUA_BL_Type( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%alpha0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%alpha1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%alpha2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%eta_e = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%C_nalpha = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%T_f0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%T_V0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%T_p = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%T_VL = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%b1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%b2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%b5 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%A1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%A2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%A5 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%S1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%S2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%S3 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%S4 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cn1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cn2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%St_sh = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cd0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cm0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%k0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%k1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%k2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%k3 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%k1_hat = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%x_cp_bar = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%UACutout = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%filtCutOff = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%alpha0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%alpha1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%alpha2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%eta_e = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%C_nalpha = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%T_f0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%T_V0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%T_p = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%T_VL = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%b1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%b2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%b5 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%A1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%A2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%A5 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%S1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%S2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%S3 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%S4 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cn1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cn2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%St_sh = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cd0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cm0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%k0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%k1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%k2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%k3 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%k1_hat = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%x_cp_bar = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%UACutout = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%filtCutOff = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AFI_UnPackUA_BL_Type SUBROUTINE AFI_CopyTable_Type( SrcTable_TypeData, DstTable_TypeData, CtrlCode, ErrStat, ErrMsg ) @@ -659,8 +653,10 @@ SUBROUTINE AFI_PackTable_Type( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Alpha,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Alpha)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Alpha))-1 ) = PACK(InData%Alpha,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Alpha) + DO i1 = LBOUND(InData%Alpha,1), UBOUND(InData%Alpha,1) + ReKiBuf(Re_Xferred) = InData%Alpha(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%Coefs) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -675,8 +671,12 @@ SUBROUTINE AFI_PackTable_Type( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Coefs,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Coefs)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Coefs))-1 ) = PACK(InData%Coefs,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Coefs) + DO i2 = LBOUND(InData%Coefs,2), UBOUND(InData%Coefs,2) + DO i1 = LBOUND(InData%Coefs,1), UBOUND(InData%Coefs,1) + ReKiBuf(Re_Xferred) = InData%Coefs(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%SplineCoefs) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -694,19 +694,25 @@ SUBROUTINE AFI_PackTable_Type( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SplineCoefs,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%SplineCoefs)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SplineCoefs))-1 ) = PACK(InData%SplineCoefs,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SplineCoefs) + DO i3 = LBOUND(InData%SplineCoefs,3), UBOUND(InData%SplineCoefs,3) + DO i2 = LBOUND(InData%SplineCoefs,2), UBOUND(InData%SplineCoefs,2) + DO i1 = LBOUND(InData%SplineCoefs,1), UBOUND(InData%SplineCoefs,1) + ReKiBuf(Re_Xferred) = InData%SplineCoefs(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%UserProp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Re - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumAlf - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%ConstData , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%InclUAdata , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%UserProp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Re + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumAlf + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%ConstData, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%InclUAdata, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 CALL AFI_Packua_bl_type( Re_Buf, Db_Buf, Int_Buf, InData%UA_BL, ErrStat2, ErrMsg2, OnlySize ) ! UA_BL CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -750,12 +756,6 @@ SUBROUTINE AFI_UnPackTable_Type( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -785,15 +785,10 @@ SUBROUTINE AFI_UnPackTable_Type( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Alpha.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Alpha)>0) OutData%Alpha = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Alpha))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Alpha) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Alpha,1), UBOUND(OutData%Alpha,1) + OutData%Alpha(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Coefs not allocated Int_Xferred = Int_Xferred + 1 @@ -811,15 +806,12 @@ SUBROUTINE AFI_UnPackTable_Type( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Coefs.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Coefs)>0) OutData%Coefs = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Coefs))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Coefs) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Coefs,2), UBOUND(OutData%Coefs,2) + DO i1 = LBOUND(OutData%Coefs,1), UBOUND(OutData%Coefs,1) + OutData%Coefs(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SplineCoefs not allocated Int_Xferred = Int_Xferred + 1 @@ -840,26 +832,25 @@ SUBROUTINE AFI_UnPackTable_Type( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SplineCoefs.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%SplineCoefs)>0) OutData%SplineCoefs = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SplineCoefs))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SplineCoefs) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%SplineCoefs,3), UBOUND(OutData%SplineCoefs,3) + DO i2 = LBOUND(OutData%SplineCoefs,2), UBOUND(OutData%SplineCoefs,2) + DO i1 = LBOUND(OutData%SplineCoefs,1), UBOUND(OutData%SplineCoefs,1) + OutData%SplineCoefs(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - OutData%UserProp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Re = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NumAlf = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ConstData = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%InclUAdata = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%UserProp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Re = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NumAlf = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ConstData = TRANSFER(IntKiBuf(Int_Xferred), OutData%ConstData) + Int_Xferred = Int_Xferred + 1 + OutData%InclUAdata = TRANSFER(IntKiBuf(Int_Xferred), OutData%InclUAdata) + Int_Xferred = Int_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -1005,22 +996,22 @@ SUBROUTINE AFI_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%AFTabMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%InCol_Alfa - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%InCol_Cl - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%InCol_Cd - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%InCol_Cm - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%InCol_Cpmin - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%FileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%FileName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%AFTabMod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%InCol_Alfa + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%InCol_Cl + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%InCol_Cd + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%InCol_Cm + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%InCol_Cpmin + Int_Xferred = Int_Xferred + 1 END SUBROUTINE AFI_PackInitInput SUBROUTINE AFI_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1036,12 +1027,6 @@ SUBROUTINE AFI_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AFI_UnPackInitInput' @@ -1055,22 +1040,22 @@ SUBROUTINE AFI_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%FileName) - OutData%FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%AFTabMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%InCol_Alfa = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%InCol_Cl = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%InCol_Cd = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%InCol_Cm = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%InCol_Cpmin = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%FileName) + OutData%FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%AFTabMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%InCol_Alfa = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%InCol_Cl = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%InCol_Cd = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%InCol_Cm = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%InCol_Cpmin = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE AFI_UnPackInitInput SUBROUTINE AFI_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -1227,12 +1212,6 @@ SUBROUTINE AFI_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AFI_UnPackInitOutput' @@ -1502,16 +1481,16 @@ SUBROUTINE AFI_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%ColCd - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%ColCl - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%ColCm - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%ColCpmin - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%AFTabMod - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%ColCd + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%ColCl + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%ColCm + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%ColCpmin + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%AFTabMod + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%secondVals) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1522,15 +1501,17 @@ SUBROUTINE AFI_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%secondVals,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%secondVals)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%secondVals))-1 ) = PACK(InData%secondVals,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%secondVals) + DO i1 = LBOUND(InData%secondVals,1), UBOUND(InData%secondVals,1) + ReKiBuf(Re_Xferred) = InData%secondVals(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%InterpOrd - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NonDimArea - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumCoords - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%InterpOrd + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NonDimArea + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumCoords + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%X_Coord) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1541,8 +1522,10 @@ SUBROUTINE AFI_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X_Coord,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%X_Coord)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%X_Coord))-1 ) = PACK(InData%X_Coord,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%X_Coord) + DO i1 = LBOUND(InData%X_Coord,1), UBOUND(InData%X_Coord,1) + ReKiBuf(Re_Xferred) = InData%X_Coord(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%Y_Coord) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1554,11 +1537,13 @@ SUBROUTINE AFI_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Y_Coord,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Y_Coord)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Y_Coord))-1 ) = PACK(InData%Y_Coord,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Y_Coord) + DO i1 = LBOUND(InData%Y_Coord,1), UBOUND(InData%Y_Coord,1) + ReKiBuf(Re_Xferred) = InData%Y_Coord(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumTabs - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumTabs + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%Table) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1615,12 +1600,6 @@ SUBROUTINE AFI_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1635,16 +1614,16 @@ SUBROUTINE AFI_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%ColCd = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ColCl = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ColCm = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ColCpmin = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%AFTabMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%ColCd = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ColCl = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ColCm = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ColCpmin = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%AFTabMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! secondVals not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1658,22 +1637,17 @@ SUBROUTINE AFI_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%secondVals.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%secondVals)>0) OutData%secondVals = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%secondVals))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%secondVals) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%secondVals,1), UBOUND(OutData%secondVals,1) + OutData%secondVals(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%InterpOrd = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NonDimArea = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NumCoords = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%InterpOrd = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NonDimArea = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NumCoords = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! X_Coord not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1687,15 +1661,10 @@ SUBROUTINE AFI_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%X_Coord.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%X_Coord)>0) OutData%X_Coord = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%X_Coord))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%X_Coord) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%X_Coord,1), UBOUND(OutData%X_Coord,1) + OutData%X_Coord(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Y_Coord not allocated Int_Xferred = Int_Xferred + 1 @@ -1710,18 +1679,13 @@ SUBROUTINE AFI_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y_Coord.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Y_Coord)>0) OutData%Y_Coord = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Y_Coord))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Y_Coord) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Y_Coord,1), UBOUND(OutData%Y_Coord,1) + OutData%Y_Coord(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%NumTabs = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NumTabs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Table not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1875,12 +1839,12 @@ SUBROUTINE AFI_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AoA - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%UserProp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Re - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AoA + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%UserProp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Re + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AFI_PackInput SUBROUTINE AFI_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1896,12 +1860,6 @@ SUBROUTINE AFI_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AFI_UnPackInput' @@ -1915,12 +1873,12 @@ SUBROUTINE AFI_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%AoA = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%UserProp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Re = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%AoA = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%UserProp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Re = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AFI_UnPackInput SUBROUTINE AFI_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -2024,18 +1982,18 @@ SUBROUTINE AFI_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cl - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cd - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cm - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cpmin - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cd0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cm0 - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cl + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cd + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cm + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cpmin + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cd0 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cm0 + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AFI_PackOutput SUBROUTINE AFI_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2051,12 +2009,6 @@ SUBROUTINE AFI_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AFI_UnPackOutput' @@ -2070,18 +2022,18 @@ SUBROUTINE AFI_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%Cl = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cd = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cm = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cpmin = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cd0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cm0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%Cl = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cd = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cm = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cpmin = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cd0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cm0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AFI_UnPackOutput @@ -2159,8 +2111,8 @@ SUBROUTINE AFI_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg REAL(ReKi) :: t(2) ! Times associated with the Outputs REAL(ReKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'AFI_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -2175,18 +2127,20 @@ SUBROUTINE AFI_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = -(y1%Cl - y2%Cl)/t(2) - y_out%Cl = y1%Cl + b0 * t_out - b0 = -(y1%Cd - y2%Cd)/t(2) - y_out%Cd = y1%Cd + b0 * t_out - b0 = -(y1%Cm - y2%Cm)/t(2) - y_out%Cm = y1%Cm + b0 * t_out - b0 = -(y1%Cpmin - y2%Cpmin)/t(2) - y_out%Cpmin = y1%Cpmin + b0 * t_out - b0 = -(y1%Cd0 - y2%Cd0)/t(2) - y_out%Cd0 = y1%Cd0 + b0 * t_out - b0 = -(y1%Cm0 - y2%Cm0)/t(2) - y_out%Cm0 = y1%Cm0 + b0 * t_out + + ScaleFactor = t_out / t(2) + b = -(y1%Cl - y2%Cl) + y_out%Cl = y1%Cl + b * ScaleFactor + b = -(y1%Cd - y2%Cd) + y_out%Cd = y1%Cd + b * ScaleFactor + b = -(y1%Cm - y2%Cm) + y_out%Cm = y1%Cm + b * ScaleFactor + b = -(y1%Cpmin - y2%Cpmin) + y_out%Cpmin = y1%Cpmin + b * ScaleFactor + b = -(y1%Cd0 - y2%Cd0) + y_out%Cd0 = y1%Cd0 + b * ScaleFactor + b = -(y1%Cm0 - y2%Cm0) + y_out%Cm0 = y1%Cm0 + b * ScaleFactor END SUBROUTINE AFI_Output_ExtrapInterp1 @@ -2216,8 +2170,9 @@ SUBROUTINE AFI_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er REAL(ReKi) :: t(3) ! Times associated with the Outputs REAL(ReKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'AFI_Output_ExtrapInterp2' @@ -2239,24 +2194,26 @@ SUBROUTINE AFI_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = (t(3)**2*(y1%Cl - y2%Cl) + t(2)**2*(-y1%Cl + y3%Cl))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%Cl + t(3)*y2%Cl - t(2)*y3%Cl ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Cl = y1%Cl + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%Cd - y2%Cd) + t(2)**2*(-y1%Cd + y3%Cd))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%Cd + t(3)*y2%Cd - t(2)*y3%Cd ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Cd = y1%Cd + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%Cm - y2%Cm) + t(2)**2*(-y1%Cm + y3%Cm))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%Cm + t(3)*y2%Cm - t(2)*y3%Cm ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Cm = y1%Cm + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%Cpmin - y2%Cpmin) + t(2)**2*(-y1%Cpmin + y3%Cpmin))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%Cpmin + t(3)*y2%Cpmin - t(2)*y3%Cpmin ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Cpmin = y1%Cpmin + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%Cd0 - y2%Cd0) + t(2)**2*(-y1%Cd0 + y3%Cd0))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%Cd0 + t(3)*y2%Cd0 - t(2)*y3%Cd0 ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Cd0 = y1%Cd0 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%Cm0 - y2%Cm0) + t(2)**2*(-y1%Cm0 + y3%Cm0))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%Cm0 + t(3)*y2%Cm0 - t(2)*y3%Cm0 ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Cm0 = y1%Cm0 + b0 * t_out + c0 * t_out**2 + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) + b = (t(3)**2*(y1%Cl - y2%Cl) + t(2)**2*(-y1%Cl + y3%Cl))* scaleFactor + c = ( (t(2)-t(3))*y1%Cl + t(3)*y2%Cl - t(2)*y3%Cl ) * scaleFactor + y_out%Cl = y1%Cl + b + c * t_out + b = (t(3)**2*(y1%Cd - y2%Cd) + t(2)**2*(-y1%Cd + y3%Cd))* scaleFactor + c = ( (t(2)-t(3))*y1%Cd + t(3)*y2%Cd - t(2)*y3%Cd ) * scaleFactor + y_out%Cd = y1%Cd + b + c * t_out + b = (t(3)**2*(y1%Cm - y2%Cm) + t(2)**2*(-y1%Cm + y3%Cm))* scaleFactor + c = ( (t(2)-t(3))*y1%Cm + t(3)*y2%Cm - t(2)*y3%Cm ) * scaleFactor + y_out%Cm = y1%Cm + b + c * t_out + b = (t(3)**2*(y1%Cpmin - y2%Cpmin) + t(2)**2*(-y1%Cpmin + y3%Cpmin))* scaleFactor + c = ( (t(2)-t(3))*y1%Cpmin + t(3)*y2%Cpmin - t(2)*y3%Cpmin ) * scaleFactor + y_out%Cpmin = y1%Cpmin + b + c * t_out + b = (t(3)**2*(y1%Cd0 - y2%Cd0) + t(2)**2*(-y1%Cd0 + y3%Cd0))* scaleFactor + c = ( (t(2)-t(3))*y1%Cd0 + t(3)*y2%Cd0 - t(2)*y3%Cd0 ) * scaleFactor + y_out%Cd0 = y1%Cd0 + b + c * t_out + b = (t(3)**2*(y1%Cm0 - y2%Cm0) + t(2)**2*(-y1%Cm0 + y3%Cm0))* scaleFactor + c = ( (t(2)-t(3))*y1%Cm0 + t(3)*y2%Cm0 - t(2)*y3%Cm0 ) * scaleFactor + y_out%Cm0 = y1%Cm0 + b + c * t_out END SUBROUTINE AFI_Output_ExtrapInterp2 @@ -2334,8 +2291,8 @@ SUBROUTINE AFI_UA_BL_Type_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, Er REAL(ReKi) :: t(2) ! Times associated with the UA_BL_Types REAL(ReKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'AFI_UA_BL_Type_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -2350,70 +2307,72 @@ SUBROUTINE AFI_UA_BL_Type_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = -(u1%alpha0 - u2%alpha0)/t(2) - u_out%alpha0 = u1%alpha0 + b0 * t_out - b0 = -(u1%alpha1 - u2%alpha1)/t(2) - u_out%alpha1 = u1%alpha1 + b0 * t_out - b0 = -(u1%alpha2 - u2%alpha2)/t(2) - u_out%alpha2 = u1%alpha2 + b0 * t_out - b0 = -(u1%eta_e - u2%eta_e)/t(2) - u_out%eta_e = u1%eta_e + b0 * t_out - b0 = -(u1%C_nalpha - u2%C_nalpha)/t(2) - u_out%C_nalpha = u1%C_nalpha + b0 * t_out - b0 = -(u1%T_f0 - u2%T_f0)/t(2) - u_out%T_f0 = u1%T_f0 + b0 * t_out - b0 = -(u1%T_V0 - u2%T_V0)/t(2) - u_out%T_V0 = u1%T_V0 + b0 * t_out - b0 = -(u1%T_p - u2%T_p)/t(2) - u_out%T_p = u1%T_p + b0 * t_out - b0 = -(u1%T_VL - u2%T_VL)/t(2) - u_out%T_VL = u1%T_VL + b0 * t_out - b0 = -(u1%b1 - u2%b1)/t(2) - u_out%b1 = u1%b1 + b0 * t_out - b0 = -(u1%b2 - u2%b2)/t(2) - u_out%b2 = u1%b2 + b0 * t_out - b0 = -(u1%b5 - u2%b5)/t(2) - u_out%b5 = u1%b5 + b0 * t_out - b0 = -(u1%A1 - u2%A1)/t(2) - u_out%A1 = u1%A1 + b0 * t_out - b0 = -(u1%A2 - u2%A2)/t(2) - u_out%A2 = u1%A2 + b0 * t_out - b0 = -(u1%A5 - u2%A5)/t(2) - u_out%A5 = u1%A5 + b0 * t_out - b0 = -(u1%S1 - u2%S1)/t(2) - u_out%S1 = u1%S1 + b0 * t_out - b0 = -(u1%S2 - u2%S2)/t(2) - u_out%S2 = u1%S2 + b0 * t_out - b0 = -(u1%S3 - u2%S3)/t(2) - u_out%S3 = u1%S3 + b0 * t_out - b0 = -(u1%S4 - u2%S4)/t(2) - u_out%S4 = u1%S4 + b0 * t_out - b0 = -(u1%Cn1 - u2%Cn1)/t(2) - u_out%Cn1 = u1%Cn1 + b0 * t_out - b0 = -(u1%Cn2 - u2%Cn2)/t(2) - u_out%Cn2 = u1%Cn2 + b0 * t_out - b0 = -(u1%St_sh - u2%St_sh)/t(2) - u_out%St_sh = u1%St_sh + b0 * t_out - b0 = -(u1%Cd0 - u2%Cd0)/t(2) - u_out%Cd0 = u1%Cd0 + b0 * t_out - b0 = -(u1%Cm0 - u2%Cm0)/t(2) - u_out%Cm0 = u1%Cm0 + b0 * t_out - b0 = -(u1%k0 - u2%k0)/t(2) - u_out%k0 = u1%k0 + b0 * t_out - b0 = -(u1%k1 - u2%k1)/t(2) - u_out%k1 = u1%k1 + b0 * t_out - b0 = -(u1%k2 - u2%k2)/t(2) - u_out%k2 = u1%k2 + b0 * t_out - b0 = -(u1%k3 - u2%k3)/t(2) - u_out%k3 = u1%k3 + b0 * t_out - b0 = -(u1%k1_hat - u2%k1_hat)/t(2) - u_out%k1_hat = u1%k1_hat + b0 * t_out - b0 = -(u1%x_cp_bar - u2%x_cp_bar)/t(2) - u_out%x_cp_bar = u1%x_cp_bar + b0 * t_out - b0 = -(u1%UACutout - u2%UACutout)/t(2) - u_out%UACutout = u1%UACutout + b0 * t_out - b0 = -(u1%filtCutOff - u2%filtCutOff)/t(2) - u_out%filtCutOff = u1%filtCutOff + b0 * t_out + + ScaleFactor = t_out / t(2) + b = -(u1%alpha0 - u2%alpha0) + u_out%alpha0 = u1%alpha0 + b * ScaleFactor + b = -(u1%alpha1 - u2%alpha1) + u_out%alpha1 = u1%alpha1 + b * ScaleFactor + b = -(u1%alpha2 - u2%alpha2) + u_out%alpha2 = u1%alpha2 + b * ScaleFactor + b = -(u1%eta_e - u2%eta_e) + u_out%eta_e = u1%eta_e + b * ScaleFactor + b = -(u1%C_nalpha - u2%C_nalpha) + u_out%C_nalpha = u1%C_nalpha + b * ScaleFactor + b = -(u1%T_f0 - u2%T_f0) + u_out%T_f0 = u1%T_f0 + b * ScaleFactor + b = -(u1%T_V0 - u2%T_V0) + u_out%T_V0 = u1%T_V0 + b * ScaleFactor + b = -(u1%T_p - u2%T_p) + u_out%T_p = u1%T_p + b * ScaleFactor + b = -(u1%T_VL - u2%T_VL) + u_out%T_VL = u1%T_VL + b * ScaleFactor + b = -(u1%b1 - u2%b1) + u_out%b1 = u1%b1 + b * ScaleFactor + b = -(u1%b2 - u2%b2) + u_out%b2 = u1%b2 + b * ScaleFactor + b = -(u1%b5 - u2%b5) + u_out%b5 = u1%b5 + b * ScaleFactor + b = -(u1%A1 - u2%A1) + u_out%A1 = u1%A1 + b * ScaleFactor + b = -(u1%A2 - u2%A2) + u_out%A2 = u1%A2 + b * ScaleFactor + b = -(u1%A5 - u2%A5) + u_out%A5 = u1%A5 + b * ScaleFactor + b = -(u1%S1 - u2%S1) + u_out%S1 = u1%S1 + b * ScaleFactor + b = -(u1%S2 - u2%S2) + u_out%S2 = u1%S2 + b * ScaleFactor + b = -(u1%S3 - u2%S3) + u_out%S3 = u1%S3 + b * ScaleFactor + b = -(u1%S4 - u2%S4) + u_out%S4 = u1%S4 + b * ScaleFactor + b = -(u1%Cn1 - u2%Cn1) + u_out%Cn1 = u1%Cn1 + b * ScaleFactor + b = -(u1%Cn2 - u2%Cn2) + u_out%Cn2 = u1%Cn2 + b * ScaleFactor + b = -(u1%St_sh - u2%St_sh) + u_out%St_sh = u1%St_sh + b * ScaleFactor + b = -(u1%Cd0 - u2%Cd0) + u_out%Cd0 = u1%Cd0 + b * ScaleFactor + b = -(u1%Cm0 - u2%Cm0) + u_out%Cm0 = u1%Cm0 + b * ScaleFactor + b = -(u1%k0 - u2%k0) + u_out%k0 = u1%k0 + b * ScaleFactor + b = -(u1%k1 - u2%k1) + u_out%k1 = u1%k1 + b * ScaleFactor + b = -(u1%k2 - u2%k2) + u_out%k2 = u1%k2 + b * ScaleFactor + b = -(u1%k3 - u2%k3) + u_out%k3 = u1%k3 + b * ScaleFactor + b = -(u1%k1_hat - u2%k1_hat) + u_out%k1_hat = u1%k1_hat + b * ScaleFactor + b = -(u1%x_cp_bar - u2%x_cp_bar) + u_out%x_cp_bar = u1%x_cp_bar + b * ScaleFactor + b = -(u1%UACutout - u2%UACutout) + u_out%UACutout = u1%UACutout + b * ScaleFactor + b = -(u1%filtCutOff - u2%filtCutOff) + u_out%filtCutOff = u1%filtCutOff + b * ScaleFactor END SUBROUTINE AFI_UA_BL_Type_ExtrapInterp1 @@ -2443,8 +2402,9 @@ SUBROUTINE AFI_UA_BL_Type_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat REAL(ReKi) :: t(3) ! Times associated with the UA_BL_Types REAL(ReKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'AFI_UA_BL_Type_ExtrapInterp2' @@ -2466,102 +2426,104 @@ SUBROUTINE AFI_UA_BL_Type_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = (t(3)**2*(u1%alpha0 - u2%alpha0) + t(2)**2*(-u1%alpha0 + u3%alpha0))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%alpha0 + t(3)*u2%alpha0 - t(2)*u3%alpha0 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%alpha0 = u1%alpha0 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%alpha1 - u2%alpha1) + t(2)**2*(-u1%alpha1 + u3%alpha1))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%alpha1 + t(3)*u2%alpha1 - t(2)*u3%alpha1 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%alpha1 = u1%alpha1 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%alpha2 - u2%alpha2) + t(2)**2*(-u1%alpha2 + u3%alpha2))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%alpha2 + t(3)*u2%alpha2 - t(2)*u3%alpha2 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%alpha2 = u1%alpha2 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%eta_e - u2%eta_e) + t(2)**2*(-u1%eta_e + u3%eta_e))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%eta_e + t(3)*u2%eta_e - t(2)*u3%eta_e ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%eta_e = u1%eta_e + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%C_nalpha - u2%C_nalpha) + t(2)**2*(-u1%C_nalpha + u3%C_nalpha))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%C_nalpha + t(3)*u2%C_nalpha - t(2)*u3%C_nalpha ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%C_nalpha = u1%C_nalpha + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%T_f0 - u2%T_f0) + t(2)**2*(-u1%T_f0 + u3%T_f0))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%T_f0 + t(3)*u2%T_f0 - t(2)*u3%T_f0 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%T_f0 = u1%T_f0 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%T_V0 - u2%T_V0) + t(2)**2*(-u1%T_V0 + u3%T_V0))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%T_V0 + t(3)*u2%T_V0 - t(2)*u3%T_V0 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%T_V0 = u1%T_V0 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%T_p - u2%T_p) + t(2)**2*(-u1%T_p + u3%T_p))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%T_p + t(3)*u2%T_p - t(2)*u3%T_p ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%T_p = u1%T_p + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%T_VL - u2%T_VL) + t(2)**2*(-u1%T_VL + u3%T_VL))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%T_VL + t(3)*u2%T_VL - t(2)*u3%T_VL ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%T_VL = u1%T_VL + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%b1 - u2%b1) + t(2)**2*(-u1%b1 + u3%b1))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%b1 + t(3)*u2%b1 - t(2)*u3%b1 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%b1 = u1%b1 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%b2 - u2%b2) + t(2)**2*(-u1%b2 + u3%b2))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%b2 + t(3)*u2%b2 - t(2)*u3%b2 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%b2 = u1%b2 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%b5 - u2%b5) + t(2)**2*(-u1%b5 + u3%b5))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%b5 + t(3)*u2%b5 - t(2)*u3%b5 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%b5 = u1%b5 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%A1 - u2%A1) + t(2)**2*(-u1%A1 + u3%A1))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%A1 + t(3)*u2%A1 - t(2)*u3%A1 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%A1 = u1%A1 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%A2 - u2%A2) + t(2)**2*(-u1%A2 + u3%A2))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%A2 + t(3)*u2%A2 - t(2)*u3%A2 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%A2 = u1%A2 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%A5 - u2%A5) + t(2)**2*(-u1%A5 + u3%A5))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%A5 + t(3)*u2%A5 - t(2)*u3%A5 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%A5 = u1%A5 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%S1 - u2%S1) + t(2)**2*(-u1%S1 + u3%S1))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%S1 + t(3)*u2%S1 - t(2)*u3%S1 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%S1 = u1%S1 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%S2 - u2%S2) + t(2)**2*(-u1%S2 + u3%S2))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%S2 + t(3)*u2%S2 - t(2)*u3%S2 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%S2 = u1%S2 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%S3 - u2%S3) + t(2)**2*(-u1%S3 + u3%S3))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%S3 + t(3)*u2%S3 - t(2)*u3%S3 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%S3 = u1%S3 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%S4 - u2%S4) + t(2)**2*(-u1%S4 + u3%S4))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%S4 + t(3)*u2%S4 - t(2)*u3%S4 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%S4 = u1%S4 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%Cn1 - u2%Cn1) + t(2)**2*(-u1%Cn1 + u3%Cn1))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%Cn1 + t(3)*u2%Cn1 - t(2)*u3%Cn1 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Cn1 = u1%Cn1 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%Cn2 - u2%Cn2) + t(2)**2*(-u1%Cn2 + u3%Cn2))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%Cn2 + t(3)*u2%Cn2 - t(2)*u3%Cn2 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Cn2 = u1%Cn2 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%St_sh - u2%St_sh) + t(2)**2*(-u1%St_sh + u3%St_sh))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%St_sh + t(3)*u2%St_sh - t(2)*u3%St_sh ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%St_sh = u1%St_sh + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%Cd0 - u2%Cd0) + t(2)**2*(-u1%Cd0 + u3%Cd0))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%Cd0 + t(3)*u2%Cd0 - t(2)*u3%Cd0 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Cd0 = u1%Cd0 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%Cm0 - u2%Cm0) + t(2)**2*(-u1%Cm0 + u3%Cm0))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%Cm0 + t(3)*u2%Cm0 - t(2)*u3%Cm0 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Cm0 = u1%Cm0 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%k0 - u2%k0) + t(2)**2*(-u1%k0 + u3%k0))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%k0 + t(3)*u2%k0 - t(2)*u3%k0 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%k0 = u1%k0 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%k1 - u2%k1) + t(2)**2*(-u1%k1 + u3%k1))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%k1 + t(3)*u2%k1 - t(2)*u3%k1 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%k1 = u1%k1 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%k2 - u2%k2) + t(2)**2*(-u1%k2 + u3%k2))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%k2 + t(3)*u2%k2 - t(2)*u3%k2 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%k2 = u1%k2 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%k3 - u2%k3) + t(2)**2*(-u1%k3 + u3%k3))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%k3 + t(3)*u2%k3 - t(2)*u3%k3 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%k3 = u1%k3 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%k1_hat - u2%k1_hat) + t(2)**2*(-u1%k1_hat + u3%k1_hat))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%k1_hat + t(3)*u2%k1_hat - t(2)*u3%k1_hat ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%k1_hat = u1%k1_hat + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%x_cp_bar - u2%x_cp_bar) + t(2)**2*(-u1%x_cp_bar + u3%x_cp_bar))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%x_cp_bar + t(3)*u2%x_cp_bar - t(2)*u3%x_cp_bar ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%x_cp_bar = u1%x_cp_bar + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%UACutout - u2%UACutout) + t(2)**2*(-u1%UACutout + u3%UACutout))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%UACutout + t(3)*u2%UACutout - t(2)*u3%UACutout ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%UACutout = u1%UACutout + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%filtCutOff - u2%filtCutOff) + t(2)**2*(-u1%filtCutOff + u3%filtCutOff))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%filtCutOff + t(3)*u2%filtCutOff - t(2)*u3%filtCutOff ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%filtCutOff = u1%filtCutOff + b0 * t_out + c0 * t_out**2 + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) + b = (t(3)**2*(u1%alpha0 - u2%alpha0) + t(2)**2*(-u1%alpha0 + u3%alpha0))* scaleFactor + c = ( (t(2)-t(3))*u1%alpha0 + t(3)*u2%alpha0 - t(2)*u3%alpha0 ) * scaleFactor + u_out%alpha0 = u1%alpha0 + b + c * t_out + b = (t(3)**2*(u1%alpha1 - u2%alpha1) + t(2)**2*(-u1%alpha1 + u3%alpha1))* scaleFactor + c = ( (t(2)-t(3))*u1%alpha1 + t(3)*u2%alpha1 - t(2)*u3%alpha1 ) * scaleFactor + u_out%alpha1 = u1%alpha1 + b + c * t_out + b = (t(3)**2*(u1%alpha2 - u2%alpha2) + t(2)**2*(-u1%alpha2 + u3%alpha2))* scaleFactor + c = ( (t(2)-t(3))*u1%alpha2 + t(3)*u2%alpha2 - t(2)*u3%alpha2 ) * scaleFactor + u_out%alpha2 = u1%alpha2 + b + c * t_out + b = (t(3)**2*(u1%eta_e - u2%eta_e) + t(2)**2*(-u1%eta_e + u3%eta_e))* scaleFactor + c = ( (t(2)-t(3))*u1%eta_e + t(3)*u2%eta_e - t(2)*u3%eta_e ) * scaleFactor + u_out%eta_e = u1%eta_e + b + c * t_out + b = (t(3)**2*(u1%C_nalpha - u2%C_nalpha) + t(2)**2*(-u1%C_nalpha + u3%C_nalpha))* scaleFactor + c = ( (t(2)-t(3))*u1%C_nalpha + t(3)*u2%C_nalpha - t(2)*u3%C_nalpha ) * scaleFactor + u_out%C_nalpha = u1%C_nalpha + b + c * t_out + b = (t(3)**2*(u1%T_f0 - u2%T_f0) + t(2)**2*(-u1%T_f0 + u3%T_f0))* scaleFactor + c = ( (t(2)-t(3))*u1%T_f0 + t(3)*u2%T_f0 - t(2)*u3%T_f0 ) * scaleFactor + u_out%T_f0 = u1%T_f0 + b + c * t_out + b = (t(3)**2*(u1%T_V0 - u2%T_V0) + t(2)**2*(-u1%T_V0 + u3%T_V0))* scaleFactor + c = ( (t(2)-t(3))*u1%T_V0 + t(3)*u2%T_V0 - t(2)*u3%T_V0 ) * scaleFactor + u_out%T_V0 = u1%T_V0 + b + c * t_out + b = (t(3)**2*(u1%T_p - u2%T_p) + t(2)**2*(-u1%T_p + u3%T_p))* scaleFactor + c = ( (t(2)-t(3))*u1%T_p + t(3)*u2%T_p - t(2)*u3%T_p ) * scaleFactor + u_out%T_p = u1%T_p + b + c * t_out + b = (t(3)**2*(u1%T_VL - u2%T_VL) + t(2)**2*(-u1%T_VL + u3%T_VL))* scaleFactor + c = ( (t(2)-t(3))*u1%T_VL + t(3)*u2%T_VL - t(2)*u3%T_VL ) * scaleFactor + u_out%T_VL = u1%T_VL + b + c * t_out + b = (t(3)**2*(u1%b1 - u2%b1) + t(2)**2*(-u1%b1 + u3%b1))* scaleFactor + c = ( (t(2)-t(3))*u1%b1 + t(3)*u2%b1 - t(2)*u3%b1 ) * scaleFactor + u_out%b1 = u1%b1 + b + c * t_out + b = (t(3)**2*(u1%b2 - u2%b2) + t(2)**2*(-u1%b2 + u3%b2))* scaleFactor + c = ( (t(2)-t(3))*u1%b2 + t(3)*u2%b2 - t(2)*u3%b2 ) * scaleFactor + u_out%b2 = u1%b2 + b + c * t_out + b = (t(3)**2*(u1%b5 - u2%b5) + t(2)**2*(-u1%b5 + u3%b5))* scaleFactor + c = ( (t(2)-t(3))*u1%b5 + t(3)*u2%b5 - t(2)*u3%b5 ) * scaleFactor + u_out%b5 = u1%b5 + b + c * t_out + b = (t(3)**2*(u1%A1 - u2%A1) + t(2)**2*(-u1%A1 + u3%A1))* scaleFactor + c = ( (t(2)-t(3))*u1%A1 + t(3)*u2%A1 - t(2)*u3%A1 ) * scaleFactor + u_out%A1 = u1%A1 + b + c * t_out + b = (t(3)**2*(u1%A2 - u2%A2) + t(2)**2*(-u1%A2 + u3%A2))* scaleFactor + c = ( (t(2)-t(3))*u1%A2 + t(3)*u2%A2 - t(2)*u3%A2 ) * scaleFactor + u_out%A2 = u1%A2 + b + c * t_out + b = (t(3)**2*(u1%A5 - u2%A5) + t(2)**2*(-u1%A5 + u3%A5))* scaleFactor + c = ( (t(2)-t(3))*u1%A5 + t(3)*u2%A5 - t(2)*u3%A5 ) * scaleFactor + u_out%A5 = u1%A5 + b + c * t_out + b = (t(3)**2*(u1%S1 - u2%S1) + t(2)**2*(-u1%S1 + u3%S1))* scaleFactor + c = ( (t(2)-t(3))*u1%S1 + t(3)*u2%S1 - t(2)*u3%S1 ) * scaleFactor + u_out%S1 = u1%S1 + b + c * t_out + b = (t(3)**2*(u1%S2 - u2%S2) + t(2)**2*(-u1%S2 + u3%S2))* scaleFactor + c = ( (t(2)-t(3))*u1%S2 + t(3)*u2%S2 - t(2)*u3%S2 ) * scaleFactor + u_out%S2 = u1%S2 + b + c * t_out + b = (t(3)**2*(u1%S3 - u2%S3) + t(2)**2*(-u1%S3 + u3%S3))* scaleFactor + c = ( (t(2)-t(3))*u1%S3 + t(3)*u2%S3 - t(2)*u3%S3 ) * scaleFactor + u_out%S3 = u1%S3 + b + c * t_out + b = (t(3)**2*(u1%S4 - u2%S4) + t(2)**2*(-u1%S4 + u3%S4))* scaleFactor + c = ( (t(2)-t(3))*u1%S4 + t(3)*u2%S4 - t(2)*u3%S4 ) * scaleFactor + u_out%S4 = u1%S4 + b + c * t_out + b = (t(3)**2*(u1%Cn1 - u2%Cn1) + t(2)**2*(-u1%Cn1 + u3%Cn1))* scaleFactor + c = ( (t(2)-t(3))*u1%Cn1 + t(3)*u2%Cn1 - t(2)*u3%Cn1 ) * scaleFactor + u_out%Cn1 = u1%Cn1 + b + c * t_out + b = (t(3)**2*(u1%Cn2 - u2%Cn2) + t(2)**2*(-u1%Cn2 + u3%Cn2))* scaleFactor + c = ( (t(2)-t(3))*u1%Cn2 + t(3)*u2%Cn2 - t(2)*u3%Cn2 ) * scaleFactor + u_out%Cn2 = u1%Cn2 + b + c * t_out + b = (t(3)**2*(u1%St_sh - u2%St_sh) + t(2)**2*(-u1%St_sh + u3%St_sh))* scaleFactor + c = ( (t(2)-t(3))*u1%St_sh + t(3)*u2%St_sh - t(2)*u3%St_sh ) * scaleFactor + u_out%St_sh = u1%St_sh + b + c * t_out + b = (t(3)**2*(u1%Cd0 - u2%Cd0) + t(2)**2*(-u1%Cd0 + u3%Cd0))* scaleFactor + c = ( (t(2)-t(3))*u1%Cd0 + t(3)*u2%Cd0 - t(2)*u3%Cd0 ) * scaleFactor + u_out%Cd0 = u1%Cd0 + b + c * t_out + b = (t(3)**2*(u1%Cm0 - u2%Cm0) + t(2)**2*(-u1%Cm0 + u3%Cm0))* scaleFactor + c = ( (t(2)-t(3))*u1%Cm0 + t(3)*u2%Cm0 - t(2)*u3%Cm0 ) * scaleFactor + u_out%Cm0 = u1%Cm0 + b + c * t_out + b = (t(3)**2*(u1%k0 - u2%k0) + t(2)**2*(-u1%k0 + u3%k0))* scaleFactor + c = ( (t(2)-t(3))*u1%k0 + t(3)*u2%k0 - t(2)*u3%k0 ) * scaleFactor + u_out%k0 = u1%k0 + b + c * t_out + b = (t(3)**2*(u1%k1 - u2%k1) + t(2)**2*(-u1%k1 + u3%k1))* scaleFactor + c = ( (t(2)-t(3))*u1%k1 + t(3)*u2%k1 - t(2)*u3%k1 ) * scaleFactor + u_out%k1 = u1%k1 + b + c * t_out + b = (t(3)**2*(u1%k2 - u2%k2) + t(2)**2*(-u1%k2 + u3%k2))* scaleFactor + c = ( (t(2)-t(3))*u1%k2 + t(3)*u2%k2 - t(2)*u3%k2 ) * scaleFactor + u_out%k2 = u1%k2 + b + c * t_out + b = (t(3)**2*(u1%k3 - u2%k3) + t(2)**2*(-u1%k3 + u3%k3))* scaleFactor + c = ( (t(2)-t(3))*u1%k3 + t(3)*u2%k3 - t(2)*u3%k3 ) * scaleFactor + u_out%k3 = u1%k3 + b + c * t_out + b = (t(3)**2*(u1%k1_hat - u2%k1_hat) + t(2)**2*(-u1%k1_hat + u3%k1_hat))* scaleFactor + c = ( (t(2)-t(3))*u1%k1_hat + t(3)*u2%k1_hat - t(2)*u3%k1_hat ) * scaleFactor + u_out%k1_hat = u1%k1_hat + b + c * t_out + b = (t(3)**2*(u1%x_cp_bar - u2%x_cp_bar) + t(2)**2*(-u1%x_cp_bar + u3%x_cp_bar))* scaleFactor + c = ( (t(2)-t(3))*u1%x_cp_bar + t(3)*u2%x_cp_bar - t(2)*u3%x_cp_bar ) * scaleFactor + u_out%x_cp_bar = u1%x_cp_bar + b + c * t_out + b = (t(3)**2*(u1%UACutout - u2%UACutout) + t(2)**2*(-u1%UACutout + u3%UACutout))* scaleFactor + c = ( (t(2)-t(3))*u1%UACutout + t(3)*u2%UACutout - t(2)*u3%UACutout ) * scaleFactor + u_out%UACutout = u1%UACutout + b + c * t_out + b = (t(3)**2*(u1%filtCutOff - u2%filtCutOff) + t(2)**2*(-u1%filtCutOff + u3%filtCutOff))* scaleFactor + c = ( (t(2)-t(3))*u1%filtCutOff + t(3)*u2%filtCutOff - t(2)*u3%filtCutOff ) * scaleFactor + u_out%filtCutOff = u1%filtCutOff + b + c * t_out END SUBROUTINE AFI_UA_BL_Type_ExtrapInterp2 END MODULE AirfoilInfo_Types diff --git a/modules/aerodyn/src/BEMT_Types.f90 b/modules/aerodyn/src/BEMT_Types.f90 index 5388d79a12..a5450d6eb5 100644 --- a/modules/aerodyn/src/BEMT_Types.f90 +++ b/modules/aerodyn/src/BEMT_Types.f90 @@ -446,37 +446,41 @@ SUBROUTINE BEMT_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%chord,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%chord)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%chord))-1 ) = PACK(InData%chord,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%chord) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%numBlades - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%airDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%kinVisc - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%skewWakeMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%aTol - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%useTipLoss , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%useHubLoss , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%useInduction , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%useTanInd , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%useAIDrag , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%useTIDrag , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%numBladeNodes - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%numReIterations - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%maxIndIterations - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(InData%chord,2), UBOUND(InData%chord,2) + DO i1 = LBOUND(InData%chord,1), UBOUND(InData%chord,1) + ReKiBuf(Re_Xferred) = InData%chord(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IntKiBuf(Int_Xferred) = InData%numBlades + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%airDens + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%kinVisc + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%skewWakeMod + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%aTol + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%useTipLoss, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%useHubLoss, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%useInduction, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%useTanInd, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%useAIDrag, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%useTIDrag, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%numBladeNodes + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%numReIterations + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%maxIndIterations + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%AFindx) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -490,8 +494,12 @@ SUBROUTINE BEMT_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFindx,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AFindx)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%AFindx))-1 ) = PACK(InData%AFindx,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%AFindx) + DO i2 = LBOUND(InData%AFindx,2), UBOUND(InData%AFindx,2) + DO i1 = LBOUND(InData%AFindx,1), UBOUND(InData%AFindx,1) + IntKiBuf(Int_Xferred) = InData%AFindx(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%zHub) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -503,8 +511,10 @@ SUBROUTINE BEMT_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%zHub,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%zHub)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%zHub))-1 ) = PACK(InData%zHub,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%zHub) + DO i1 = LBOUND(InData%zHub,1), UBOUND(InData%zHub,1) + ReKiBuf(Re_Xferred) = InData%zHub(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%zLocal) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -519,8 +529,12 @@ SUBROUTINE BEMT_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%zLocal,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%zLocal)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%zLocal))-1 ) = PACK(InData%zLocal,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%zLocal) + DO i2 = LBOUND(InData%zLocal,2), UBOUND(InData%zLocal,2) + DO i1 = LBOUND(InData%zLocal,1), UBOUND(InData%zLocal,1) + ReKiBuf(Re_Xferred) = InData%zLocal(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%zTip) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -532,8 +546,10 @@ SUBROUTINE BEMT_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%zTip,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%zTip)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%zTip))-1 ) = PACK(InData%zTip,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%zTip) + DO i1 = LBOUND(InData%zTip,1), UBOUND(InData%zTip,1) + ReKiBuf(Re_Xferred) = InData%zTip(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%rLocal) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -548,23 +564,27 @@ SUBROUTINE BEMT_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rLocal,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rLocal)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%rLocal))-1 ) = PACK(InData%rLocal,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%rLocal) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UAMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%UA_Flag , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Flookup , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%a_s - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DBEMT_Mod - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%tau1_const - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%yawCorrFactor - Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(InData%rLocal,2), UBOUND(InData%rLocal,2) + DO i1 = LBOUND(InData%rLocal,1), UBOUND(InData%rLocal,1) + ReKiBuf(Re_Xferred) = InData%rLocal(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IntKiBuf(Int_Xferred) = InData%UAMod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%UA_Flag, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%Flookup, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%a_s + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DBEMT_Mod + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%tau1_const + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%yawCorrFactor + Re_Xferred = Re_Xferred + 1 END SUBROUTINE BEMT_PackInitInput SUBROUTINE BEMT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -580,12 +600,6 @@ SUBROUTINE BEMT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -617,44 +631,41 @@ SUBROUTINE BEMT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%chord.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%chord)>0) OutData%chord = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%chord))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%chord) - DEALLOCATE(mask2) - END IF - OutData%numBlades = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%airDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%kinVisc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%skewWakeMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%aTol = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%useTipLoss = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%useHubLoss = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%useInduction = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%useTanInd = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%useAIDrag = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%useTIDrag = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%numBladeNodes = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%numReIterations = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%maxIndIterations = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(OutData%chord,2), UBOUND(OutData%chord,2) + DO i1 = LBOUND(OutData%chord,1), UBOUND(OutData%chord,1) + OutData%chord(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%numBlades = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%airDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%kinVisc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%skewWakeMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%aTol = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%useTipLoss = TRANSFER(IntKiBuf(Int_Xferred), OutData%useTipLoss) + Int_Xferred = Int_Xferred + 1 + OutData%useHubLoss = TRANSFER(IntKiBuf(Int_Xferred), OutData%useHubLoss) + Int_Xferred = Int_Xferred + 1 + OutData%useInduction = TRANSFER(IntKiBuf(Int_Xferred), OutData%useInduction) + Int_Xferred = Int_Xferred + 1 + OutData%useTanInd = TRANSFER(IntKiBuf(Int_Xferred), OutData%useTanInd) + Int_Xferred = Int_Xferred + 1 + OutData%useAIDrag = TRANSFER(IntKiBuf(Int_Xferred), OutData%useAIDrag) + Int_Xferred = Int_Xferred + 1 + OutData%useTIDrag = TRANSFER(IntKiBuf(Int_Xferred), OutData%useTIDrag) + Int_Xferred = Int_Xferred + 1 + OutData%numBladeNodes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%numReIterations = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%maxIndIterations = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AFindx not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -671,15 +682,12 @@ SUBROUTINE BEMT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFindx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%AFindx)>0) OutData%AFindx = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%AFindx))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%AFindx) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AFindx,2), UBOUND(OutData%AFindx,2) + DO i1 = LBOUND(OutData%AFindx,1), UBOUND(OutData%AFindx,1) + OutData%AFindx(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! zHub not allocated Int_Xferred = Int_Xferred + 1 @@ -694,15 +702,10 @@ SUBROUTINE BEMT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%zHub.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%zHub)>0) OutData%zHub = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%zHub))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%zHub) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%zHub,1), UBOUND(OutData%zHub,1) + OutData%zHub(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! zLocal not allocated Int_Xferred = Int_Xferred + 1 @@ -720,15 +723,12 @@ SUBROUTINE BEMT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%zLocal.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%zLocal)>0) OutData%zLocal = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%zLocal))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%zLocal) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%zLocal,2), UBOUND(OutData%zLocal,2) + DO i1 = LBOUND(OutData%zLocal,1), UBOUND(OutData%zLocal,1) + OutData%zLocal(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! zTip not allocated Int_Xferred = Int_Xferred + 1 @@ -743,15 +743,10 @@ SUBROUTINE BEMT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%zTip.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%zTip)>0) OutData%zTip = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%zTip))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%zTip) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%zTip,1), UBOUND(OutData%zTip,1) + OutData%zTip(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rLocal not allocated Int_Xferred = Int_Xferred + 1 @@ -769,30 +764,27 @@ SUBROUTINE BEMT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rLocal.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%rLocal)>0) OutData%rLocal = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%rLocal))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%rLocal) - DEALLOCATE(mask2) - END IF - OutData%UAMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%UA_Flag = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%Flookup = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%a_s = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%DBEMT_Mod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%tau1_const = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%yawCorrFactor = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(OutData%rLocal,2), UBOUND(OutData%rLocal,2) + DO i1 = LBOUND(OutData%rLocal,1), UBOUND(OutData%rLocal,1) + OutData%rLocal(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%UAMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%UA_Flag = TRANSFER(IntKiBuf(Int_Xferred), OutData%UA_Flag) + Int_Xferred = Int_Xferred + 1 + OutData%Flookup = TRANSFER(IntKiBuf(Int_Xferred), OutData%Flookup) + Int_Xferred = Int_Xferred + 1 + OutData%a_s = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%DBEMT_Mod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%tau1_const = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%yawCorrFactor = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE BEMT_UnPackInitInput SUBROUTINE BEMT_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -949,12 +941,6 @@ SUBROUTINE BEMT_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_UnPackInitOutput' @@ -1123,8 +1109,8 @@ SUBROUTINE BEMT_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyContState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyContState + Re_Xferred = Re_Xferred + 1 CALL DBEMT_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%DBEMT, ErrStat2, ErrMsg2, OnlySize ) ! DBEMT CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1168,12 +1154,6 @@ SUBROUTINE BEMT_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_UnPackContState' @@ -1187,8 +1167,8 @@ SUBROUTINE BEMT_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyContState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyContState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -1385,12 +1365,6 @@ SUBROUTINE BEMT_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_UnPackDiscState' @@ -1572,8 +1546,12 @@ SUBROUTINE BEMT_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%phi,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%phi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%phi))-1 ) = PACK(InData%phi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%phi) + DO i2 = LBOUND(InData%phi,2), UBOUND(InData%phi,2) + DO i1 = LBOUND(InData%phi,1), UBOUND(InData%phi,1) + ReKiBuf(Re_Xferred) = InData%phi(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE BEMT_PackConstrState @@ -1590,12 +1568,6 @@ SUBROUTINE BEMT_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -1627,15 +1599,12 @@ SUBROUTINE BEMT_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%phi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%phi)>0) OutData%phi = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%phi))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%phi) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%phi,2), UBOUND(OutData%phi,2) + DO i1 = LBOUND(OutData%phi,1), UBOUND(OutData%phi,1) + OutData%phi(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE BEMT_UnPackConstrState @@ -1888,8 +1857,12 @@ SUBROUTINE BEMT_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UA_Flag,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%UA_Flag)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%UA_Flag)-1 ) = TRANSFER(PACK( InData%UA_Flag ,.TRUE.), IntKiBuf(1), SIZE(InData%UA_Flag)) - Int_Xferred = Int_Xferred + SIZE(InData%UA_Flag) + DO i2 = LBOUND(InData%UA_Flag,2), UBOUND(InData%UA_Flag,2) + DO i1 = LBOUND(InData%UA_Flag,1), UBOUND(InData%UA_Flag,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%UA_Flag(i1,i2), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%ValidPhi) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1904,11 +1877,15 @@ SUBROUTINE BEMT_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ValidPhi,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ValidPhi)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%ValidPhi)-1 ) = TRANSFER(PACK( InData%ValidPhi ,.TRUE.), IntKiBuf(1), SIZE(InData%ValidPhi)) - Int_Xferred = Int_Xferred + SIZE(InData%ValidPhi) + DO i2 = LBOUND(InData%ValidPhi,2), UBOUND(InData%ValidPhi,2) + DO i1 = LBOUND(InData%ValidPhi,1), UBOUND(InData%ValidPhi,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%ValidPhi(i1,i2), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%nodesInitialized , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%nodesInitialized, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE BEMT_PackOtherState SUBROUTINE BEMT_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1924,12 +1901,6 @@ SUBROUTINE BEMT_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -2041,15 +2012,12 @@ SUBROUTINE BEMT_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UA_Flag.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%UA_Flag)>0) OutData%UA_Flag = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%UA_Flag))-1 ), OutData%UA_Flag), mask2,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%UA_Flag) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%UA_Flag,2), UBOUND(OutData%UA_Flag,2) + DO i1 = LBOUND(OutData%UA_Flag,1), UBOUND(OutData%UA_Flag,1) + OutData%UA_Flag(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%UA_Flag(i1,i2)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ValidPhi not allocated Int_Xferred = Int_Xferred + 1 @@ -2067,18 +2035,15 @@ SUBROUTINE BEMT_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ValidPhi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%ValidPhi)>0) OutData%ValidPhi = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%ValidPhi))-1 ), OutData%ValidPhi), mask2,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%ValidPhi) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%ValidPhi,2), UBOUND(OutData%ValidPhi,2) + DO i1 = LBOUND(OutData%ValidPhi,1), UBOUND(OutData%ValidPhi,1) + OutData%ValidPhi(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%ValidPhi(i1,i2)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF - OutData%nodesInitialized = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%nodesInitialized = TRANSFER(IntKiBuf(Int_Xferred), OutData%nodesInitialized) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE BEMT_UnPackOtherState SUBROUTINE BEMT_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -2350,10 +2315,10 @@ SUBROUTINE BEMT_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%FirstWarn_Skew , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%FirstWarn_Phi , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%FirstWarn_Skew, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%FirstWarn_Phi, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 CALL UA_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%UA, ErrStat2, ErrMsg2, OnlySize ) ! UA CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2451,8 +2416,12 @@ SUBROUTINE BEMT_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TnInd_op,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TnInd_op)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TnInd_op))-1 ) = PACK(InData%TnInd_op,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TnInd_op) + DO i2 = LBOUND(InData%TnInd_op,2), UBOUND(InData%TnInd_op,2) + DO i1 = LBOUND(InData%TnInd_op,1), UBOUND(InData%TnInd_op,1) + ReKiBuf(Re_Xferred) = InData%TnInd_op(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%AxInd_op) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2467,8 +2436,12 @@ SUBROUTINE BEMT_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxInd_op,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AxInd_op)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AxInd_op))-1 ) = PACK(InData%AxInd_op,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AxInd_op) + DO i2 = LBOUND(InData%AxInd_op,2), UBOUND(InData%AxInd_op,2) + DO i1 = LBOUND(InData%AxInd_op,1), UBOUND(InData%AxInd_op,1) + ReKiBuf(Re_Xferred) = InData%AxInd_op(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%AxInduction) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2483,8 +2456,12 @@ SUBROUTINE BEMT_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxInduction,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AxInduction)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AxInduction))-1 ) = PACK(InData%AxInduction,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AxInduction) + DO i2 = LBOUND(InData%AxInduction,2), UBOUND(InData%AxInduction,2) + DO i1 = LBOUND(InData%AxInduction,1), UBOUND(InData%AxInduction,1) + ReKiBuf(Re_Xferred) = InData%AxInduction(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%TanInduction) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2499,11 +2476,15 @@ SUBROUTINE BEMT_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TanInduction,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TanInduction)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TanInduction))-1 ) = PACK(InData%TanInduction,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TanInduction) + DO i2 = LBOUND(InData%TanInduction,2), UBOUND(InData%TanInduction,2) + DO i1 = LBOUND(InData%TanInduction,1), UBOUND(InData%TanInduction,1) + ReKiBuf(Re_Xferred) = InData%TanInduction(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%UseFrozenWake , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%UseFrozenWake, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%Rtip) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2514,8 +2495,10 @@ SUBROUTINE BEMT_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Rtip,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Rtip)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Rtip))-1 ) = PACK(InData%Rtip,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Rtip) + DO i1 = LBOUND(InData%Rtip,1), UBOUND(InData%Rtip,1) + ReKiBuf(Re_Xferred) = InData%Rtip(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE BEMT_PackMisc @@ -2532,12 +2515,6 @@ SUBROUTINE BEMT_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -2553,10 +2530,10 @@ SUBROUTINE BEMT_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%FirstWarn_Skew = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%FirstWarn_Phi = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%FirstWarn_Skew = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstWarn_Skew) + Int_Xferred = Int_Xferred + 1 + OutData%FirstWarn_Phi = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstWarn_Phi) + Int_Xferred = Int_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -2693,15 +2670,12 @@ SUBROUTINE BEMT_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TnInd_op.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%TnInd_op)>0) OutData%TnInd_op = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TnInd_op))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TnInd_op) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%TnInd_op,2), UBOUND(OutData%TnInd_op,2) + DO i1 = LBOUND(OutData%TnInd_op,1), UBOUND(OutData%TnInd_op,1) + OutData%TnInd_op(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AxInd_op not allocated Int_Xferred = Int_Xferred + 1 @@ -2719,15 +2693,12 @@ SUBROUTINE BEMT_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxInd_op.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%AxInd_op)>0) OutData%AxInd_op = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AxInd_op))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AxInd_op) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AxInd_op,2), UBOUND(OutData%AxInd_op,2) + DO i1 = LBOUND(OutData%AxInd_op,1), UBOUND(OutData%AxInd_op,1) + OutData%AxInd_op(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AxInduction not allocated Int_Xferred = Int_Xferred + 1 @@ -2745,15 +2716,12 @@ SUBROUTINE BEMT_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxInduction.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%AxInduction)>0) OutData%AxInduction = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AxInduction))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AxInduction) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AxInduction,2), UBOUND(OutData%AxInduction,2) + DO i1 = LBOUND(OutData%AxInduction,1), UBOUND(OutData%AxInduction,1) + OutData%AxInduction(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TanInduction not allocated Int_Xferred = Int_Xferred + 1 @@ -2771,18 +2739,15 @@ SUBROUTINE BEMT_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TanInduction.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%TanInduction)>0) OutData%TanInduction = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TanInduction))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TanInduction) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%TanInduction,2), UBOUND(OutData%TanInduction,2) + DO i1 = LBOUND(OutData%TanInduction,1), UBOUND(OutData%TanInduction,1) + OutData%TanInduction(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%UseFrozenWake = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%UseFrozenWake = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseFrozenWake) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Rtip not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2796,15 +2761,10 @@ SUBROUTINE BEMT_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Rtip.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Rtip)>0) OutData%Rtip = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Rtip))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Rtip) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Rtip,1), UBOUND(OutData%Rtip,1) + OutData%Rtip(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE BEMT_UnPackMisc @@ -3086,8 +3046,8 @@ SUBROUTINE BEMT_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 IF ( .NOT. ALLOCATED(InData%chord) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -3101,37 +3061,41 @@ SUBROUTINE BEMT_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%chord,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%chord)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%chord))-1 ) = PACK(InData%chord,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%chord) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%numBlades - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%airDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%kinVisc - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%skewWakeMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%aTol - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%useTipLoss , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%useHubLoss , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%useInduction , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%useTanInd , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%useAIDrag , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%useTIDrag , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%numBladeNodes - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%numReIterations - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%maxIndIterations - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(InData%chord,2), UBOUND(InData%chord,2) + DO i1 = LBOUND(InData%chord,1), UBOUND(InData%chord,1) + ReKiBuf(Re_Xferred) = InData%chord(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IntKiBuf(Int_Xferred) = InData%numBlades + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%airDens + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%kinVisc + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%skewWakeMod + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%aTol + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%useTipLoss, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%useHubLoss, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%useInduction, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%useTanInd, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%useAIDrag, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%useTIDrag, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%numBladeNodes + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%numReIterations + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%maxIndIterations + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%AFindx) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -3145,8 +3109,12 @@ SUBROUTINE BEMT_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFindx,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AFindx)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%AFindx))-1 ) = PACK(InData%AFindx,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%AFindx) + DO i2 = LBOUND(InData%AFindx,2), UBOUND(InData%AFindx,2) + DO i1 = LBOUND(InData%AFindx,1), UBOUND(InData%AFindx,1) + IntKiBuf(Int_Xferred) = InData%AFindx(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%tipLossConst) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3161,8 +3129,12 @@ SUBROUTINE BEMT_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%tipLossConst,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%tipLossConst)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%tipLossConst))-1 ) = PACK(InData%tipLossConst,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%tipLossConst) + DO i2 = LBOUND(InData%tipLossConst,2), UBOUND(InData%tipLossConst,2) + DO i1 = LBOUND(InData%tipLossConst,1), UBOUND(InData%tipLossConst,1) + ReKiBuf(Re_Xferred) = InData%tipLossConst(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%hubLossConst) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3177,8 +3149,12 @@ SUBROUTINE BEMT_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%hubLossConst,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%hubLossConst)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%hubLossConst))-1 ) = PACK(InData%hubLossConst,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%hubLossConst) + DO i2 = LBOUND(InData%hubLossConst,2), UBOUND(InData%hubLossConst,2) + DO i1 = LBOUND(InData%hubLossConst,1), UBOUND(InData%hubLossConst,1) + ReKiBuf(Re_Xferred) = InData%hubLossConst(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%zHub) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3190,8 +3166,10 @@ SUBROUTINE BEMT_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%zHub,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%zHub)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%zHub))-1 ) = PACK(InData%zHub,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%zHub) + DO i1 = LBOUND(InData%zHub,1), UBOUND(InData%zHub,1) + ReKiBuf(Re_Xferred) = InData%zHub(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF CALL UA_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%UA, ErrStat2, ErrMsg2, OnlySize ) ! UA CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3249,12 +3227,12 @@ SUBROUTINE BEMT_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%UA_Flag , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DBEMT_Mod - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%yawCorrFactor - Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%UA_Flag, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DBEMT_Mod + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%yawCorrFactor + Re_Xferred = Re_Xferred + 1 END SUBROUTINE BEMT_PackParam SUBROUTINE BEMT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -3270,12 +3248,6 @@ SUBROUTINE BEMT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -3291,8 +3263,8 @@ SUBROUTINE BEMT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! chord not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3309,44 +3281,41 @@ SUBROUTINE BEMT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%chord.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%chord)>0) OutData%chord = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%chord))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%chord) - DEALLOCATE(mask2) - END IF - OutData%numBlades = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%airDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%kinVisc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%skewWakeMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%aTol = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%useTipLoss = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%useHubLoss = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%useInduction = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%useTanInd = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%useAIDrag = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%useTIDrag = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%numBladeNodes = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%numReIterations = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%maxIndIterations = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(OutData%chord,2), UBOUND(OutData%chord,2) + DO i1 = LBOUND(OutData%chord,1), UBOUND(OutData%chord,1) + OutData%chord(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%numBlades = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%airDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%kinVisc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%skewWakeMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%aTol = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%useTipLoss = TRANSFER(IntKiBuf(Int_Xferred), OutData%useTipLoss) + Int_Xferred = Int_Xferred + 1 + OutData%useHubLoss = TRANSFER(IntKiBuf(Int_Xferred), OutData%useHubLoss) + Int_Xferred = Int_Xferred + 1 + OutData%useInduction = TRANSFER(IntKiBuf(Int_Xferred), OutData%useInduction) + Int_Xferred = Int_Xferred + 1 + OutData%useTanInd = TRANSFER(IntKiBuf(Int_Xferred), OutData%useTanInd) + Int_Xferred = Int_Xferred + 1 + OutData%useAIDrag = TRANSFER(IntKiBuf(Int_Xferred), OutData%useAIDrag) + Int_Xferred = Int_Xferred + 1 + OutData%useTIDrag = TRANSFER(IntKiBuf(Int_Xferred), OutData%useTIDrag) + Int_Xferred = Int_Xferred + 1 + OutData%numBladeNodes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%numReIterations = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%maxIndIterations = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AFindx not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3363,15 +3332,12 @@ SUBROUTINE BEMT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFindx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%AFindx)>0) OutData%AFindx = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%AFindx))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%AFindx) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AFindx,2), UBOUND(OutData%AFindx,2) + DO i1 = LBOUND(OutData%AFindx,1), UBOUND(OutData%AFindx,1) + OutData%AFindx(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! tipLossConst not allocated Int_Xferred = Int_Xferred + 1 @@ -3389,15 +3355,12 @@ SUBROUTINE BEMT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%tipLossConst.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%tipLossConst)>0) OutData%tipLossConst = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%tipLossConst))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%tipLossConst) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%tipLossConst,2), UBOUND(OutData%tipLossConst,2) + DO i1 = LBOUND(OutData%tipLossConst,1), UBOUND(OutData%tipLossConst,1) + OutData%tipLossConst(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! hubLossConst not allocated Int_Xferred = Int_Xferred + 1 @@ -3415,15 +3378,12 @@ SUBROUTINE BEMT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%hubLossConst.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%hubLossConst)>0) OutData%hubLossConst = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%hubLossConst))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%hubLossConst) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%hubLossConst,2), UBOUND(OutData%hubLossConst,2) + DO i1 = LBOUND(OutData%hubLossConst,1), UBOUND(OutData%hubLossConst,1) + OutData%hubLossConst(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! zHub not allocated Int_Xferred = Int_Xferred + 1 @@ -3438,15 +3398,10 @@ SUBROUTINE BEMT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%zHub.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%zHub)>0) OutData%zHub = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%zHub))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%zHub) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%zHub,1), UBOUND(OutData%zHub,1) + OutData%zHub(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -3528,12 +3483,12 @@ SUBROUTINE BEMT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%UA_Flag = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%DBEMT_Mod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%yawCorrFactor = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%UA_Flag = TRANSFER(IntKiBuf(Int_Xferred), OutData%UA_Flag) + Int_Xferred = Int_Xferred + 1 + OutData%DBEMT_Mod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%yawCorrFactor = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE BEMT_UnPackParam SUBROUTINE BEMT_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -3776,11 +3731,15 @@ SUBROUTINE BEMT_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%theta,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%theta)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%theta))-1 ) = PACK(InData%theta,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%theta) + DO i2 = LBOUND(InData%theta,2), UBOUND(InData%theta,2) + DO i1 = LBOUND(InData%theta,1), UBOUND(InData%theta,1) + ReKiBuf(Re_Xferred) = InData%theta(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%chi0 - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%chi0 + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%psi) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -3791,11 +3750,13 @@ SUBROUTINE BEMT_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%psi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%psi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%psi))-1 ) = PACK(InData%psi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%psi) + DO i1 = LBOUND(InData%psi,1), UBOUND(InData%psi,1) + ReKiBuf(Re_Xferred) = InData%psi(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%omega - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%omega + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%Vx) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -3809,8 +3770,12 @@ SUBROUTINE BEMT_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vx,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Vx)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Vx))-1 ) = PACK(InData%Vx,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Vx) + DO i2 = LBOUND(InData%Vx,2), UBOUND(InData%Vx,2) + DO i1 = LBOUND(InData%Vx,1), UBOUND(InData%Vx,1) + ReKiBuf(Re_Xferred) = InData%Vx(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Vy) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3825,8 +3790,12 @@ SUBROUTINE BEMT_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vy,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Vy)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Vy))-1 ) = PACK(InData%Vy,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Vy) + DO i2 = LBOUND(InData%Vy,2), UBOUND(InData%Vy,2) + DO i1 = LBOUND(InData%Vy,1), UBOUND(InData%Vy,1) + ReKiBuf(Re_Xferred) = InData%Vy(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%rLocal) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3841,11 +3810,15 @@ SUBROUTINE BEMT_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rLocal,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rLocal)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%rLocal))-1 ) = PACK(InData%rLocal,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%rLocal) + DO i2 = LBOUND(InData%rLocal,2), UBOUND(InData%rLocal,2) + DO i1 = LBOUND(InData%rLocal,1), UBOUND(InData%rLocal,1) + ReKiBuf(Re_Xferred) = InData%rLocal(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Un_disk - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Un_disk + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%UserProp) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -3859,8 +3832,12 @@ SUBROUTINE BEMT_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UserProp,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%UserProp)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%UserProp))-1 ) = PACK(InData%UserProp,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%UserProp) + DO i2 = LBOUND(InData%UserProp,2), UBOUND(InData%UserProp,2) + DO i1 = LBOUND(InData%UserProp,1), UBOUND(InData%UserProp,1) + ReKiBuf(Re_Xferred) = InData%UserProp(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE BEMT_PackInput @@ -3877,12 +3854,6 @@ SUBROUTINE BEMT_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -3914,18 +3885,15 @@ SUBROUTINE BEMT_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%theta.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%theta)>0) OutData%theta = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%theta))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%theta) - DEALLOCATE(mask2) - END IF - OutData%chi0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(OutData%theta,2), UBOUND(OutData%theta,2) + DO i1 = LBOUND(OutData%theta,1), UBOUND(OutData%theta,1) + OutData%theta(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%chi0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! psi not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3939,18 +3907,13 @@ SUBROUTINE BEMT_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%psi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%psi)>0) OutData%psi = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%psi))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%psi) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%psi,1), UBOUND(OutData%psi,1) + OutData%psi(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%omega = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%omega = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vx not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3967,15 +3930,12 @@ SUBROUTINE BEMT_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Vx)>0) OutData%Vx = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Vx))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Vx) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Vx,2), UBOUND(OutData%Vx,2) + DO i1 = LBOUND(OutData%Vx,1), UBOUND(OutData%Vx,1) + OutData%Vx(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vy not allocated Int_Xferred = Int_Xferred + 1 @@ -3993,15 +3953,12 @@ SUBROUTINE BEMT_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vy.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Vy)>0) OutData%Vy = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Vy))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Vy) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Vy,2), UBOUND(OutData%Vy,2) + DO i1 = LBOUND(OutData%Vy,1), UBOUND(OutData%Vy,1) + OutData%Vy(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rLocal not allocated Int_Xferred = Int_Xferred + 1 @@ -4019,18 +3976,15 @@ SUBROUTINE BEMT_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rLocal.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%rLocal)>0) OutData%rLocal = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%rLocal))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%rLocal) - DEALLOCATE(mask2) - END IF - OutData%Un_disk = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(OutData%rLocal,2), UBOUND(OutData%rLocal,2) + DO i1 = LBOUND(OutData%rLocal,1), UBOUND(OutData%rLocal,1) + OutData%rLocal(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%Un_disk = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UserProp not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -4047,15 +4001,12 @@ SUBROUTINE BEMT_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UserProp.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%UserProp)>0) OutData%UserProp = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%UserProp))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%UserProp) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%UserProp,2), UBOUND(OutData%UserProp,2) + DO i1 = LBOUND(OutData%UserProp,1), UBOUND(OutData%UserProp,1) + OutData%UserProp(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE BEMT_UnPackInput @@ -4449,8 +4400,12 @@ SUBROUTINE BEMT_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vrel,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Vrel)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Vrel))-1 ) = PACK(InData%Vrel,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Vrel) + DO i2 = LBOUND(InData%Vrel,2), UBOUND(InData%Vrel,2) + DO i1 = LBOUND(InData%Vrel,1), UBOUND(InData%Vrel,1) + ReKiBuf(Re_Xferred) = InData%Vrel(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%phi) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4465,8 +4420,12 @@ SUBROUTINE BEMT_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%phi,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%phi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%phi))-1 ) = PACK(InData%phi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%phi) + DO i2 = LBOUND(InData%phi,2), UBOUND(InData%phi,2) + DO i1 = LBOUND(InData%phi,1), UBOUND(InData%phi,1) + ReKiBuf(Re_Xferred) = InData%phi(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%axInduction) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4481,8 +4440,12 @@ SUBROUTINE BEMT_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%axInduction,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%axInduction)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%axInduction))-1 ) = PACK(InData%axInduction,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%axInduction) + DO i2 = LBOUND(InData%axInduction,2), UBOUND(InData%axInduction,2) + DO i1 = LBOUND(InData%axInduction,1), UBOUND(InData%axInduction,1) + ReKiBuf(Re_Xferred) = InData%axInduction(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%tanInduction) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4497,8 +4460,12 @@ SUBROUTINE BEMT_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%tanInduction,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%tanInduction)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%tanInduction))-1 ) = PACK(InData%tanInduction,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%tanInduction) + DO i2 = LBOUND(InData%tanInduction,2), UBOUND(InData%tanInduction,2) + DO i1 = LBOUND(InData%tanInduction,1), UBOUND(InData%tanInduction,1) + ReKiBuf(Re_Xferred) = InData%tanInduction(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Re) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4513,8 +4480,12 @@ SUBROUTINE BEMT_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Re,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Re)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Re))-1 ) = PACK(InData%Re,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Re) + DO i2 = LBOUND(InData%Re,2), UBOUND(InData%Re,2) + DO i1 = LBOUND(InData%Re,1), UBOUND(InData%Re,1) + ReKiBuf(Re_Xferred) = InData%Re(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%AOA) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4529,8 +4500,12 @@ SUBROUTINE BEMT_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AOA,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AOA)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AOA))-1 ) = PACK(InData%AOA,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AOA) + DO i2 = LBOUND(InData%AOA,2), UBOUND(InData%AOA,2) + DO i1 = LBOUND(InData%AOA,1), UBOUND(InData%AOA,1) + ReKiBuf(Re_Xferred) = InData%AOA(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Cx) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4545,8 +4520,12 @@ SUBROUTINE BEMT_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cx,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Cx)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Cx))-1 ) = PACK(InData%Cx,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Cx) + DO i2 = LBOUND(InData%Cx,2), UBOUND(InData%Cx,2) + DO i1 = LBOUND(InData%Cx,1), UBOUND(InData%Cx,1) + ReKiBuf(Re_Xferred) = InData%Cx(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Cy) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4561,8 +4540,12 @@ SUBROUTINE BEMT_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cy,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Cy)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Cy))-1 ) = PACK(InData%Cy,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Cy) + DO i2 = LBOUND(InData%Cy,2), UBOUND(InData%Cy,2) + DO i1 = LBOUND(InData%Cy,1), UBOUND(InData%Cy,1) + ReKiBuf(Re_Xferred) = InData%Cy(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Cm) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4577,8 +4560,12 @@ SUBROUTINE BEMT_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cm,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Cm)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Cm))-1 ) = PACK(InData%Cm,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Cm) + DO i2 = LBOUND(InData%Cm,2), UBOUND(InData%Cm,2) + DO i1 = LBOUND(InData%Cm,1), UBOUND(InData%Cm,1) + ReKiBuf(Re_Xferred) = InData%Cm(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Cl) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4593,8 +4580,12 @@ SUBROUTINE BEMT_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cl,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Cl)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Cl))-1 ) = PACK(InData%Cl,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Cl) + DO i2 = LBOUND(InData%Cl,2), UBOUND(InData%Cl,2) + DO i1 = LBOUND(InData%Cl,1), UBOUND(InData%Cl,1) + ReKiBuf(Re_Xferred) = InData%Cl(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Cd) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4609,8 +4600,12 @@ SUBROUTINE BEMT_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cd,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Cd)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Cd))-1 ) = PACK(InData%Cd,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Cd) + DO i2 = LBOUND(InData%Cd,2), UBOUND(InData%Cd,2) + DO i1 = LBOUND(InData%Cd,1), UBOUND(InData%Cd,1) + ReKiBuf(Re_Xferred) = InData%Cd(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%chi) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4625,8 +4620,12 @@ SUBROUTINE BEMT_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%chi,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%chi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%chi))-1 ) = PACK(InData%chi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%chi) + DO i2 = LBOUND(InData%chi,2), UBOUND(InData%chi,2) + DO i1 = LBOUND(InData%chi,1), UBOUND(InData%chi,1) + ReKiBuf(Re_Xferred) = InData%chi(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Cpmin) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4641,8 +4640,12 @@ SUBROUTINE BEMT_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cpmin,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Cpmin)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Cpmin))-1 ) = PACK(InData%Cpmin,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Cpmin) + DO i2 = LBOUND(InData%Cpmin,2), UBOUND(InData%Cpmin,2) + DO i1 = LBOUND(InData%Cpmin,1), UBOUND(InData%Cpmin,1) + ReKiBuf(Re_Xferred) = InData%Cpmin(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE BEMT_PackOutput @@ -4659,12 +4662,6 @@ SUBROUTINE BEMT_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -4696,15 +4693,12 @@ SUBROUTINE BEMT_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vrel.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Vrel)>0) OutData%Vrel = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Vrel))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Vrel) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Vrel,2), UBOUND(OutData%Vrel,2) + DO i1 = LBOUND(OutData%Vrel,1), UBOUND(OutData%Vrel,1) + OutData%Vrel(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! phi not allocated Int_Xferred = Int_Xferred + 1 @@ -4722,15 +4716,12 @@ SUBROUTINE BEMT_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%phi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%phi)>0) OutData%phi = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%phi))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%phi) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%phi,2), UBOUND(OutData%phi,2) + DO i1 = LBOUND(OutData%phi,1), UBOUND(OutData%phi,1) + OutData%phi(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! axInduction not allocated Int_Xferred = Int_Xferred + 1 @@ -4748,15 +4739,12 @@ SUBROUTINE BEMT_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%axInduction.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%axInduction)>0) OutData%axInduction = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%axInduction))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%axInduction) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%axInduction,2), UBOUND(OutData%axInduction,2) + DO i1 = LBOUND(OutData%axInduction,1), UBOUND(OutData%axInduction,1) + OutData%axInduction(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! tanInduction not allocated Int_Xferred = Int_Xferred + 1 @@ -4774,15 +4762,12 @@ SUBROUTINE BEMT_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%tanInduction.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%tanInduction)>0) OutData%tanInduction = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%tanInduction))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%tanInduction) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%tanInduction,2), UBOUND(OutData%tanInduction,2) + DO i1 = LBOUND(OutData%tanInduction,1), UBOUND(OutData%tanInduction,1) + OutData%tanInduction(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Re not allocated Int_Xferred = Int_Xferred + 1 @@ -4800,15 +4785,12 @@ SUBROUTINE BEMT_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Re.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Re)>0) OutData%Re = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Re))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Re) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Re,2), UBOUND(OutData%Re,2) + DO i1 = LBOUND(OutData%Re,1), UBOUND(OutData%Re,1) + OutData%Re(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AOA not allocated Int_Xferred = Int_Xferred + 1 @@ -4826,15 +4808,12 @@ SUBROUTINE BEMT_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AOA.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%AOA)>0) OutData%AOA = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AOA))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AOA) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AOA,2), UBOUND(OutData%AOA,2) + DO i1 = LBOUND(OutData%AOA,1), UBOUND(OutData%AOA,1) + OutData%AOA(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cx not allocated Int_Xferred = Int_Xferred + 1 @@ -4852,15 +4831,12 @@ SUBROUTINE BEMT_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Cx)>0) OutData%Cx = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Cx))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Cx) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Cx,2), UBOUND(OutData%Cx,2) + DO i1 = LBOUND(OutData%Cx,1), UBOUND(OutData%Cx,1) + OutData%Cx(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cy not allocated Int_Xferred = Int_Xferred + 1 @@ -4878,15 +4854,12 @@ SUBROUTINE BEMT_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cy.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Cy)>0) OutData%Cy = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Cy))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Cy) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Cy,2), UBOUND(OutData%Cy,2) + DO i1 = LBOUND(OutData%Cy,1), UBOUND(OutData%Cy,1) + OutData%Cy(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cm not allocated Int_Xferred = Int_Xferred + 1 @@ -4904,15 +4877,12 @@ SUBROUTINE BEMT_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cm.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Cm)>0) OutData%Cm = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Cm))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Cm) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Cm,2), UBOUND(OutData%Cm,2) + DO i1 = LBOUND(OutData%Cm,1), UBOUND(OutData%Cm,1) + OutData%Cm(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cl not allocated Int_Xferred = Int_Xferred + 1 @@ -4930,15 +4900,12 @@ SUBROUTINE BEMT_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cl.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Cl)>0) OutData%Cl = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Cl))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Cl) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Cl,2), UBOUND(OutData%Cl,2) + DO i1 = LBOUND(OutData%Cl,1), UBOUND(OutData%Cl,1) + OutData%Cl(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cd not allocated Int_Xferred = Int_Xferred + 1 @@ -4956,15 +4923,12 @@ SUBROUTINE BEMT_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cd.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Cd)>0) OutData%Cd = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Cd))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Cd) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Cd,2), UBOUND(OutData%Cd,2) + DO i1 = LBOUND(OutData%Cd,1), UBOUND(OutData%Cd,1) + OutData%Cd(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! chi not allocated Int_Xferred = Int_Xferred + 1 @@ -4982,15 +4946,12 @@ SUBROUTINE BEMT_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%chi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%chi)>0) OutData%chi = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%chi))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%chi) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%chi,2), UBOUND(OutData%chi,2) + DO i1 = LBOUND(OutData%chi,1), UBOUND(OutData%chi,1) + OutData%chi(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cpmin not allocated Int_Xferred = Int_Xferred + 1 @@ -5008,15 +4969,12 @@ SUBROUTINE BEMT_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cpmin.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Cpmin)>0) OutData%Cpmin = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Cpmin))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Cpmin) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Cpmin,2), UBOUND(OutData%Cpmin,2) + DO i1 = LBOUND(OutData%Cpmin,1), UBOUND(OutData%Cpmin,1) + OutData%Cpmin(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE BEMT_UnPackOutput @@ -5095,14 +5053,14 @@ SUBROUTINE BEMT_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! 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 :: i02 ! dim2 level 0 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 = "" @@ -5115,59 +5073,59 @@ SUBROUTINE BEMT_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ALLOCATED(u_out%theta) .AND. ALLOCATED(u1%theta)) THEN - ALLOCATE(b2(SIZE(u_out%theta,1),SIZE(u_out%theta,2) )) - ALLOCATE(c2(SIZE(u_out%theta,1),SIZE(u_out%theta,2) )) - b2 = -(u1%theta - u2%theta)/t(2) - u_out%theta = u1%theta + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%theta,2),UBOUND(u_out%theta,2) + DO i1 = LBOUND(u_out%theta,1),UBOUND(u_out%theta,1) + b = -(u1%theta(i1,i2) - u2%theta(i1,i2)) + u_out%theta(i1,i2) = u1%theta(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated - b0 = -(u1%chi0 - u2%chi0)/t(2) - u_out%chi0 = u1%chi0 + b0 * t_out + b = -(u1%chi0 - u2%chi0) + u_out%chi0 = u1%chi0 + b * ScaleFactor IF (ALLOCATED(u_out%psi) .AND. ALLOCATED(u1%psi)) THEN - ALLOCATE(b1(SIZE(u_out%psi,1))) - ALLOCATE(c1(SIZE(u_out%psi,1))) - b1 = -(u1%psi - u2%psi)/t(2) - u_out%psi = u1%psi + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%psi,1),UBOUND(u_out%psi,1) + b = -(u1%psi(i1) - u2%psi(i1)) + u_out%psi(i1) = u1%psi(i1) + b * ScaleFactor + END DO END IF ! check if allocated - b0 = -(u1%omega - u2%omega)/t(2) - u_out%omega = u1%omega + b0 * t_out + b = -(u1%omega - u2%omega) + u_out%omega = u1%omega + b * ScaleFactor IF (ALLOCATED(u_out%Vx) .AND. ALLOCATED(u1%Vx)) THEN - ALLOCATE(b2(SIZE(u_out%Vx,1),SIZE(u_out%Vx,2) )) - ALLOCATE(c2(SIZE(u_out%Vx,1),SIZE(u_out%Vx,2) )) - b2 = -(u1%Vx - u2%Vx)/t(2) - u_out%Vx = u1%Vx + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%Vx,2),UBOUND(u_out%Vx,2) + DO i1 = LBOUND(u_out%Vx,1),UBOUND(u_out%Vx,1) + b = -(u1%Vx(i1,i2) - u2%Vx(i1,i2)) + u_out%Vx(i1,i2) = u1%Vx(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Vy) .AND. ALLOCATED(u1%Vy)) THEN - ALLOCATE(b2(SIZE(u_out%Vy,1),SIZE(u_out%Vy,2) )) - ALLOCATE(c2(SIZE(u_out%Vy,1),SIZE(u_out%Vy,2) )) - b2 = -(u1%Vy - u2%Vy)/t(2) - u_out%Vy = u1%Vy + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%Vy,2),UBOUND(u_out%Vy,2) + DO i1 = LBOUND(u_out%Vy,1),UBOUND(u_out%Vy,1) + b = -(u1%Vy(i1,i2) - u2%Vy(i1,i2)) + u_out%Vy(i1,i2) = u1%Vy(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated IF (ALLOCATED(u_out%rLocal) .AND. ALLOCATED(u1%rLocal)) THEN - ALLOCATE(b2(SIZE(u_out%rLocal,1),SIZE(u_out%rLocal,2) )) - ALLOCATE(c2(SIZE(u_out%rLocal,1),SIZE(u_out%rLocal,2) )) - b2 = -(u1%rLocal - u2%rLocal)/t(2) - u_out%rLocal = u1%rLocal + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%rLocal,2),UBOUND(u_out%rLocal,2) + DO i1 = LBOUND(u_out%rLocal,1),UBOUND(u_out%rLocal,1) + b = -(u1%rLocal(i1,i2) - u2%rLocal(i1,i2)) + u_out%rLocal(i1,i2) = u1%rLocal(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated - b0 = -(u1%Un_disk - u2%Un_disk)/t(2) - u_out%Un_disk = u1%Un_disk + b0 * t_out + b = -(u1%Un_disk - u2%Un_disk) + u_out%Un_disk = u1%Un_disk + b * ScaleFactor IF (ALLOCATED(u_out%UserProp) .AND. ALLOCATED(u1%UserProp)) THEN - ALLOCATE(b2(SIZE(u_out%UserProp,1),SIZE(u_out%UserProp,2) )) - ALLOCATE(c2(SIZE(u_out%UserProp,1),SIZE(u_out%UserProp,2) )) - b2 = -(u1%UserProp - u2%UserProp)/t(2) - u_out%UserProp = u1%UserProp + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%UserProp,2),UBOUND(u_out%UserProp,2) + DO i1 = LBOUND(u_out%UserProp,1),UBOUND(u_out%UserProp,1) + b = -(u1%UserProp(i1,i2) - u2%UserProp(i1,i2)) + u_out%UserProp(i1,i2) = u1%UserProp(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated END SUBROUTINE BEMT_Input_ExtrapInterp1 @@ -5198,15 +5156,16 @@ SUBROUTINE BEMT_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 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 = "" @@ -5225,68 +5184,68 @@ SUBROUTINE BEMT_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ALLOCATED(u_out%theta) .AND. ALLOCATED(u1%theta)) THEN - ALLOCATE(b2(SIZE(u_out%theta,1),SIZE(u_out%theta,2) )) - ALLOCATE(c2(SIZE(u_out%theta,1),SIZE(u_out%theta,2) )) - b2 = (t(3)**2*(u1%theta - u2%theta) + t(2)**2*(-u1%theta + u3%theta))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%theta + t(3)*u2%theta - t(2)*u3%theta ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%theta = u1%theta + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%theta,2),UBOUND(u_out%theta,2) + DO i1 = LBOUND(u_out%theta,1),UBOUND(u_out%theta,1) + b = (t(3)**2*(u1%theta(i1,i2) - u2%theta(i1,i2)) + t(2)**2*(-u1%theta(i1,i2) + u3%theta(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%theta(i1,i2) + t(3)*u2%theta(i1,i2) - t(2)*u3%theta(i1,i2) ) * scaleFactor + u_out%theta(i1,i2) = u1%theta(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated - b0 = (t(3)**2*(u1%chi0 - u2%chi0) + t(2)**2*(-u1%chi0 + u3%chi0))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%chi0 + t(3)*u2%chi0 - t(2)*u3%chi0 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%chi0 = u1%chi0 + b0 * t_out + c0 * t_out**2 + b = (t(3)**2*(u1%chi0 - u2%chi0) + t(2)**2*(-u1%chi0 + u3%chi0))* scaleFactor + c = ( (t(2)-t(3))*u1%chi0 + t(3)*u2%chi0 - t(2)*u3%chi0 ) * scaleFactor + u_out%chi0 = u1%chi0 + b + c * t_out IF (ALLOCATED(u_out%psi) .AND. ALLOCATED(u1%psi)) THEN - ALLOCATE(b1(SIZE(u_out%psi,1))) - ALLOCATE(c1(SIZE(u_out%psi,1))) - b1 = (t(3)**2*(u1%psi - u2%psi) + t(2)**2*(-u1%psi + u3%psi))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%psi + t(3)*u2%psi - t(2)*u3%psi ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%psi = u1%psi + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%psi,1),UBOUND(u_out%psi,1) + b = (t(3)**2*(u1%psi(i1) - u2%psi(i1)) + t(2)**2*(-u1%psi(i1) + u3%psi(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%psi(i1) + t(3)*u2%psi(i1) - t(2)*u3%psi(i1) ) * scaleFactor + u_out%psi(i1) = u1%psi(i1) + b + c * t_out + END DO END IF ! check if allocated - b0 = (t(3)**2*(u1%omega - u2%omega) + t(2)**2*(-u1%omega + u3%omega))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%omega + t(3)*u2%omega - t(2)*u3%omega ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%omega = u1%omega + b0 * t_out + c0 * t_out**2 + b = (t(3)**2*(u1%omega - u2%omega) + t(2)**2*(-u1%omega + u3%omega))* scaleFactor + c = ( (t(2)-t(3))*u1%omega + t(3)*u2%omega - t(2)*u3%omega ) * scaleFactor + u_out%omega = u1%omega + b + c * t_out IF (ALLOCATED(u_out%Vx) .AND. ALLOCATED(u1%Vx)) THEN - ALLOCATE(b2(SIZE(u_out%Vx,1),SIZE(u_out%Vx,2) )) - ALLOCATE(c2(SIZE(u_out%Vx,1),SIZE(u_out%Vx,2) )) - b2 = (t(3)**2*(u1%Vx - u2%Vx) + t(2)**2*(-u1%Vx + u3%Vx))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%Vx + t(3)*u2%Vx - t(2)*u3%Vx ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Vx = u1%Vx + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%Vx,2),UBOUND(u_out%Vx,2) + DO i1 = LBOUND(u_out%Vx,1),UBOUND(u_out%Vx,1) + b = (t(3)**2*(u1%Vx(i1,i2) - u2%Vx(i1,i2)) + t(2)**2*(-u1%Vx(i1,i2) + u3%Vx(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%Vx(i1,i2) + t(3)*u2%Vx(i1,i2) - t(2)*u3%Vx(i1,i2) ) * scaleFactor + u_out%Vx(i1,i2) = u1%Vx(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Vy) .AND. ALLOCATED(u1%Vy)) THEN - ALLOCATE(b2(SIZE(u_out%Vy,1),SIZE(u_out%Vy,2) )) - ALLOCATE(c2(SIZE(u_out%Vy,1),SIZE(u_out%Vy,2) )) - b2 = (t(3)**2*(u1%Vy - u2%Vy) + t(2)**2*(-u1%Vy + u3%Vy))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%Vy + t(3)*u2%Vy - t(2)*u3%Vy ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Vy = u1%Vy + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%Vy,2),UBOUND(u_out%Vy,2) + DO i1 = LBOUND(u_out%Vy,1),UBOUND(u_out%Vy,1) + b = (t(3)**2*(u1%Vy(i1,i2) - u2%Vy(i1,i2)) + t(2)**2*(-u1%Vy(i1,i2) + u3%Vy(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%Vy(i1,i2) + t(3)*u2%Vy(i1,i2) - t(2)*u3%Vy(i1,i2) ) * scaleFactor + u_out%Vy(i1,i2) = u1%Vy(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated IF (ALLOCATED(u_out%rLocal) .AND. ALLOCATED(u1%rLocal)) THEN - ALLOCATE(b2(SIZE(u_out%rLocal,1),SIZE(u_out%rLocal,2) )) - ALLOCATE(c2(SIZE(u_out%rLocal,1),SIZE(u_out%rLocal,2) )) - b2 = (t(3)**2*(u1%rLocal - u2%rLocal) + t(2)**2*(-u1%rLocal + u3%rLocal))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%rLocal + t(3)*u2%rLocal - t(2)*u3%rLocal ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%rLocal = u1%rLocal + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%rLocal,2),UBOUND(u_out%rLocal,2) + DO i1 = LBOUND(u_out%rLocal,1),UBOUND(u_out%rLocal,1) + b = (t(3)**2*(u1%rLocal(i1,i2) - u2%rLocal(i1,i2)) + t(2)**2*(-u1%rLocal(i1,i2) + u3%rLocal(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%rLocal(i1,i2) + t(3)*u2%rLocal(i1,i2) - t(2)*u3%rLocal(i1,i2) ) * scaleFactor + u_out%rLocal(i1,i2) = u1%rLocal(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated - b0 = (t(3)**2*(u1%Un_disk - u2%Un_disk) + t(2)**2*(-u1%Un_disk + u3%Un_disk))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%Un_disk + t(3)*u2%Un_disk - t(2)*u3%Un_disk ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Un_disk = u1%Un_disk + b0 * t_out + c0 * t_out**2 + b = (t(3)**2*(u1%Un_disk - u2%Un_disk) + t(2)**2*(-u1%Un_disk + u3%Un_disk))* scaleFactor + c = ( (t(2)-t(3))*u1%Un_disk + t(3)*u2%Un_disk - t(2)*u3%Un_disk ) * scaleFactor + u_out%Un_disk = u1%Un_disk + b + c * t_out IF (ALLOCATED(u_out%UserProp) .AND. ALLOCATED(u1%UserProp)) THEN - ALLOCATE(b2(SIZE(u_out%UserProp,1),SIZE(u_out%UserProp,2) )) - ALLOCATE(c2(SIZE(u_out%UserProp,1),SIZE(u_out%UserProp,2) )) - b2 = (t(3)**2*(u1%UserProp - u2%UserProp) + t(2)**2*(-u1%UserProp + u3%UserProp))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%UserProp + t(3)*u2%UserProp - t(2)*u3%UserProp ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%UserProp = u1%UserProp + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%UserProp,2),UBOUND(u_out%UserProp,2) + DO i1 = LBOUND(u_out%UserProp,1),UBOUND(u_out%UserProp,1) + b = (t(3)**2*(u1%UserProp(i1,i2) - u2%UserProp(i1,i2)) + t(2)**2*(-u1%UserProp(i1,i2) + u3%UserProp(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%UserProp(i1,i2) + t(3)*u2%UserProp(i1,i2) - t(2)*u3%UserProp(i1,i2) ) * scaleFactor + u_out%UserProp(i1,i2) = u1%UserProp(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated END SUBROUTINE BEMT_Input_ExtrapInterp2 @@ -5365,14 +5324,14 @@ SUBROUTINE BEMT_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! 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 :: i02 ! dim2 level 0 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 = "" @@ -5385,109 +5344,111 @@ SUBROUTINE BEMT_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ALLOCATED(y_out%Vrel) .AND. ALLOCATED(y1%Vrel)) THEN - ALLOCATE(b2(SIZE(y_out%Vrel,1),SIZE(y_out%Vrel,2) )) - ALLOCATE(c2(SIZE(y_out%Vrel,1),SIZE(y_out%Vrel,2) )) - b2 = -(y1%Vrel - y2%Vrel)/t(2) - y_out%Vrel = y1%Vrel + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%Vrel,2),UBOUND(y_out%Vrel,2) + DO i1 = LBOUND(y_out%Vrel,1),UBOUND(y_out%Vrel,1) + b = -(y1%Vrel(i1,i2) - y2%Vrel(i1,i2)) + y_out%Vrel(i1,i2) = y1%Vrel(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%phi) .AND. ALLOCATED(y1%phi)) THEN - ALLOCATE(b2(SIZE(y_out%phi,1),SIZE(y_out%phi,2) )) - ALLOCATE(c2(SIZE(y_out%phi,1),SIZE(y_out%phi,2) )) - b2 = -(y1%phi - y2%phi)/t(2) - y_out%phi = y1%phi + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%phi,2),UBOUND(y_out%phi,2) + DO i1 = LBOUND(y_out%phi,1),UBOUND(y_out%phi,1) + b = -(y1%phi(i1,i2) - y2%phi(i1,i2)) + y_out%phi(i1,i2) = y1%phi(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%axInduction) .AND. ALLOCATED(y1%axInduction)) THEN - ALLOCATE(b2(SIZE(y_out%axInduction,1),SIZE(y_out%axInduction,2) )) - ALLOCATE(c2(SIZE(y_out%axInduction,1),SIZE(y_out%axInduction,2) )) - b2 = -(y1%axInduction - y2%axInduction)/t(2) - y_out%axInduction = y1%axInduction + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%axInduction,2),UBOUND(y_out%axInduction,2) + DO i1 = LBOUND(y_out%axInduction,1),UBOUND(y_out%axInduction,1) + b = -(y1%axInduction(i1,i2) - y2%axInduction(i1,i2)) + y_out%axInduction(i1,i2) = y1%axInduction(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%tanInduction) .AND. ALLOCATED(y1%tanInduction)) THEN - ALLOCATE(b2(SIZE(y_out%tanInduction,1),SIZE(y_out%tanInduction,2) )) - ALLOCATE(c2(SIZE(y_out%tanInduction,1),SIZE(y_out%tanInduction,2) )) - b2 = -(y1%tanInduction - y2%tanInduction)/t(2) - y_out%tanInduction = y1%tanInduction + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%tanInduction,2),UBOUND(y_out%tanInduction,2) + DO i1 = LBOUND(y_out%tanInduction,1),UBOUND(y_out%tanInduction,1) + b = -(y1%tanInduction(i1,i2) - y2%tanInduction(i1,i2)) + y_out%tanInduction(i1,i2) = y1%tanInduction(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%Re) .AND. ALLOCATED(y1%Re)) THEN - ALLOCATE(b2(SIZE(y_out%Re,1),SIZE(y_out%Re,2) )) - ALLOCATE(c2(SIZE(y_out%Re,1),SIZE(y_out%Re,2) )) - b2 = -(y1%Re - y2%Re)/t(2) - y_out%Re = y1%Re + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%Re,2),UBOUND(y_out%Re,2) + DO i1 = LBOUND(y_out%Re,1),UBOUND(y_out%Re,1) + b = -(y1%Re(i1,i2) - y2%Re(i1,i2)) + y_out%Re(i1,i2) = y1%Re(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%AOA) .AND. ALLOCATED(y1%AOA)) THEN - ALLOCATE(b2(SIZE(y_out%AOA,1),SIZE(y_out%AOA,2) )) - ALLOCATE(c2(SIZE(y_out%AOA,1),SIZE(y_out%AOA,2) )) - b2 = -(y1%AOA - y2%AOA)/t(2) - y_out%AOA = y1%AOA + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%AOA,2),UBOUND(y_out%AOA,2) + DO i1 = LBOUND(y_out%AOA,1),UBOUND(y_out%AOA,1) + b = -(y1%AOA(i1,i2) - y2%AOA(i1,i2)) + y_out%AOA(i1,i2) = y1%AOA(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%Cx) .AND. ALLOCATED(y1%Cx)) THEN - ALLOCATE(b2(SIZE(y_out%Cx,1),SIZE(y_out%Cx,2) )) - ALLOCATE(c2(SIZE(y_out%Cx,1),SIZE(y_out%Cx,2) )) - b2 = -(y1%Cx - y2%Cx)/t(2) - y_out%Cx = y1%Cx + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%Cx,2),UBOUND(y_out%Cx,2) + DO i1 = LBOUND(y_out%Cx,1),UBOUND(y_out%Cx,1) + b = -(y1%Cx(i1,i2) - y2%Cx(i1,i2)) + y_out%Cx(i1,i2) = y1%Cx(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%Cy) .AND. ALLOCATED(y1%Cy)) THEN - ALLOCATE(b2(SIZE(y_out%Cy,1),SIZE(y_out%Cy,2) )) - ALLOCATE(c2(SIZE(y_out%Cy,1),SIZE(y_out%Cy,2) )) - b2 = -(y1%Cy - y2%Cy)/t(2) - y_out%Cy = y1%Cy + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%Cy,2),UBOUND(y_out%Cy,2) + DO i1 = LBOUND(y_out%Cy,1),UBOUND(y_out%Cy,1) + b = -(y1%Cy(i1,i2) - y2%Cy(i1,i2)) + y_out%Cy(i1,i2) = y1%Cy(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%Cm) .AND. ALLOCATED(y1%Cm)) THEN - ALLOCATE(b2(SIZE(y_out%Cm,1),SIZE(y_out%Cm,2) )) - ALLOCATE(c2(SIZE(y_out%Cm,1),SIZE(y_out%Cm,2) )) - b2 = -(y1%Cm - y2%Cm)/t(2) - y_out%Cm = y1%Cm + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%Cm,2),UBOUND(y_out%Cm,2) + DO i1 = LBOUND(y_out%Cm,1),UBOUND(y_out%Cm,1) + b = -(y1%Cm(i1,i2) - y2%Cm(i1,i2)) + y_out%Cm(i1,i2) = y1%Cm(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%Cl) .AND. ALLOCATED(y1%Cl)) THEN - ALLOCATE(b2(SIZE(y_out%Cl,1),SIZE(y_out%Cl,2) )) - ALLOCATE(c2(SIZE(y_out%Cl,1),SIZE(y_out%Cl,2) )) - b2 = -(y1%Cl - y2%Cl)/t(2) - y_out%Cl = y1%Cl + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%Cl,2),UBOUND(y_out%Cl,2) + DO i1 = LBOUND(y_out%Cl,1),UBOUND(y_out%Cl,1) + b = -(y1%Cl(i1,i2) - y2%Cl(i1,i2)) + y_out%Cl(i1,i2) = y1%Cl(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%Cd) .AND. ALLOCATED(y1%Cd)) THEN - ALLOCATE(b2(SIZE(y_out%Cd,1),SIZE(y_out%Cd,2) )) - ALLOCATE(c2(SIZE(y_out%Cd,1),SIZE(y_out%Cd,2) )) - b2 = -(y1%Cd - y2%Cd)/t(2) - y_out%Cd = y1%Cd + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%Cd,2),UBOUND(y_out%Cd,2) + DO i1 = LBOUND(y_out%Cd,1),UBOUND(y_out%Cd,1) + b = -(y1%Cd(i1,i2) - y2%Cd(i1,i2)) + y_out%Cd(i1,i2) = y1%Cd(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%chi) .AND. ALLOCATED(y1%chi)) THEN - ALLOCATE(b2(SIZE(y_out%chi,1),SIZE(y_out%chi,2) )) - ALLOCATE(c2(SIZE(y_out%chi,1),SIZE(y_out%chi,2) )) - b2 = -(y1%chi - y2%chi)/t(2) - y_out%chi = y1%chi + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%chi,2),UBOUND(y_out%chi,2) + DO i1 = LBOUND(y_out%chi,1),UBOUND(y_out%chi,1) + b = -(y1%chi(i1,i2) - y2%chi(i1,i2)) + y_out%chi(i1,i2) = y1%chi(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%Cpmin) .AND. ALLOCATED(y1%Cpmin)) THEN - ALLOCATE(b2(SIZE(y_out%Cpmin,1),SIZE(y_out%Cpmin,2) )) - ALLOCATE(c2(SIZE(y_out%Cpmin,1),SIZE(y_out%Cpmin,2) )) - b2 = -(y1%Cpmin - y2%Cpmin)/t(2) - y_out%Cpmin = y1%Cpmin + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%Cpmin,2),UBOUND(y_out%Cpmin,2) + DO i1 = LBOUND(y_out%Cpmin,1),UBOUND(y_out%Cpmin,1) + b = -(y1%Cpmin(i1,i2) - y2%Cpmin(i1,i2)) + y_out%Cpmin(i1,i2) = y1%Cpmin(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated END SUBROUTINE BEMT_Output_ExtrapInterp1 @@ -5518,15 +5479,16 @@ SUBROUTINE BEMT_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 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 = "" @@ -5545,122 +5507,124 @@ SUBROUTINE BEMT_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ALLOCATED(y_out%Vrel) .AND. ALLOCATED(y1%Vrel)) THEN - ALLOCATE(b2(SIZE(y_out%Vrel,1),SIZE(y_out%Vrel,2) )) - ALLOCATE(c2(SIZE(y_out%Vrel,1),SIZE(y_out%Vrel,2) )) - b2 = (t(3)**2*(y1%Vrel - y2%Vrel) + t(2)**2*(-y1%Vrel + y3%Vrel))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*y1%Vrel + t(3)*y2%Vrel - t(2)*y3%Vrel ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Vrel = y1%Vrel + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%Vrel,2),UBOUND(y_out%Vrel,2) + DO i1 = LBOUND(y_out%Vrel,1),UBOUND(y_out%Vrel,1) + b = (t(3)**2*(y1%Vrel(i1,i2) - y2%Vrel(i1,i2)) + t(2)**2*(-y1%Vrel(i1,i2) + y3%Vrel(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*y1%Vrel(i1,i2) + t(3)*y2%Vrel(i1,i2) - t(2)*y3%Vrel(i1,i2) ) * scaleFactor + y_out%Vrel(i1,i2) = y1%Vrel(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%phi) .AND. ALLOCATED(y1%phi)) THEN - ALLOCATE(b2(SIZE(y_out%phi,1),SIZE(y_out%phi,2) )) - ALLOCATE(c2(SIZE(y_out%phi,1),SIZE(y_out%phi,2) )) - b2 = (t(3)**2*(y1%phi - y2%phi) + t(2)**2*(-y1%phi + y3%phi))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*y1%phi + t(3)*y2%phi - t(2)*y3%phi ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%phi = y1%phi + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%phi,2),UBOUND(y_out%phi,2) + DO i1 = LBOUND(y_out%phi,1),UBOUND(y_out%phi,1) + b = (t(3)**2*(y1%phi(i1,i2) - y2%phi(i1,i2)) + t(2)**2*(-y1%phi(i1,i2) + y3%phi(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*y1%phi(i1,i2) + t(3)*y2%phi(i1,i2) - t(2)*y3%phi(i1,i2) ) * scaleFactor + y_out%phi(i1,i2) = y1%phi(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%axInduction) .AND. ALLOCATED(y1%axInduction)) THEN - ALLOCATE(b2(SIZE(y_out%axInduction,1),SIZE(y_out%axInduction,2) )) - ALLOCATE(c2(SIZE(y_out%axInduction,1),SIZE(y_out%axInduction,2) )) - b2 = (t(3)**2*(y1%axInduction - y2%axInduction) + t(2)**2*(-y1%axInduction + y3%axInduction))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*y1%axInduction + t(3)*y2%axInduction - t(2)*y3%axInduction ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%axInduction = y1%axInduction + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%axInduction,2),UBOUND(y_out%axInduction,2) + DO i1 = LBOUND(y_out%axInduction,1),UBOUND(y_out%axInduction,1) + b = (t(3)**2*(y1%axInduction(i1,i2) - y2%axInduction(i1,i2)) + t(2)**2*(-y1%axInduction(i1,i2) + y3%axInduction(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*y1%axInduction(i1,i2) + t(3)*y2%axInduction(i1,i2) - t(2)*y3%axInduction(i1,i2) ) * scaleFactor + y_out%axInduction(i1,i2) = y1%axInduction(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%tanInduction) .AND. ALLOCATED(y1%tanInduction)) THEN - ALLOCATE(b2(SIZE(y_out%tanInduction,1),SIZE(y_out%tanInduction,2) )) - ALLOCATE(c2(SIZE(y_out%tanInduction,1),SIZE(y_out%tanInduction,2) )) - b2 = (t(3)**2*(y1%tanInduction - y2%tanInduction) + t(2)**2*(-y1%tanInduction + y3%tanInduction))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*y1%tanInduction + t(3)*y2%tanInduction - t(2)*y3%tanInduction ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%tanInduction = y1%tanInduction + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%tanInduction,2),UBOUND(y_out%tanInduction,2) + DO i1 = LBOUND(y_out%tanInduction,1),UBOUND(y_out%tanInduction,1) + b = (t(3)**2*(y1%tanInduction(i1,i2) - y2%tanInduction(i1,i2)) + t(2)**2*(-y1%tanInduction(i1,i2) + y3%tanInduction(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*y1%tanInduction(i1,i2) + t(3)*y2%tanInduction(i1,i2) - t(2)*y3%tanInduction(i1,i2) ) * scaleFactor + y_out%tanInduction(i1,i2) = y1%tanInduction(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%Re) .AND. ALLOCATED(y1%Re)) THEN - ALLOCATE(b2(SIZE(y_out%Re,1),SIZE(y_out%Re,2) )) - ALLOCATE(c2(SIZE(y_out%Re,1),SIZE(y_out%Re,2) )) - b2 = (t(3)**2*(y1%Re - y2%Re) + t(2)**2*(-y1%Re + y3%Re))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*y1%Re + t(3)*y2%Re - t(2)*y3%Re ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Re = y1%Re + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%Re,2),UBOUND(y_out%Re,2) + DO i1 = LBOUND(y_out%Re,1),UBOUND(y_out%Re,1) + b = (t(3)**2*(y1%Re(i1,i2) - y2%Re(i1,i2)) + t(2)**2*(-y1%Re(i1,i2) + y3%Re(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*y1%Re(i1,i2) + t(3)*y2%Re(i1,i2) - t(2)*y3%Re(i1,i2) ) * scaleFactor + y_out%Re(i1,i2) = y1%Re(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%AOA) .AND. ALLOCATED(y1%AOA)) THEN - ALLOCATE(b2(SIZE(y_out%AOA,1),SIZE(y_out%AOA,2) )) - ALLOCATE(c2(SIZE(y_out%AOA,1),SIZE(y_out%AOA,2) )) - b2 = (t(3)**2*(y1%AOA - y2%AOA) + t(2)**2*(-y1%AOA + y3%AOA))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*y1%AOA + t(3)*y2%AOA - t(2)*y3%AOA ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%AOA = y1%AOA + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%AOA,2),UBOUND(y_out%AOA,2) + DO i1 = LBOUND(y_out%AOA,1),UBOUND(y_out%AOA,1) + b = (t(3)**2*(y1%AOA(i1,i2) - y2%AOA(i1,i2)) + t(2)**2*(-y1%AOA(i1,i2) + y3%AOA(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*y1%AOA(i1,i2) + t(3)*y2%AOA(i1,i2) - t(2)*y3%AOA(i1,i2) ) * scaleFactor + y_out%AOA(i1,i2) = y1%AOA(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%Cx) .AND. ALLOCATED(y1%Cx)) THEN - ALLOCATE(b2(SIZE(y_out%Cx,1),SIZE(y_out%Cx,2) )) - ALLOCATE(c2(SIZE(y_out%Cx,1),SIZE(y_out%Cx,2) )) - b2 = (t(3)**2*(y1%Cx - y2%Cx) + t(2)**2*(-y1%Cx + y3%Cx))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*y1%Cx + t(3)*y2%Cx - t(2)*y3%Cx ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Cx = y1%Cx + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%Cx,2),UBOUND(y_out%Cx,2) + DO i1 = LBOUND(y_out%Cx,1),UBOUND(y_out%Cx,1) + b = (t(3)**2*(y1%Cx(i1,i2) - y2%Cx(i1,i2)) + t(2)**2*(-y1%Cx(i1,i2) + y3%Cx(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*y1%Cx(i1,i2) + t(3)*y2%Cx(i1,i2) - t(2)*y3%Cx(i1,i2) ) * scaleFactor + y_out%Cx(i1,i2) = y1%Cx(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%Cy) .AND. ALLOCATED(y1%Cy)) THEN - ALLOCATE(b2(SIZE(y_out%Cy,1),SIZE(y_out%Cy,2) )) - ALLOCATE(c2(SIZE(y_out%Cy,1),SIZE(y_out%Cy,2) )) - b2 = (t(3)**2*(y1%Cy - y2%Cy) + t(2)**2*(-y1%Cy + y3%Cy))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*y1%Cy + t(3)*y2%Cy - t(2)*y3%Cy ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Cy = y1%Cy + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%Cy,2),UBOUND(y_out%Cy,2) + DO i1 = LBOUND(y_out%Cy,1),UBOUND(y_out%Cy,1) + b = (t(3)**2*(y1%Cy(i1,i2) - y2%Cy(i1,i2)) + t(2)**2*(-y1%Cy(i1,i2) + y3%Cy(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*y1%Cy(i1,i2) + t(3)*y2%Cy(i1,i2) - t(2)*y3%Cy(i1,i2) ) * scaleFactor + y_out%Cy(i1,i2) = y1%Cy(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%Cm) .AND. ALLOCATED(y1%Cm)) THEN - ALLOCATE(b2(SIZE(y_out%Cm,1),SIZE(y_out%Cm,2) )) - ALLOCATE(c2(SIZE(y_out%Cm,1),SIZE(y_out%Cm,2) )) - b2 = (t(3)**2*(y1%Cm - y2%Cm) + t(2)**2*(-y1%Cm + y3%Cm))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*y1%Cm + t(3)*y2%Cm - t(2)*y3%Cm ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Cm = y1%Cm + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%Cm,2),UBOUND(y_out%Cm,2) + DO i1 = LBOUND(y_out%Cm,1),UBOUND(y_out%Cm,1) + b = (t(3)**2*(y1%Cm(i1,i2) - y2%Cm(i1,i2)) + t(2)**2*(-y1%Cm(i1,i2) + y3%Cm(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*y1%Cm(i1,i2) + t(3)*y2%Cm(i1,i2) - t(2)*y3%Cm(i1,i2) ) * scaleFactor + y_out%Cm(i1,i2) = y1%Cm(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%Cl) .AND. ALLOCATED(y1%Cl)) THEN - ALLOCATE(b2(SIZE(y_out%Cl,1),SIZE(y_out%Cl,2) )) - ALLOCATE(c2(SIZE(y_out%Cl,1),SIZE(y_out%Cl,2) )) - b2 = (t(3)**2*(y1%Cl - y2%Cl) + t(2)**2*(-y1%Cl + y3%Cl))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*y1%Cl + t(3)*y2%Cl - t(2)*y3%Cl ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Cl = y1%Cl + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%Cl,2),UBOUND(y_out%Cl,2) + DO i1 = LBOUND(y_out%Cl,1),UBOUND(y_out%Cl,1) + b = (t(3)**2*(y1%Cl(i1,i2) - y2%Cl(i1,i2)) + t(2)**2*(-y1%Cl(i1,i2) + y3%Cl(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*y1%Cl(i1,i2) + t(3)*y2%Cl(i1,i2) - t(2)*y3%Cl(i1,i2) ) * scaleFactor + y_out%Cl(i1,i2) = y1%Cl(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%Cd) .AND. ALLOCATED(y1%Cd)) THEN - ALLOCATE(b2(SIZE(y_out%Cd,1),SIZE(y_out%Cd,2) )) - ALLOCATE(c2(SIZE(y_out%Cd,1),SIZE(y_out%Cd,2) )) - b2 = (t(3)**2*(y1%Cd - y2%Cd) + t(2)**2*(-y1%Cd + y3%Cd))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*y1%Cd + t(3)*y2%Cd - t(2)*y3%Cd ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Cd = y1%Cd + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%Cd,2),UBOUND(y_out%Cd,2) + DO i1 = LBOUND(y_out%Cd,1),UBOUND(y_out%Cd,1) + b = (t(3)**2*(y1%Cd(i1,i2) - y2%Cd(i1,i2)) + t(2)**2*(-y1%Cd(i1,i2) + y3%Cd(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*y1%Cd(i1,i2) + t(3)*y2%Cd(i1,i2) - t(2)*y3%Cd(i1,i2) ) * scaleFactor + y_out%Cd(i1,i2) = y1%Cd(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%chi) .AND. ALLOCATED(y1%chi)) THEN - ALLOCATE(b2(SIZE(y_out%chi,1),SIZE(y_out%chi,2) )) - ALLOCATE(c2(SIZE(y_out%chi,1),SIZE(y_out%chi,2) )) - b2 = (t(3)**2*(y1%chi - y2%chi) + t(2)**2*(-y1%chi + y3%chi))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*y1%chi + t(3)*y2%chi - t(2)*y3%chi ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%chi = y1%chi + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%chi,2),UBOUND(y_out%chi,2) + DO i1 = LBOUND(y_out%chi,1),UBOUND(y_out%chi,1) + b = (t(3)**2*(y1%chi(i1,i2) - y2%chi(i1,i2)) + t(2)**2*(-y1%chi(i1,i2) + y3%chi(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*y1%chi(i1,i2) + t(3)*y2%chi(i1,i2) - t(2)*y3%chi(i1,i2) ) * scaleFactor + y_out%chi(i1,i2) = y1%chi(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%Cpmin) .AND. ALLOCATED(y1%Cpmin)) THEN - ALLOCATE(b2(SIZE(y_out%Cpmin,1),SIZE(y_out%Cpmin,2) )) - ALLOCATE(c2(SIZE(y_out%Cpmin,1),SIZE(y_out%Cpmin,2) )) - b2 = (t(3)**2*(y1%Cpmin - y2%Cpmin) + t(2)**2*(-y1%Cpmin + y3%Cpmin))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*y1%Cpmin + t(3)*y2%Cpmin - t(2)*y3%Cpmin ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Cpmin = y1%Cpmin + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%Cpmin,2),UBOUND(y_out%Cpmin,2) + DO i1 = LBOUND(y_out%Cpmin,1),UBOUND(y_out%Cpmin,1) + b = (t(3)**2*(y1%Cpmin(i1,i2) - y2%Cpmin(i1,i2)) + t(2)**2*(-y1%Cpmin(i1,i2) + y3%Cpmin(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*y1%Cpmin(i1,i2) + t(3)*y2%Cpmin(i1,i2) - t(2)*y3%Cpmin(i1,i2) ) * scaleFactor + y_out%Cpmin(i1,i2) = y1%Cpmin(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated END SUBROUTINE BEMT_Output_ExtrapInterp2 diff --git a/modules/aerodyn/src/DBEMT_Types.f90 b/modules/aerodyn/src/DBEMT_Types.f90 index 278226f56c..2f3fa7499c 100644 --- a/modules/aerodyn/src/DBEMT_Types.f90 +++ b/modules/aerodyn/src/DBEMT_Types.f90 @@ -266,24 +266,24 @@ SUBROUTINE DBEMT_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumBlades - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumNodes - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%k_0ye - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%c5 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%c6 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%c7 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%c8 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%c9 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%tau1_const - Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumBlades + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumNodes + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k_0ye + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%c5 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%c6 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%c7 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%c8 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%c9 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%tau1_const + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%spanRatio) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -297,11 +297,15 @@ SUBROUTINE DBEMT_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%spanRatio,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%spanRatio)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%spanRatio))-1 ) = PACK(InData%spanRatio,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%spanRatio) + DO i2 = LBOUND(InData%spanRatio,2), UBOUND(InData%spanRatio,2) + DO i1 = LBOUND(InData%spanRatio,1), UBOUND(InData%spanRatio,1) + ReKiBuf(Re_Xferred) = InData%spanRatio(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DBEMT_Mod - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DBEMT_Mod + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%rLocal) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -315,8 +319,12 @@ SUBROUTINE DBEMT_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rLocal,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rLocal)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%rLocal))-1 ) = PACK(InData%rLocal,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%rLocal) + DO i2 = LBOUND(InData%rLocal,2), UBOUND(InData%rLocal,2) + DO i1 = LBOUND(InData%rLocal,1), UBOUND(InData%rLocal,1) + ReKiBuf(Re_Xferred) = InData%rLocal(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE DBEMT_PackInitInput @@ -333,12 +341,6 @@ SUBROUTINE DBEMT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -355,24 +357,24 @@ SUBROUTINE DBEMT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%NumBlades = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumNodes = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%k_0ye = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%c5 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%c6 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%c7 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%c8 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%c9 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%tau1_const = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%NumBlades = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumNodes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%k_0ye = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%c5 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%c6 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%c7 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%c8 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%c9 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%tau1_const = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! spanRatio not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -389,18 +391,15 @@ SUBROUTINE DBEMT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%spanRatio.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%spanRatio)>0) OutData%spanRatio = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%spanRatio))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%spanRatio) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%spanRatio,2), UBOUND(OutData%spanRatio,2) + DO i1 = LBOUND(OutData%spanRatio,1), UBOUND(OutData%spanRatio,1) + OutData%spanRatio(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%DBEMT_Mod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%DBEMT_Mod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rLocal not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -417,15 +416,12 @@ SUBROUTINE DBEMT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rLocal.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%rLocal)>0) OutData%rLocal = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%rLocal))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%rLocal) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%rLocal,2), UBOUND(OutData%rLocal,2) + DO i1 = LBOUND(OutData%rLocal,1), UBOUND(OutData%rLocal,1) + OutData%rLocal(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE DBEMT_UnPackInitInput @@ -583,12 +579,6 @@ SUBROUTINE DBEMT_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_UnPackInitOutput' @@ -800,8 +790,14 @@ SUBROUTINE DBEMT_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vind,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%vind)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%vind))-1 ) = PACK(InData%vind,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%vind) + DO i3 = LBOUND(InData%vind,3), UBOUND(InData%vind,3) + DO i2 = LBOUND(InData%vind,2), UBOUND(InData%vind,2) + DO i1 = LBOUND(InData%vind,1), UBOUND(InData%vind,1) + ReKiBuf(Re_Xferred) = InData%vind(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%vind_1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -819,8 +815,14 @@ SUBROUTINE DBEMT_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vind_1,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%vind_1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%vind_1))-1 ) = PACK(InData%vind_1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%vind_1) + DO i3 = LBOUND(InData%vind_1,3), UBOUND(InData%vind_1,3) + DO i2 = LBOUND(InData%vind_1,2), UBOUND(InData%vind_1,2) + DO i1 = LBOUND(InData%vind_1,1), UBOUND(InData%vind_1,1) + ReKiBuf(Re_Xferred) = InData%vind_1(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF END SUBROUTINE DBEMT_PackContState @@ -837,12 +839,6 @@ SUBROUTINE DBEMT_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -878,15 +874,14 @@ SUBROUTINE DBEMT_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%vind.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%vind)>0) OutData%vind = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%vind))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%vind) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%vind,3), UBOUND(OutData%vind,3) + DO i2 = LBOUND(OutData%vind,2), UBOUND(OutData%vind,2) + DO i1 = LBOUND(OutData%vind,1), UBOUND(OutData%vind,1) + OutData%vind(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 ! vind_1 not allocated Int_Xferred = Int_Xferred + 1 @@ -907,15 +902,14 @@ SUBROUTINE DBEMT_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%vind_1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%vind_1)>0) OutData%vind_1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%vind_1))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%vind_1) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%vind_1,3), UBOUND(OutData%vind_1,3) + DO i2 = LBOUND(OutData%vind_1,2), UBOUND(OutData%vind_1,2) + DO i1 = LBOUND(OutData%vind_1,1), UBOUND(OutData%vind_1,1) + OutData%vind_1(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF END SUBROUTINE DBEMT_UnPackContState @@ -1010,8 +1004,8 @@ SUBROUTINE DBEMT_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyDiscreteState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyDiscreteState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DBEMT_PackDiscState SUBROUTINE DBEMT_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1027,12 +1021,6 @@ SUBROUTINE DBEMT_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_UnPackDiscState' @@ -1046,8 +1034,8 @@ SUBROUTINE DBEMT_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyDiscreteState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyDiscreteState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DBEMT_UnPackDiscState SUBROUTINE DBEMT_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -1141,8 +1129,8 @@ SUBROUTINE DBEMT_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyContState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyContState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DBEMT_PackConstrState SUBROUTINE DBEMT_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1158,12 +1146,6 @@ SUBROUTINE DBEMT_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_UnPackConstrState' @@ -1177,8 +1159,8 @@ SUBROUTINE DBEMT_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyContState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyContState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DBEMT_UnPackConstrState SUBROUTINE DBEMT_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -1309,11 +1291,15 @@ SUBROUTINE DBEMT_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%areStatesInitialized,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%areStatesInitialized)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%areStatesInitialized)-1 ) = TRANSFER(PACK( InData%areStatesInitialized ,.TRUE.), IntKiBuf(1), SIZE(InData%areStatesInitialized)) - Int_Xferred = Int_Xferred + SIZE(InData%areStatesInitialized) + DO i2 = LBOUND(InData%areStatesInitialized,2), UBOUND(InData%areStatesInitialized,2) + DO i1 = LBOUND(InData%areStatesInitialized,1), UBOUND(InData%areStatesInitialized,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%areStatesInitialized(i1,i2), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%tau1 - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%tau1 + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DBEMT_PackOtherState SUBROUTINE DBEMT_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1329,12 +1315,6 @@ SUBROUTINE DBEMT_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -1366,18 +1346,15 @@ SUBROUTINE DBEMT_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%areStatesInitialized.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%areStatesInitialized)>0) OutData%areStatesInitialized = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%areStatesInitialized))-1 ), OutData%areStatesInitialized), mask2,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%areStatesInitialized) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%areStatesInitialized,2), UBOUND(OutData%areStatesInitialized,2) + DO i1 = LBOUND(OutData%areStatesInitialized,1), UBOUND(OutData%areStatesInitialized,1) + OutData%areStatesInitialized(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%areStatesInitialized(i1,i2)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF - OutData%tau1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%tau1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DBEMT_UnPackOtherState SUBROUTINE DBEMT_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -1471,8 +1448,8 @@ SUBROUTINE DBEMT_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%FirstWarn_tau1 , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%FirstWarn_tau1, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE DBEMT_PackMisc SUBROUTINE DBEMT_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1488,12 +1465,6 @@ SUBROUTINE DBEMT_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_UnPackMisc' @@ -1507,8 +1478,8 @@ SUBROUTINE DBEMT_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%FirstWarn_tau1 = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%FirstWarn_tau1 = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstWarn_tau1) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE DBEMT_UnPackMisc SUBROUTINE DBEMT_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -1636,16 +1607,16 @@ SUBROUTINE DBEMT_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumBlades - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumNodes - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%k_0ye - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%tau1_const - Re_Xferred = Re_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumBlades + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumNodes + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k_0ye + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%tau1_const + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%spanRatio) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1659,11 +1630,15 @@ SUBROUTINE DBEMT_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%spanRatio,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%spanRatio)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%spanRatio))-1 ) = PACK(InData%spanRatio,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%spanRatio) + DO i2 = LBOUND(InData%spanRatio,2), UBOUND(InData%spanRatio,2) + DO i1 = LBOUND(InData%spanRatio,1), UBOUND(InData%spanRatio,1) + ReKiBuf(Re_Xferred) = InData%spanRatio(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DBEMT_Mod - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DBEMT_Mod + Int_Xferred = Int_Xferred + 1 END SUBROUTINE DBEMT_PackParam SUBROUTINE DBEMT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1679,12 +1654,6 @@ SUBROUTINE DBEMT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -1700,16 +1669,16 @@ SUBROUTINE DBEMT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%NumBlades = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumNodes = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%k_0ye = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%tau1_const = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%NumBlades = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumNodes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%k_0ye = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%tau1_const = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! spanRatio not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1726,18 +1695,15 @@ SUBROUTINE DBEMT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%spanRatio.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%spanRatio)>0) OutData%spanRatio = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%spanRatio))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%spanRatio) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%spanRatio,2), UBOUND(OutData%spanRatio,2) + DO i1 = LBOUND(OutData%spanRatio,1), UBOUND(OutData%spanRatio,1) + OutData%spanRatio(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%DBEMT_Mod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%DBEMT_Mod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE DBEMT_UnPackParam SUBROUTINE DBEMT_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -1840,16 +1806,18 @@ SUBROUTINE DBEMT_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AxInd_disk - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Un_disk - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%R_disk - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%vind_s))-1 ) = PACK(InData%vind_s,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%vind_s) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%spanRatio - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AxInd_disk + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Un_disk + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%R_disk + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%vind_s,1), UBOUND(InData%vind_s,1) + ReKiBuf(Re_Xferred) = InData%vind_s(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%spanRatio + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DBEMT_PackInput SUBROUTINE DBEMT_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1865,12 +1833,6 @@ SUBROUTINE DBEMT_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1885,25 +1847,20 @@ SUBROUTINE DBEMT_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%AxInd_disk = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Un_disk = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%R_disk = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%AxInd_disk = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Un_disk = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%R_disk = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%vind_s,1) i1_u = UBOUND(OutData%vind_s,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%vind_s = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%vind_s))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%vind_s) - DEALLOCATE(mask1) - OutData%spanRatio = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%vind_s,1), UBOUND(OutData%vind_s,1) + OutData%vind_s(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%spanRatio = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DBEMT_UnPackInput SUBROUTINE DBEMT_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -2038,8 +1995,14 @@ SUBROUTINE DBEMT_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vind,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%vind)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%vind))-1 ) = PACK(InData%vind,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%vind) + DO i3 = LBOUND(InData%vind,3), UBOUND(InData%vind,3) + DO i2 = LBOUND(InData%vind,2), UBOUND(InData%vind,2) + DO i1 = LBOUND(InData%vind,1), UBOUND(InData%vind,1) + ReKiBuf(Re_Xferred) = InData%vind(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF END SUBROUTINE DBEMT_PackOutput @@ -2056,12 +2019,6 @@ SUBROUTINE DBEMT_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -2097,15 +2054,14 @@ SUBROUTINE DBEMT_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%vind.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%vind)>0) OutData%vind = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%vind))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%vind) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%vind,3), UBOUND(OutData%vind,3) + DO i2 = LBOUND(OutData%vind,2), UBOUND(OutData%vind,2) + DO i1 = LBOUND(OutData%vind,1), UBOUND(OutData%vind,1) + OutData%vind(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF END SUBROUTINE DBEMT_UnPackOutput @@ -2184,12 +2140,12 @@ SUBROUTINE DBEMT_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMs REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! 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 :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -2202,20 +2158,20 @@ SUBROUTINE DBEMT_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = -(u1%AxInd_disk - u2%AxInd_disk)/t(2) - u_out%AxInd_disk = u1%AxInd_disk + b0 * t_out - b0 = -(u1%Un_disk - u2%Un_disk)/t(2) - u_out%Un_disk = u1%Un_disk + b0 * t_out - b0 = -(u1%R_disk - u2%R_disk)/t(2) - u_out%R_disk = u1%R_disk + b0 * t_out - ALLOCATE(b1(SIZE(u_out%vind_s,1))) - ALLOCATE(c1(SIZE(u_out%vind_s,1))) - b1 = -(u1%vind_s - u2%vind_s)/t(2) - u_out%vind_s = u1%vind_s + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - b0 = -(u1%spanRatio - u2%spanRatio)/t(2) - u_out%spanRatio = u1%spanRatio + b0 * t_out + + ScaleFactor = t_out / t(2) + b = -(u1%AxInd_disk - u2%AxInd_disk) + u_out%AxInd_disk = u1%AxInd_disk + b * ScaleFactor + b = -(u1%Un_disk - u2%Un_disk) + u_out%Un_disk = u1%Un_disk + b * ScaleFactor + b = -(u1%R_disk - u2%R_disk) + u_out%R_disk = u1%R_disk + b * ScaleFactor + DO i1 = LBOUND(u_out%vind_s,1),UBOUND(u_out%vind_s,1) + b = -(u1%vind_s(i1) - u2%vind_s(i1)) + u_out%vind_s(i1) = u1%vind_s(i1) + b * ScaleFactor + END DO + b = -(u1%spanRatio - u2%spanRatio) + u_out%spanRatio = u1%spanRatio + b * ScaleFactor END SUBROUTINE DBEMT_Input_ExtrapInterp1 @@ -2245,13 +2201,14 @@ SUBROUTINE DBEMT_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, E REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -2270,25 +2227,25 @@ SUBROUTINE DBEMT_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, E CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = (t(3)**2*(u1%AxInd_disk - u2%AxInd_disk) + t(2)**2*(-u1%AxInd_disk + u3%AxInd_disk))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%AxInd_disk + t(3)*u2%AxInd_disk - t(2)*u3%AxInd_disk ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%AxInd_disk = u1%AxInd_disk + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%Un_disk - u2%Un_disk) + t(2)**2*(-u1%Un_disk + u3%Un_disk))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%Un_disk + t(3)*u2%Un_disk - t(2)*u3%Un_disk ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Un_disk = u1%Un_disk + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%R_disk - u2%R_disk) + t(2)**2*(-u1%R_disk + u3%R_disk))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%R_disk + t(3)*u2%R_disk - t(2)*u3%R_disk ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%R_disk = u1%R_disk + b0 * t_out + c0 * t_out**2 - ALLOCATE(b1(SIZE(u_out%vind_s,1))) - ALLOCATE(c1(SIZE(u_out%vind_s,1))) - b1 = (t(3)**2*(u1%vind_s - u2%vind_s) + t(2)**2*(-u1%vind_s + u3%vind_s))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%vind_s + t(3)*u2%vind_s - t(2)*u3%vind_s ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%vind_s = u1%vind_s + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - b0 = (t(3)**2*(u1%spanRatio - u2%spanRatio) + t(2)**2*(-u1%spanRatio + u3%spanRatio))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%spanRatio + t(3)*u2%spanRatio - t(2)*u3%spanRatio ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%spanRatio = u1%spanRatio + b0 * t_out + c0 * t_out**2 + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) + b = (t(3)**2*(u1%AxInd_disk - u2%AxInd_disk) + t(2)**2*(-u1%AxInd_disk + u3%AxInd_disk))* scaleFactor + c = ( (t(2)-t(3))*u1%AxInd_disk + t(3)*u2%AxInd_disk - t(2)*u3%AxInd_disk ) * scaleFactor + u_out%AxInd_disk = u1%AxInd_disk + b + c * t_out + b = (t(3)**2*(u1%Un_disk - u2%Un_disk) + t(2)**2*(-u1%Un_disk + u3%Un_disk))* scaleFactor + c = ( (t(2)-t(3))*u1%Un_disk + t(3)*u2%Un_disk - t(2)*u3%Un_disk ) * scaleFactor + u_out%Un_disk = u1%Un_disk + b + c * t_out + b = (t(3)**2*(u1%R_disk - u2%R_disk) + t(2)**2*(-u1%R_disk + u3%R_disk))* scaleFactor + c = ( (t(2)-t(3))*u1%R_disk + t(3)*u2%R_disk - t(2)*u3%R_disk ) * scaleFactor + u_out%R_disk = u1%R_disk + b + c * t_out + DO i1 = LBOUND(u_out%vind_s,1),UBOUND(u_out%vind_s,1) + b = (t(3)**2*(u1%vind_s(i1) - u2%vind_s(i1)) + t(2)**2*(-u1%vind_s(i1) + u3%vind_s(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%vind_s(i1) + t(3)*u2%vind_s(i1) - t(2)*u3%vind_s(i1) ) * scaleFactor + u_out%vind_s(i1) = u1%vind_s(i1) + b + c * t_out + END DO + b = (t(3)**2*(u1%spanRatio - u2%spanRatio) + t(2)**2*(-u1%spanRatio + u3%spanRatio))* scaleFactor + c = ( (t(2)-t(3))*u1%spanRatio + t(3)*u2%spanRatio - t(2)*u3%spanRatio ) * scaleFactor + u_out%spanRatio = u1%spanRatio + b + c * t_out END SUBROUTINE DBEMT_Input_ExtrapInterp2 @@ -2366,16 +2323,16 @@ SUBROUTINE DBEMT_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrM REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: b3 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: c3 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! 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 :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + INTEGER :: i3 ! dim3 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -2388,15 +2345,17 @@ SUBROUTINE DBEMT_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ALLOCATED(y_out%vind) .AND. ALLOCATED(y1%vind)) THEN - ALLOCATE(b3(SIZE(y_out%vind,1),SIZE(y_out%vind,2), & - SIZE(y_out%vind,3) )) - ALLOCATE(c3(SIZE(y_out%vind,1),SIZE(y_out%vind,2), & - SIZE(y_out%vind,3) )) - b3 = -(y1%vind - y2%vind)/t(2) - y_out%vind = y1%vind + b3 * t_out - DEALLOCATE(b3) - DEALLOCATE(c3) + DO i3 = LBOUND(y_out%vind,3),UBOUND(y_out%vind,3) + DO i2 = LBOUND(y_out%vind,2),UBOUND(y_out%vind,2) + DO i1 = LBOUND(y_out%vind,1),UBOUND(y_out%vind,1) + b = -(y1%vind(i1,i2,i3) - y2%vind(i1,i2,i3)) + y_out%vind(i1,i2,i3) = y1%vind(i1,i2,i3) + b * ScaleFactor + END DO + END DO + END DO END IF ! check if allocated END SUBROUTINE DBEMT_Output_ExtrapInterp1 @@ -2427,17 +2386,18 @@ SUBROUTINE DBEMT_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: b3 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: c3 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + INTEGER :: i3 ! dim3 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -2456,16 +2416,18 @@ SUBROUTINE DBEMT_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ALLOCATED(y_out%vind) .AND. ALLOCATED(y1%vind)) THEN - ALLOCATE(b3(SIZE(y_out%vind,1),SIZE(y_out%vind,2), & - SIZE(y_out%vind,3) )) - ALLOCATE(c3(SIZE(y_out%vind,1),SIZE(y_out%vind,2), & - SIZE(y_out%vind,3) )) - b3 = (t(3)**2*(y1%vind - y2%vind) + t(2)**2*(-y1%vind + y3%vind))/(t(2)*t(3)*(t(2) - t(3))) - c3 = ( (t(2)-t(3))*y1%vind + t(3)*y2%vind - t(2)*y3%vind ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%vind = y1%vind + b3 * t_out + c3 * t_out**2 - DEALLOCATE(b3) - DEALLOCATE(c3) + DO i3 = LBOUND(y_out%vind,3),UBOUND(y_out%vind,3) + DO i2 = LBOUND(y_out%vind,2),UBOUND(y_out%vind,2) + DO i1 = LBOUND(y_out%vind,1),UBOUND(y_out%vind,1) + b = (t(3)**2*(y1%vind(i1,i2,i3) - y2%vind(i1,i2,i3)) + t(2)**2*(-y1%vind(i1,i2,i3) + y3%vind(i1,i2,i3)))* scaleFactor + c = ( (t(2)-t(3))*y1%vind(i1,i2,i3) + t(3)*y2%vind(i1,i2,i3) - t(2)*y3%vind(i1,i2,i3) ) * scaleFactor + y_out%vind(i1,i2,i3) = y1%vind(i1,i2,i3) + b + c * t_out + END DO + END DO + END DO END IF ! check if allocated END SUBROUTINE DBEMT_Output_ExtrapInterp2 diff --git a/modules/aerodyn/src/UnsteadyAero_Types.f90 b/modules/aerodyn/src/UnsteadyAero_Types.f90 index ffe61ed6b8..6e79d82c90 100644 --- a/modules/aerodyn/src/UnsteadyAero_Types.f90 +++ b/modules/aerodyn/src/UnsteadyAero_Types.f90 @@ -339,12 +339,12 @@ SUBROUTINE UA_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%dt - Db_Xferred = Db_Xferred + 1 - DO I = 1, LEN(InData%OutRootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutRootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DbKiBuf(Db_Xferred) = InData%dt + Db_Xferred = Db_Xferred + 1 + DO I = 1, LEN(InData%OutRootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutRootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( .NOT. ALLOCATED(InData%c) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -358,21 +358,25 @@ SUBROUTINE UA_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%c,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%c)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%c))-1 ) = PACK(InData%c,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%c) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%numBlades - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%nNodesPerBlade - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UAMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%a_s - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Flookup , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(InData%c,2), UBOUND(InData%c,2) + DO i1 = LBOUND(InData%c,1), UBOUND(InData%c,1) + ReKiBuf(Re_Xferred) = InData%c(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IntKiBuf(Int_Xferred) = InData%numBlades + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nNodesPerBlade + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%UAMod + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%a_s + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%Flookup, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 END SUBROUTINE UA_PackInitInput SUBROUTINE UA_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -388,12 +392,6 @@ SUBROUTINE UA_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -409,12 +407,12 @@ SUBROUTINE UA_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%dt = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - DO I = 1, LEN(OutData%OutRootName) - OutData%OutRootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + OutData%dt = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + DO I = 1, LEN(OutData%OutRootName) + OutData%OutRootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! c not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -431,28 +429,25 @@ SUBROUTINE UA_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%c.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%c)>0) OutData%c = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%c))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%c) - DEALLOCATE(mask2) - END IF - OutData%numBlades = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%nNodesPerBlade = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%UAMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%a_s = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Flookup = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(OutData%c,2), UBOUND(OutData%c,2) + DO i1 = LBOUND(OutData%c,1), UBOUND(OutData%c,1) + OutData%c(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%numBlades = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nNodesPerBlade = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%UAMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%a_s = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Flookup = TRANSFER(IntKiBuf(Int_Xferred), OutData%Flookup) + Int_Xferred = Int_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE UA_UnPackInitInput SUBROUTINE UA_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -645,12 +640,12 @@ SUBROUTINE UA_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) + DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) DO I = 1, LEN(InData%WriteOutputHdr) IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdr(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -662,12 +657,12 @@ SUBROUTINE UA_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) + DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) DO I = 1, LEN(InData%WriteOutputUnt) IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUnt(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF END SUBROUTINE UA_PackInitOutput @@ -684,12 +679,6 @@ SUBROUTINE UA_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -757,19 +746,12 @@ SUBROUTINE UA_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) DO I = 1, LEN(OutData%WriteOutputHdr) OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated Int_Xferred = Int_Xferred + 1 @@ -784,19 +766,12 @@ SUBROUTINE UA_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) DO I = 1, LEN(OutData%WriteOutputUnt) OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF END SUBROUTINE UA_UnPackInitOutput @@ -987,104 +962,104 @@ SUBROUTINE UA_PackKelvinChainType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cn_prime - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%C_nalpha_circ - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Kalpha_f - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Kq_f - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%alpha_filt_cur - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%alpha_e - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dalpha0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%alpha_f - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Kq - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%q_cur - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%q_f_cur - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%X1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%X2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%X3 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%X4 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Kprime_alpha - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Kprime_q - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Dp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cn_pot - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cc_pot - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cn_alpha_q_circ - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cn_alpha_q_nc - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cm_q_circ - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cn_alpha_nc - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cn_q_circ - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cn_q_nc - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cm_q_nc - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%fprimeprime - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Df - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Df_c - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Df_m - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Dalphaf - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%fprime - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%fprime_c - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%fprimeprime_c - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%fprime_m - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%fprimeprime_m - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cn_v - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%C_V - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cn_FS - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%T_f - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%T_fc - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%T_fm - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%T_V - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%k_alpha - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%k_q - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%T_alpha - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%T_q - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ds - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cn_prime + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%C_nalpha_circ + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Kalpha_f + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Kq_f + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%alpha_filt_cur + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%alpha_e + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dalpha0 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%alpha_f + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Kq + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%q_cur + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%q_f_cur + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%X1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%X2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%X3 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%X4 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Kprime_alpha + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Kprime_q + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Dp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cn_pot + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cc_pot + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cn_alpha_q_circ + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cn_alpha_q_nc + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cm_q_circ + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cn_alpha_nc + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cn_q_circ + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cn_q_nc + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cm_q_nc + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%fprimeprime + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Df + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Df_c + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Df_m + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Dalphaf + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%fprime + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%fprime_c + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%fprimeprime_c + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%fprime_m + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%fprimeprime_m + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cn_v + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%C_V + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cn_FS + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%T_f + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%T_fc + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%T_fm + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%T_V + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k_alpha + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k_q + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%T_alpha + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%T_q + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ds + Re_Xferred = Re_Xferred + 1 END SUBROUTINE UA_PackKelvinChainType SUBROUTINE UA_UnPackKelvinChainType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1100,12 +1075,6 @@ SUBROUTINE UA_UnPackKelvinChainType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'UA_UnPackKelvinChainType' @@ -1119,104 +1088,104 @@ SUBROUTINE UA_UnPackKelvinChainType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%Cn_prime = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%C_nalpha_circ = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Kalpha_f = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Kq_f = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%alpha_filt_cur = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%alpha_e = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%dalpha0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%alpha_f = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Kq = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%q_cur = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%q_f_cur = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%X1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%X2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%X3 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%X4 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Kprime_alpha = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Kprime_q = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Dp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cn_pot = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cc_pot = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cn_alpha_q_circ = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cn_alpha_q_nc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cm_q_circ = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cn_alpha_nc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cn_q_circ = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cn_q_nc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cm_q_nc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%fprimeprime = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Df = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Df_c = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Df_m = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Dalphaf = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%fprime = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%fprime_c = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%fprimeprime_c = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%fprime_m = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%fprimeprime_m = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cn_v = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%C_V = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cn_FS = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%T_f = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%T_fc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%T_fm = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%T_V = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%k_alpha = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%k_q = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%T_alpha = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%T_q = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%ds = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%Cn_prime = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%C_nalpha_circ = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Kalpha_f = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Kq_f = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%alpha_filt_cur = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%alpha_e = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%dalpha0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%alpha_f = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Kq = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%q_cur = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%q_f_cur = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%X1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%X2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%X3 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%X4 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Kprime_alpha = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Kprime_q = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Dp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cn_pot = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cc_pot = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cn_alpha_q_circ = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cn_alpha_q_nc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cm_q_circ = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cn_alpha_nc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cn_q_circ = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cn_q_nc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cm_q_nc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%fprimeprime = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Df = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Df_c = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Df_m = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Dalphaf = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%fprime = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%fprime_c = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%fprimeprime_c = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%fprime_m = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%fprimeprime_m = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cn_v = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%C_V = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cn_FS = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%T_f = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%T_fc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%T_fm = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%T_V = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%k_alpha = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%k_q = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%T_alpha = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%T_q = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%ds = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE UA_UnPackKelvinChainType SUBROUTINE UA_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) @@ -1310,8 +1279,8 @@ SUBROUTINE UA_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyContState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyContState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE UA_PackContState SUBROUTINE UA_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1327,12 +1296,6 @@ SUBROUTINE UA_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'UA_UnPackContState' @@ -1346,8 +1309,8 @@ SUBROUTINE UA_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyContState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyContState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE UA_UnPackContState SUBROUTINE UA_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) @@ -2158,8 +2121,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%alpha_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%alpha_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%alpha_minus1))-1 ) = PACK(InData%alpha_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%alpha_minus1) + DO i2 = LBOUND(InData%alpha_minus1,2), UBOUND(InData%alpha_minus1,2) + DO i1 = LBOUND(InData%alpha_minus1,1), UBOUND(InData%alpha_minus1,1) + ReKiBuf(Re_Xferred) = InData%alpha_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%alpha_filt_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2174,8 +2141,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%alpha_filt_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%alpha_filt_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%alpha_filt_minus1))-1 ) = PACK(InData%alpha_filt_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%alpha_filt_minus1) + DO i2 = LBOUND(InData%alpha_filt_minus1,2), UBOUND(InData%alpha_filt_minus1,2) + DO i1 = LBOUND(InData%alpha_filt_minus1,1), UBOUND(InData%alpha_filt_minus1,1) + ReKiBuf(Re_Xferred) = InData%alpha_filt_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%q_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2190,8 +2161,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%q_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%q_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%q_minus1))-1 ) = PACK(InData%q_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%q_minus1) + DO i2 = LBOUND(InData%q_minus1,2), UBOUND(InData%q_minus1,2) + DO i1 = LBOUND(InData%q_minus1,1), UBOUND(InData%q_minus1,1) + ReKiBuf(Re_Xferred) = InData%q_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Kalpha_f_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2206,8 +2181,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Kalpha_f_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Kalpha_f_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Kalpha_f_minus1))-1 ) = PACK(InData%Kalpha_f_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Kalpha_f_minus1) + DO i2 = LBOUND(InData%Kalpha_f_minus1,2), UBOUND(InData%Kalpha_f_minus1,2) + DO i1 = LBOUND(InData%Kalpha_f_minus1,1), UBOUND(InData%Kalpha_f_minus1,1) + ReKiBuf(Re_Xferred) = InData%Kalpha_f_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Kq_f_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2222,8 +2201,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Kq_f_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Kq_f_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Kq_f_minus1))-1 ) = PACK(InData%Kq_f_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Kq_f_minus1) + DO i2 = LBOUND(InData%Kq_f_minus1,2), UBOUND(InData%Kq_f_minus1,2) + DO i1 = LBOUND(InData%Kq_f_minus1,1), UBOUND(InData%Kq_f_minus1,1) + ReKiBuf(Re_Xferred) = InData%Kq_f_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%q_f_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2238,8 +2221,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%q_f_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%q_f_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%q_f_minus1))-1 ) = PACK(InData%q_f_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%q_f_minus1) + DO i2 = LBOUND(InData%q_f_minus1,2), UBOUND(InData%q_f_minus1,2) + DO i1 = LBOUND(InData%q_f_minus1,1), UBOUND(InData%q_f_minus1,1) + ReKiBuf(Re_Xferred) = InData%q_f_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%X1_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2254,8 +2241,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X1_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%X1_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%X1_minus1))-1 ) = PACK(InData%X1_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%X1_minus1) + DO i2 = LBOUND(InData%X1_minus1,2), UBOUND(InData%X1_minus1,2) + DO i1 = LBOUND(InData%X1_minus1,1), UBOUND(InData%X1_minus1,1) + ReKiBuf(Re_Xferred) = InData%X1_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%X2_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2270,8 +2261,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X2_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%X2_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%X2_minus1))-1 ) = PACK(InData%X2_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%X2_minus1) + DO i2 = LBOUND(InData%X2_minus1,2), UBOUND(InData%X2_minus1,2) + DO i1 = LBOUND(InData%X2_minus1,1), UBOUND(InData%X2_minus1,1) + ReKiBuf(Re_Xferred) = InData%X2_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%X3_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2286,8 +2281,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X3_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%X3_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%X3_minus1))-1 ) = PACK(InData%X3_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%X3_minus1) + DO i2 = LBOUND(InData%X3_minus1,2), UBOUND(InData%X3_minus1,2) + DO i1 = LBOUND(InData%X3_minus1,1), UBOUND(InData%X3_minus1,1) + ReKiBuf(Re_Xferred) = InData%X3_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%X4_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2302,8 +2301,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X4_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%X4_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%X4_minus1))-1 ) = PACK(InData%X4_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%X4_minus1) + DO i2 = LBOUND(InData%X4_minus1,2), UBOUND(InData%X4_minus1,2) + DO i1 = LBOUND(InData%X4_minus1,1), UBOUND(InData%X4_minus1,1) + ReKiBuf(Re_Xferred) = InData%X4_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Kprime_alpha_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2318,8 +2321,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Kprime_alpha_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Kprime_alpha_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Kprime_alpha_minus1))-1 ) = PACK(InData%Kprime_alpha_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Kprime_alpha_minus1) + DO i2 = LBOUND(InData%Kprime_alpha_minus1,2), UBOUND(InData%Kprime_alpha_minus1,2) + DO i1 = LBOUND(InData%Kprime_alpha_minus1,1), UBOUND(InData%Kprime_alpha_minus1,1) + ReKiBuf(Re_Xferred) = InData%Kprime_alpha_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Kprime_q_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2334,8 +2341,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Kprime_q_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Kprime_q_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Kprime_q_minus1))-1 ) = PACK(InData%Kprime_q_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Kprime_q_minus1) + DO i2 = LBOUND(InData%Kprime_q_minus1,2), UBOUND(InData%Kprime_q_minus1,2) + DO i1 = LBOUND(InData%Kprime_q_minus1,1), UBOUND(InData%Kprime_q_minus1,1) + ReKiBuf(Re_Xferred) = InData%Kprime_q_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Kprimeprime_q_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2350,8 +2361,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Kprimeprime_q_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Kprimeprime_q_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Kprimeprime_q_minus1))-1 ) = PACK(InData%Kprimeprime_q_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Kprimeprime_q_minus1) + DO i2 = LBOUND(InData%Kprimeprime_q_minus1,2), UBOUND(InData%Kprimeprime_q_minus1,2) + DO i1 = LBOUND(InData%Kprimeprime_q_minus1,1), UBOUND(InData%Kprimeprime_q_minus1,1) + ReKiBuf(Re_Xferred) = InData%Kprimeprime_q_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%K3prime_q_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2366,8 +2381,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%K3prime_q_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%K3prime_q_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%K3prime_q_minus1))-1 ) = PACK(InData%K3prime_q_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%K3prime_q_minus1) + DO i2 = LBOUND(InData%K3prime_q_minus1,2), UBOUND(InData%K3prime_q_minus1,2) + DO i1 = LBOUND(InData%K3prime_q_minus1,1), UBOUND(InData%K3prime_q_minus1,1) + ReKiBuf(Re_Xferred) = InData%K3prime_q_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Dp_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2382,8 +2401,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Dp_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Dp_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Dp_minus1))-1 ) = PACK(InData%Dp_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Dp_minus1) + DO i2 = LBOUND(InData%Dp_minus1,2), UBOUND(InData%Dp_minus1,2) + DO i1 = LBOUND(InData%Dp_minus1,1), UBOUND(InData%Dp_minus1,1) + ReKiBuf(Re_Xferred) = InData%Dp_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Cn_pot_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2398,8 +2421,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cn_pot_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Cn_pot_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Cn_pot_minus1))-1 ) = PACK(InData%Cn_pot_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Cn_pot_minus1) + DO i2 = LBOUND(InData%Cn_pot_minus1,2), UBOUND(InData%Cn_pot_minus1,2) + DO i1 = LBOUND(InData%Cn_pot_minus1,1), UBOUND(InData%Cn_pot_minus1,1) + ReKiBuf(Re_Xferred) = InData%Cn_pot_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%fprimeprime_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2414,8 +2441,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fprimeprime_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%fprimeprime_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%fprimeprime_minus1))-1 ) = PACK(InData%fprimeprime_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%fprimeprime_minus1) + DO i2 = LBOUND(InData%fprimeprime_minus1,2), UBOUND(InData%fprimeprime_minus1,2) + DO i1 = LBOUND(InData%fprimeprime_minus1,1), UBOUND(InData%fprimeprime_minus1,1) + ReKiBuf(Re_Xferred) = InData%fprimeprime_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%fprimeprime_c_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2430,8 +2461,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fprimeprime_c_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%fprimeprime_c_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%fprimeprime_c_minus1))-1 ) = PACK(InData%fprimeprime_c_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%fprimeprime_c_minus1) + DO i2 = LBOUND(InData%fprimeprime_c_minus1,2), UBOUND(InData%fprimeprime_c_minus1,2) + DO i1 = LBOUND(InData%fprimeprime_c_minus1,1), UBOUND(InData%fprimeprime_c_minus1,1) + ReKiBuf(Re_Xferred) = InData%fprimeprime_c_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%fprimeprime_m_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2446,8 +2481,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fprimeprime_m_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%fprimeprime_m_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%fprimeprime_m_minus1))-1 ) = PACK(InData%fprimeprime_m_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%fprimeprime_m_minus1) + DO i2 = LBOUND(InData%fprimeprime_m_minus1,2), UBOUND(InData%fprimeprime_m_minus1,2) + DO i1 = LBOUND(InData%fprimeprime_m_minus1,1), UBOUND(InData%fprimeprime_m_minus1,1) + ReKiBuf(Re_Xferred) = InData%fprimeprime_m_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Df_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2462,8 +2501,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Df_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Df_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Df_minus1))-1 ) = PACK(InData%Df_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Df_minus1) + DO i2 = LBOUND(InData%Df_minus1,2), UBOUND(InData%Df_minus1,2) + DO i1 = LBOUND(InData%Df_minus1,1), UBOUND(InData%Df_minus1,1) + ReKiBuf(Re_Xferred) = InData%Df_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Df_c_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2478,8 +2521,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Df_c_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Df_c_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Df_c_minus1))-1 ) = PACK(InData%Df_c_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Df_c_minus1) + DO i2 = LBOUND(InData%Df_c_minus1,2), UBOUND(InData%Df_c_minus1,2) + DO i1 = LBOUND(InData%Df_c_minus1,1), UBOUND(InData%Df_c_minus1,1) + ReKiBuf(Re_Xferred) = InData%Df_c_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Df_m_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2494,8 +2541,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Df_m_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Df_m_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Df_m_minus1))-1 ) = PACK(InData%Df_m_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Df_m_minus1) + DO i2 = LBOUND(InData%Df_m_minus1,2), UBOUND(InData%Df_m_minus1,2) + DO i1 = LBOUND(InData%Df_m_minus1,1), UBOUND(InData%Df_m_minus1,1) + ReKiBuf(Re_Xferred) = InData%Df_m_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Dalphaf_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2510,8 +2561,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Dalphaf_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Dalphaf_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Dalphaf_minus1))-1 ) = PACK(InData%Dalphaf_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Dalphaf_minus1) + DO i2 = LBOUND(InData%Dalphaf_minus1,2), UBOUND(InData%Dalphaf_minus1,2) + DO i1 = LBOUND(InData%Dalphaf_minus1,1), UBOUND(InData%Dalphaf_minus1,1) + ReKiBuf(Re_Xferred) = InData%Dalphaf_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%alphaf_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2526,8 +2581,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%alphaf_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%alphaf_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%alphaf_minus1))-1 ) = PACK(InData%alphaf_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%alphaf_minus1) + DO i2 = LBOUND(InData%alphaf_minus1,2), UBOUND(InData%alphaf_minus1,2) + DO i1 = LBOUND(InData%alphaf_minus1,1), UBOUND(InData%alphaf_minus1,1) + ReKiBuf(Re_Xferred) = InData%alphaf_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%fprime_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2542,8 +2601,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fprime_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%fprime_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%fprime_minus1))-1 ) = PACK(InData%fprime_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%fprime_minus1) + DO i2 = LBOUND(InData%fprime_minus1,2), UBOUND(InData%fprime_minus1,2) + DO i1 = LBOUND(InData%fprime_minus1,1), UBOUND(InData%fprime_minus1,1) + ReKiBuf(Re_Xferred) = InData%fprime_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%fprime_c_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2558,8 +2621,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fprime_c_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%fprime_c_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%fprime_c_minus1))-1 ) = PACK(InData%fprime_c_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%fprime_c_minus1) + DO i2 = LBOUND(InData%fprime_c_minus1,2), UBOUND(InData%fprime_c_minus1,2) + DO i1 = LBOUND(InData%fprime_c_minus1,1), UBOUND(InData%fprime_c_minus1,1) + ReKiBuf(Re_Xferred) = InData%fprime_c_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%fprime_m_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2574,8 +2641,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fprime_m_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%fprime_m_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%fprime_m_minus1))-1 ) = PACK(InData%fprime_m_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%fprime_m_minus1) + DO i2 = LBOUND(InData%fprime_m_minus1,2), UBOUND(InData%fprime_m_minus1,2) + DO i1 = LBOUND(InData%fprime_m_minus1,1), UBOUND(InData%fprime_m_minus1,1) + ReKiBuf(Re_Xferred) = InData%fprime_m_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%tau_V) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2590,8 +2661,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%tau_V,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%tau_V)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%tau_V))-1 ) = PACK(InData%tau_V,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%tau_V) + DO i2 = LBOUND(InData%tau_V,2), UBOUND(InData%tau_V,2) + DO i1 = LBOUND(InData%tau_V,1), UBOUND(InData%tau_V,1) + ReKiBuf(Re_Xferred) = InData%tau_V(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%tau_V_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2606,8 +2681,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%tau_V_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%tau_V_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%tau_V_minus1))-1 ) = PACK(InData%tau_V_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%tau_V_minus1) + DO i2 = LBOUND(InData%tau_V_minus1,2), UBOUND(InData%tau_V_minus1,2) + DO i1 = LBOUND(InData%tau_V_minus1,1), UBOUND(InData%tau_V_minus1,1) + ReKiBuf(Re_Xferred) = InData%tau_V_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Cn_v_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2622,8 +2701,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cn_v_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Cn_v_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Cn_v_minus1))-1 ) = PACK(InData%Cn_v_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Cn_v_minus1) + DO i2 = LBOUND(InData%Cn_v_minus1,2), UBOUND(InData%Cn_v_minus1,2) + DO i1 = LBOUND(InData%Cn_v_minus1,1), UBOUND(InData%Cn_v_minus1,1) + ReKiBuf(Re_Xferred) = InData%Cn_v_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%C_V_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2638,8 +2721,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C_V_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%C_V_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%C_V_minus1))-1 ) = PACK(InData%C_V_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%C_V_minus1) + DO i2 = LBOUND(InData%C_V_minus1,2), UBOUND(InData%C_V_minus1,2) + DO i1 = LBOUND(InData%C_V_minus1,1), UBOUND(InData%C_V_minus1,1) + ReKiBuf(Re_Xferred) = InData%C_V_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Cn_prime_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2654,8 +2741,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cn_prime_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Cn_prime_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Cn_prime_minus1))-1 ) = PACK(InData%Cn_prime_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Cn_prime_minus1) + DO i2 = LBOUND(InData%Cn_prime_minus1,2), UBOUND(InData%Cn_prime_minus1,2) + DO i1 = LBOUND(InData%Cn_prime_minus1,1), UBOUND(InData%Cn_prime_minus1,1) + ReKiBuf(Re_Xferred) = InData%Cn_prime_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE UA_PackDiscState @@ -2672,12 +2763,6 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -2709,15 +2794,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%alpha_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%alpha_minus1)>0) OutData%alpha_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%alpha_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%alpha_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%alpha_minus1,2), UBOUND(OutData%alpha_minus1,2) + DO i1 = LBOUND(OutData%alpha_minus1,1), UBOUND(OutData%alpha_minus1,1) + OutData%alpha_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! alpha_filt_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -2735,15 +2817,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%alpha_filt_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%alpha_filt_minus1)>0) OutData%alpha_filt_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%alpha_filt_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%alpha_filt_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%alpha_filt_minus1,2), UBOUND(OutData%alpha_filt_minus1,2) + DO i1 = LBOUND(OutData%alpha_filt_minus1,1), UBOUND(OutData%alpha_filt_minus1,1) + OutData%alpha_filt_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! q_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -2761,15 +2840,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%q_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%q_minus1)>0) OutData%q_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%q_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%q_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%q_minus1,2), UBOUND(OutData%q_minus1,2) + DO i1 = LBOUND(OutData%q_minus1,1), UBOUND(OutData%q_minus1,1) + OutData%q_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Kalpha_f_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -2787,15 +2863,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Kalpha_f_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Kalpha_f_minus1)>0) OutData%Kalpha_f_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Kalpha_f_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Kalpha_f_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Kalpha_f_minus1,2), UBOUND(OutData%Kalpha_f_minus1,2) + DO i1 = LBOUND(OutData%Kalpha_f_minus1,1), UBOUND(OutData%Kalpha_f_minus1,1) + OutData%Kalpha_f_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Kq_f_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -2813,15 +2886,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Kq_f_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Kq_f_minus1)>0) OutData%Kq_f_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Kq_f_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Kq_f_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Kq_f_minus1,2), UBOUND(OutData%Kq_f_minus1,2) + DO i1 = LBOUND(OutData%Kq_f_minus1,1), UBOUND(OutData%Kq_f_minus1,1) + OutData%Kq_f_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! q_f_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -2839,15 +2909,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%q_f_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%q_f_minus1)>0) OutData%q_f_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%q_f_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%q_f_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%q_f_minus1,2), UBOUND(OutData%q_f_minus1,2) + DO i1 = LBOUND(OutData%q_f_minus1,1), UBOUND(OutData%q_f_minus1,1) + OutData%q_f_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! X1_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -2865,15 +2932,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%X1_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%X1_minus1)>0) OutData%X1_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%X1_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%X1_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%X1_minus1,2), UBOUND(OutData%X1_minus1,2) + DO i1 = LBOUND(OutData%X1_minus1,1), UBOUND(OutData%X1_minus1,1) + OutData%X1_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! X2_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -2891,15 +2955,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%X2_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%X2_minus1)>0) OutData%X2_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%X2_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%X2_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%X2_minus1,2), UBOUND(OutData%X2_minus1,2) + DO i1 = LBOUND(OutData%X2_minus1,1), UBOUND(OutData%X2_minus1,1) + OutData%X2_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! X3_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -2917,15 +2978,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%X3_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%X3_minus1)>0) OutData%X3_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%X3_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%X3_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%X3_minus1,2), UBOUND(OutData%X3_minus1,2) + DO i1 = LBOUND(OutData%X3_minus1,1), UBOUND(OutData%X3_minus1,1) + OutData%X3_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! X4_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -2943,15 +3001,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%X4_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%X4_minus1)>0) OutData%X4_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%X4_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%X4_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%X4_minus1,2), UBOUND(OutData%X4_minus1,2) + DO i1 = LBOUND(OutData%X4_minus1,1), UBOUND(OutData%X4_minus1,1) + OutData%X4_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Kprime_alpha_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -2969,15 +3024,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Kprime_alpha_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Kprime_alpha_minus1)>0) OutData%Kprime_alpha_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Kprime_alpha_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Kprime_alpha_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Kprime_alpha_minus1,2), UBOUND(OutData%Kprime_alpha_minus1,2) + DO i1 = LBOUND(OutData%Kprime_alpha_minus1,1), UBOUND(OutData%Kprime_alpha_minus1,1) + OutData%Kprime_alpha_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Kprime_q_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -2995,15 +3047,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Kprime_q_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Kprime_q_minus1)>0) OutData%Kprime_q_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Kprime_q_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Kprime_q_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Kprime_q_minus1,2), UBOUND(OutData%Kprime_q_minus1,2) + DO i1 = LBOUND(OutData%Kprime_q_minus1,1), UBOUND(OutData%Kprime_q_minus1,1) + OutData%Kprime_q_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Kprimeprime_q_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -3021,15 +3070,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Kprimeprime_q_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Kprimeprime_q_minus1)>0) OutData%Kprimeprime_q_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Kprimeprime_q_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Kprimeprime_q_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Kprimeprime_q_minus1,2), UBOUND(OutData%Kprimeprime_q_minus1,2) + DO i1 = LBOUND(OutData%Kprimeprime_q_minus1,1), UBOUND(OutData%Kprimeprime_q_minus1,1) + OutData%Kprimeprime_q_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! K3prime_q_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -3047,15 +3093,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%K3prime_q_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%K3prime_q_minus1)>0) OutData%K3prime_q_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%K3prime_q_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%K3prime_q_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%K3prime_q_minus1,2), UBOUND(OutData%K3prime_q_minus1,2) + DO i1 = LBOUND(OutData%K3prime_q_minus1,1), UBOUND(OutData%K3prime_q_minus1,1) + OutData%K3prime_q_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Dp_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -3073,15 +3116,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Dp_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Dp_minus1)>0) OutData%Dp_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Dp_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Dp_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Dp_minus1,2), UBOUND(OutData%Dp_minus1,2) + DO i1 = LBOUND(OutData%Dp_minus1,1), UBOUND(OutData%Dp_minus1,1) + OutData%Dp_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cn_pot_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -3099,15 +3139,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cn_pot_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Cn_pot_minus1)>0) OutData%Cn_pot_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Cn_pot_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Cn_pot_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Cn_pot_minus1,2), UBOUND(OutData%Cn_pot_minus1,2) + DO i1 = LBOUND(OutData%Cn_pot_minus1,1), UBOUND(OutData%Cn_pot_minus1,1) + OutData%Cn_pot_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fprimeprime_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -3125,15 +3162,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fprimeprime_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%fprimeprime_minus1)>0) OutData%fprimeprime_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%fprimeprime_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%fprimeprime_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%fprimeprime_minus1,2), UBOUND(OutData%fprimeprime_minus1,2) + DO i1 = LBOUND(OutData%fprimeprime_minus1,1), UBOUND(OutData%fprimeprime_minus1,1) + OutData%fprimeprime_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fprimeprime_c_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -3151,15 +3185,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fprimeprime_c_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%fprimeprime_c_minus1)>0) OutData%fprimeprime_c_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%fprimeprime_c_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%fprimeprime_c_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%fprimeprime_c_minus1,2), UBOUND(OutData%fprimeprime_c_minus1,2) + DO i1 = LBOUND(OutData%fprimeprime_c_minus1,1), UBOUND(OutData%fprimeprime_c_minus1,1) + OutData%fprimeprime_c_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fprimeprime_m_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -3177,15 +3208,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fprimeprime_m_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%fprimeprime_m_minus1)>0) OutData%fprimeprime_m_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%fprimeprime_m_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%fprimeprime_m_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%fprimeprime_m_minus1,2), UBOUND(OutData%fprimeprime_m_minus1,2) + DO i1 = LBOUND(OutData%fprimeprime_m_minus1,1), UBOUND(OutData%fprimeprime_m_minus1,1) + OutData%fprimeprime_m_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Df_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -3203,15 +3231,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Df_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Df_minus1)>0) OutData%Df_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Df_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Df_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Df_minus1,2), UBOUND(OutData%Df_minus1,2) + DO i1 = LBOUND(OutData%Df_minus1,1), UBOUND(OutData%Df_minus1,1) + OutData%Df_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Df_c_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -3229,15 +3254,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Df_c_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Df_c_minus1)>0) OutData%Df_c_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Df_c_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Df_c_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Df_c_minus1,2), UBOUND(OutData%Df_c_minus1,2) + DO i1 = LBOUND(OutData%Df_c_minus1,1), UBOUND(OutData%Df_c_minus1,1) + OutData%Df_c_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Df_m_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -3255,15 +3277,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Df_m_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Df_m_minus1)>0) OutData%Df_m_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Df_m_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Df_m_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Df_m_minus1,2), UBOUND(OutData%Df_m_minus1,2) + DO i1 = LBOUND(OutData%Df_m_minus1,1), UBOUND(OutData%Df_m_minus1,1) + OutData%Df_m_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Dalphaf_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -3281,15 +3300,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Dalphaf_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Dalphaf_minus1)>0) OutData%Dalphaf_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Dalphaf_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Dalphaf_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Dalphaf_minus1,2), UBOUND(OutData%Dalphaf_minus1,2) + DO i1 = LBOUND(OutData%Dalphaf_minus1,1), UBOUND(OutData%Dalphaf_minus1,1) + OutData%Dalphaf_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! alphaf_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -3307,15 +3323,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%alphaf_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%alphaf_minus1)>0) OutData%alphaf_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%alphaf_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%alphaf_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%alphaf_minus1,2), UBOUND(OutData%alphaf_minus1,2) + DO i1 = LBOUND(OutData%alphaf_minus1,1), UBOUND(OutData%alphaf_minus1,1) + OutData%alphaf_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fprime_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -3333,15 +3346,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fprime_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%fprime_minus1)>0) OutData%fprime_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%fprime_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%fprime_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%fprime_minus1,2), UBOUND(OutData%fprime_minus1,2) + DO i1 = LBOUND(OutData%fprime_minus1,1), UBOUND(OutData%fprime_minus1,1) + OutData%fprime_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fprime_c_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -3359,15 +3369,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fprime_c_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%fprime_c_minus1)>0) OutData%fprime_c_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%fprime_c_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%fprime_c_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%fprime_c_minus1,2), UBOUND(OutData%fprime_c_minus1,2) + DO i1 = LBOUND(OutData%fprime_c_minus1,1), UBOUND(OutData%fprime_c_minus1,1) + OutData%fprime_c_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fprime_m_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -3385,15 +3392,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fprime_m_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%fprime_m_minus1)>0) OutData%fprime_m_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%fprime_m_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%fprime_m_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%fprime_m_minus1,2), UBOUND(OutData%fprime_m_minus1,2) + DO i1 = LBOUND(OutData%fprime_m_minus1,1), UBOUND(OutData%fprime_m_minus1,1) + OutData%fprime_m_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! tau_V not allocated Int_Xferred = Int_Xferred + 1 @@ -3411,15 +3415,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%tau_V.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%tau_V)>0) OutData%tau_V = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%tau_V))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%tau_V) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%tau_V,2), UBOUND(OutData%tau_V,2) + DO i1 = LBOUND(OutData%tau_V,1), UBOUND(OutData%tau_V,1) + OutData%tau_V(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! tau_V_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -3437,15 +3438,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%tau_V_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%tau_V_minus1)>0) OutData%tau_V_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%tau_V_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%tau_V_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%tau_V_minus1,2), UBOUND(OutData%tau_V_minus1,2) + DO i1 = LBOUND(OutData%tau_V_minus1,1), UBOUND(OutData%tau_V_minus1,1) + OutData%tau_V_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cn_v_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -3463,15 +3461,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cn_v_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Cn_v_minus1)>0) OutData%Cn_v_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Cn_v_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Cn_v_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Cn_v_minus1,2), UBOUND(OutData%Cn_v_minus1,2) + DO i1 = LBOUND(OutData%Cn_v_minus1,1), UBOUND(OutData%Cn_v_minus1,1) + OutData%Cn_v_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C_V_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -3489,15 +3484,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C_V_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%C_V_minus1)>0) OutData%C_V_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%C_V_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%C_V_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%C_V_minus1,2), UBOUND(OutData%C_V_minus1,2) + DO i1 = LBOUND(OutData%C_V_minus1,1), UBOUND(OutData%C_V_minus1,1) + OutData%C_V_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cn_prime_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -3515,15 +3507,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cn_prime_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Cn_prime_minus1)>0) OutData%Cn_prime_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Cn_prime_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Cn_prime_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Cn_prime_minus1,2), UBOUND(OutData%Cn_prime_minus1,2) + DO i1 = LBOUND(OutData%Cn_prime_minus1,1), UBOUND(OutData%Cn_prime_minus1,1) + OutData%Cn_prime_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE UA_UnPackDiscState @@ -3618,8 +3607,8 @@ SUBROUTINE UA_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstraintState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyConstraintState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE UA_PackConstrState SUBROUTINE UA_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -3635,12 +3624,6 @@ SUBROUTINE UA_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'UA_UnPackConstrState' @@ -3654,8 +3637,8 @@ SUBROUTINE UA_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyConstraintState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyConstraintState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE UA_UnPackConstrState SUBROUTINE UA_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -3872,8 +3855,12 @@ SUBROUTINE UA_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FirstPass,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FirstPass)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%FirstPass)-1 ) = TRANSFER(PACK( InData%FirstPass ,.TRUE.), IntKiBuf(1), SIZE(InData%FirstPass)) - Int_Xferred = Int_Xferred + SIZE(InData%FirstPass) + DO i2 = LBOUND(InData%FirstPass,2), UBOUND(InData%FirstPass,2) + DO i1 = LBOUND(InData%FirstPass,1), UBOUND(InData%FirstPass,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%FirstPass(i1,i2), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%sigma1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3888,8 +3875,12 @@ SUBROUTINE UA_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%sigma1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%sigma1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%sigma1))-1 ) = PACK(InData%sigma1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%sigma1) + DO i2 = LBOUND(InData%sigma1,2), UBOUND(InData%sigma1,2) + DO i1 = LBOUND(InData%sigma1,1), UBOUND(InData%sigma1,1) + ReKiBuf(Re_Xferred) = InData%sigma1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%sigma1c) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3904,8 +3895,12 @@ SUBROUTINE UA_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%sigma1c,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%sigma1c)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%sigma1c))-1 ) = PACK(InData%sigma1c,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%sigma1c) + DO i2 = LBOUND(InData%sigma1c,2), UBOUND(InData%sigma1c,2) + DO i1 = LBOUND(InData%sigma1c,1), UBOUND(InData%sigma1c,1) + ReKiBuf(Re_Xferred) = InData%sigma1c(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%sigma1m) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3920,8 +3915,12 @@ SUBROUTINE UA_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%sigma1m,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%sigma1m)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%sigma1m))-1 ) = PACK(InData%sigma1m,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%sigma1m) + DO i2 = LBOUND(InData%sigma1m,2), UBOUND(InData%sigma1m,2) + DO i1 = LBOUND(InData%sigma1m,1), UBOUND(InData%sigma1m,1) + ReKiBuf(Re_Xferred) = InData%sigma1m(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%sigma3) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3936,8 +3935,12 @@ SUBROUTINE UA_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%sigma3,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%sigma3)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%sigma3))-1 ) = PACK(InData%sigma3,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%sigma3) + DO i2 = LBOUND(InData%sigma3,2), UBOUND(InData%sigma3,2) + DO i1 = LBOUND(InData%sigma3,1), UBOUND(InData%sigma3,1) + ReKiBuf(Re_Xferred) = InData%sigma3(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE UA_PackOtherState @@ -3954,12 +3957,6 @@ SUBROUTINE UA_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -3991,15 +3988,12 @@ SUBROUTINE UA_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FirstPass.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%FirstPass)>0) OutData%FirstPass = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%FirstPass))-1 ), OutData%FirstPass), mask2,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%FirstPass) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%FirstPass,2), UBOUND(OutData%FirstPass,2) + DO i1 = LBOUND(OutData%FirstPass,1), UBOUND(OutData%FirstPass,1) + OutData%FirstPass(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstPass(i1,i2)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! sigma1 not allocated Int_Xferred = Int_Xferred + 1 @@ -4017,15 +4011,12 @@ SUBROUTINE UA_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%sigma1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%sigma1)>0) OutData%sigma1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%sigma1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%sigma1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%sigma1,2), UBOUND(OutData%sigma1,2) + DO i1 = LBOUND(OutData%sigma1,1), UBOUND(OutData%sigma1,1) + OutData%sigma1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! sigma1c not allocated Int_Xferred = Int_Xferred + 1 @@ -4043,15 +4034,12 @@ SUBROUTINE UA_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%sigma1c.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%sigma1c)>0) OutData%sigma1c = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%sigma1c))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%sigma1c) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%sigma1c,2), UBOUND(OutData%sigma1c,2) + DO i1 = LBOUND(OutData%sigma1c,1), UBOUND(OutData%sigma1c,1) + OutData%sigma1c(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! sigma1m not allocated Int_Xferred = Int_Xferred + 1 @@ -4069,15 +4057,12 @@ SUBROUTINE UA_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%sigma1m.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%sigma1m)>0) OutData%sigma1m = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%sigma1m))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%sigma1m) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%sigma1m,2), UBOUND(OutData%sigma1m,2) + DO i1 = LBOUND(OutData%sigma1m,1), UBOUND(OutData%sigma1m,1) + OutData%sigma1m(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! sigma3 not allocated Int_Xferred = Int_Xferred + 1 @@ -4095,15 +4080,12 @@ SUBROUTINE UA_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%sigma3.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%sigma3)>0) OutData%sigma3 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%sigma3))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%sigma3) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%sigma3,2), UBOUND(OutData%sigma3,2) + DO i1 = LBOUND(OutData%sigma3,1), UBOUND(OutData%sigma3,1) + OutData%sigma3(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE UA_UnPackOtherState @@ -4314,12 +4296,12 @@ SUBROUTINE UA_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%FirstWarn_M , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%iBladeNode - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%iBlade - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%FirstWarn_M, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%iBladeNode + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%iBlade + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%TESF) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4333,8 +4315,12 @@ SUBROUTINE UA_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TESF,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TESF)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%TESF)-1 ) = TRANSFER(PACK( InData%TESF ,.TRUE.), IntKiBuf(1), SIZE(InData%TESF)) - Int_Xferred = Int_Xferred + SIZE(InData%TESF) + DO i2 = LBOUND(InData%TESF,2), UBOUND(InData%TESF,2) + DO i1 = LBOUND(InData%TESF,1), UBOUND(InData%TESF,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%TESF(i1,i2), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%LESF) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4349,8 +4335,12 @@ SUBROUTINE UA_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LESF,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LESF)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%LESF)-1 ) = TRANSFER(PACK( InData%LESF ,.TRUE.), IntKiBuf(1), SIZE(InData%LESF)) - Int_Xferred = Int_Xferred + SIZE(InData%LESF) + DO i2 = LBOUND(InData%LESF,2), UBOUND(InData%LESF,2) + DO i1 = LBOUND(InData%LESF,1), UBOUND(InData%LESF,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%LESF(i1,i2), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%VRTX) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4365,8 +4355,12 @@ SUBROUTINE UA_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VRTX,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%VRTX)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%VRTX)-1 ) = TRANSFER(PACK( InData%VRTX ,.TRUE.), IntKiBuf(1), SIZE(InData%VRTX)) - Int_Xferred = Int_Xferred + SIZE(InData%VRTX) + DO i2 = LBOUND(InData%VRTX,2), UBOUND(InData%VRTX,2) + DO i1 = LBOUND(InData%VRTX,1), UBOUND(InData%VRTX,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%VRTX(i1,i2), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%T_Sh) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4381,8 +4375,12 @@ SUBROUTINE UA_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%T_Sh,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%T_Sh)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%T_Sh))-1 ) = PACK(InData%T_Sh,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%T_Sh) + DO i2 = LBOUND(InData%T_Sh,2), UBOUND(InData%T_Sh,2) + DO i1 = LBOUND(InData%T_Sh,1), UBOUND(InData%T_Sh,1) + ReKiBuf(Re_Xferred) = InData%T_Sh(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%BEDSEP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4397,8 +4395,12 @@ SUBROUTINE UA_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BEDSEP,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BEDSEP)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%BEDSEP)-1 ) = TRANSFER(PACK( InData%BEDSEP ,.TRUE.), IntKiBuf(1), SIZE(InData%BEDSEP)) - Int_Xferred = Int_Xferred + SIZE(InData%BEDSEP) + DO i2 = LBOUND(InData%BEDSEP,2), UBOUND(InData%BEDSEP,2) + DO i1 = LBOUND(InData%BEDSEP,1), UBOUND(InData%BEDSEP,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%BEDSEP(i1,i2), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF END SUBROUTINE UA_PackMisc @@ -4415,12 +4417,6 @@ SUBROUTINE UA_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -4436,12 +4432,12 @@ SUBROUTINE UA_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%FirstWarn_M = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%iBladeNode = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%iBlade = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%FirstWarn_M = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstWarn_M) + Int_Xferred = Int_Xferred + 1 + OutData%iBladeNode = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%iBlade = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TESF not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -4458,15 +4454,12 @@ SUBROUTINE UA_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TESF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%TESF)>0) OutData%TESF = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%TESF))-1 ), OutData%TESF), mask2,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%TESF) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%TESF,2), UBOUND(OutData%TESF,2) + DO i1 = LBOUND(OutData%TESF,1), UBOUND(OutData%TESF,1) + OutData%TESF(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%TESF(i1,i2)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LESF not allocated Int_Xferred = Int_Xferred + 1 @@ -4484,15 +4477,12 @@ SUBROUTINE UA_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LESF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%LESF)>0) OutData%LESF = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%LESF))-1 ), OutData%LESF), mask2,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%LESF) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%LESF,2), UBOUND(OutData%LESF,2) + DO i1 = LBOUND(OutData%LESF,1), UBOUND(OutData%LESF,1) + OutData%LESF(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%LESF(i1,i2)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VRTX not allocated Int_Xferred = Int_Xferred + 1 @@ -4510,15 +4500,12 @@ SUBROUTINE UA_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VRTX.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%VRTX)>0) OutData%VRTX = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%VRTX))-1 ), OutData%VRTX), mask2,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%VRTX) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%VRTX,2), UBOUND(OutData%VRTX,2) + DO i1 = LBOUND(OutData%VRTX,1), UBOUND(OutData%VRTX,1) + OutData%VRTX(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%VRTX(i1,i2)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! T_Sh not allocated Int_Xferred = Int_Xferred + 1 @@ -4536,15 +4523,12 @@ SUBROUTINE UA_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%T_Sh.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%T_Sh)>0) OutData%T_Sh = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%T_Sh))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%T_Sh) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%T_Sh,2), UBOUND(OutData%T_Sh,2) + DO i1 = LBOUND(OutData%T_Sh,1), UBOUND(OutData%T_Sh,1) + OutData%T_Sh(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BEDSEP not allocated Int_Xferred = Int_Xferred + 1 @@ -4562,15 +4546,12 @@ SUBROUTINE UA_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BEDSEP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%BEDSEP)>0) OutData%BEDSEP = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%BEDSEP))-1 ), OutData%BEDSEP), mask2,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%BEDSEP) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%BEDSEP,2), UBOUND(OutData%BEDSEP,2) + DO i1 = LBOUND(OutData%BEDSEP,1), UBOUND(OutData%BEDSEP,1) + OutData%BEDSEP(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%BEDSEP(i1,i2)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF END SUBROUTINE UA_UnPackMisc @@ -4711,8 +4692,8 @@ SUBROUTINE UA_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%dt - Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%dt + Db_Xferred = Db_Xferred + 1 IF ( .NOT. ALLOCATED(InData%c) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4726,37 +4707,41 @@ SUBROUTINE UA_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%c,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%c)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%c))-1 ) = PACK(InData%c,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%c) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%numBlades - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%nNodesPerBlade - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UAMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Flookup , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%a_s - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%OutSwtch - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutSFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%Delim) - IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UnOutFile - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(InData%c,2), UBOUND(InData%c,2) + DO i1 = LBOUND(InData%c,1), UBOUND(InData%c,1) + ReKiBuf(Re_Xferred) = InData%c(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IntKiBuf(Int_Xferred) = InData%numBlades + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nNodesPerBlade + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%UAMod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%Flookup, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%a_s + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%OutSwtch + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%OutFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%OutSFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%Delim) + IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%UnOutFile + Int_Xferred = Int_Xferred + 1 END SUBROUTINE UA_PackParam SUBROUTINE UA_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -4772,12 +4757,6 @@ SUBROUTINE UA_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -4793,8 +4772,8 @@ SUBROUTINE UA_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%dt = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%dt = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! c not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -4811,44 +4790,41 @@ SUBROUTINE UA_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%c.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%c)>0) OutData%c = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%c))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%c) - DEALLOCATE(mask2) - END IF - OutData%numBlades = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%nNodesPerBlade = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%UAMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%Flookup = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%a_s = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%OutSwtch = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutSFmt) - OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%UnOutFile = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(OutData%c,2), UBOUND(OutData%c,2) + DO i1 = LBOUND(OutData%c,1), UBOUND(OutData%c,1) + OutData%c(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%numBlades = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nNodesPerBlade = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%UAMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Flookup = TRANSFER(IntKiBuf(Int_Xferred), OutData%Flookup) + Int_Xferred = Int_Xferred + 1 + OutData%a_s = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%OutSwtch = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%OutFmt) + OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%OutSFmt) + OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%Delim) + OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%UnOutFile = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE UA_UnPackParam SUBROUTINE UA_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -4948,14 +4924,14 @@ SUBROUTINE UA_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%U - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%alpha - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Re - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%UserProp - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%U + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%alpha + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Re + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%UserProp + Re_Xferred = Re_Xferred + 1 END SUBROUTINE UA_PackInput SUBROUTINE UA_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -4971,12 +4947,6 @@ SUBROUTINE UA_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'UA_UnPackInput' @@ -4990,14 +4960,14 @@ SUBROUTINE UA_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%U = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%alpha = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Re = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%UserProp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%U = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%alpha = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Re = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%UserProp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE UA_UnPackInput SUBROUTINE UA_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -5120,16 +5090,16 @@ SUBROUTINE UA_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cc - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cm - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cl - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cd - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cc + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cm + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cl + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cd + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WriteOutput) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -5140,8 +5110,10 @@ SUBROUTINE UA_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WriteOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE UA_PackOutput @@ -5158,12 +5130,6 @@ SUBROUTINE UA_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -5178,16 +5144,16 @@ SUBROUTINE UA_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%Cn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cm = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cl = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cd = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%Cn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cm = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cl = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cd = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutput not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5201,15 +5167,10 @@ SUBROUTINE UA_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WriteOutput)>0) OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE UA_UnPackOutput @@ -5288,8 +5249,8 @@ SUBROUTINE UA_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'UA_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -5304,14 +5265,16 @@ SUBROUTINE UA_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = -(u1%U - u2%U)/t(2) - u_out%U = u1%U + b0 * t_out - b0 = -(u1%alpha - u2%alpha)/t(2) - u_out%alpha = u1%alpha + b0 * t_out - b0 = -(u1%Re - u2%Re)/t(2) - u_out%Re = u1%Re + b0 * t_out - b0 = -(u1%UserProp - u2%UserProp)/t(2) - u_out%UserProp = u1%UserProp + b0 * t_out + + ScaleFactor = t_out / t(2) + b = -(u1%U - u2%U) + u_out%U = u1%U + b * ScaleFactor + b = -(u1%alpha - u2%alpha) + u_out%alpha = u1%alpha + b * ScaleFactor + b = -(u1%Re - u2%Re) + u_out%Re = u1%Re + b * ScaleFactor + b = -(u1%UserProp - u2%UserProp) + u_out%UserProp = u1%UserProp + b * ScaleFactor END SUBROUTINE UA_Input_ExtrapInterp1 @@ -5341,8 +5304,9 @@ SUBROUTINE UA_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'UA_Input_ExtrapInterp2' @@ -5364,18 +5328,20 @@ SUBROUTINE UA_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = (t(3)**2*(u1%U - u2%U) + t(2)**2*(-u1%U + u3%U))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%U + t(3)*u2%U - t(2)*u3%U ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%U = u1%U + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%alpha - u2%alpha) + t(2)**2*(-u1%alpha + u3%alpha))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%alpha + t(3)*u2%alpha - t(2)*u3%alpha ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%alpha = u1%alpha + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%Re - u2%Re) + t(2)**2*(-u1%Re + u3%Re))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%Re + t(3)*u2%Re - t(2)*u3%Re ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Re = u1%Re + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%UserProp - u2%UserProp) + t(2)**2*(-u1%UserProp + u3%UserProp))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%UserProp + t(3)*u2%UserProp - t(2)*u3%UserProp ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%UserProp = u1%UserProp + b0 * t_out + c0 * t_out**2 + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) + b = (t(3)**2*(u1%U - u2%U) + t(2)**2*(-u1%U + u3%U))* scaleFactor + c = ( (t(2)-t(3))*u1%U + t(3)*u2%U - t(2)*u3%U ) * scaleFactor + u_out%U = u1%U + b + c * t_out + b = (t(3)**2*(u1%alpha - u2%alpha) + t(2)**2*(-u1%alpha + u3%alpha))* scaleFactor + c = ( (t(2)-t(3))*u1%alpha + t(3)*u2%alpha - t(2)*u3%alpha ) * scaleFactor + u_out%alpha = u1%alpha + b + c * t_out + b = (t(3)**2*(u1%Re - u2%Re) + t(2)**2*(-u1%Re + u3%Re))* scaleFactor + c = ( (t(2)-t(3))*u1%Re + t(3)*u2%Re - t(2)*u3%Re ) * scaleFactor + u_out%Re = u1%Re + b + c * t_out + b = (t(3)**2*(u1%UserProp - u2%UserProp) + t(2)**2*(-u1%UserProp + u3%UserProp))* scaleFactor + c = ( (t(2)-t(3))*u1%UserProp + t(3)*u2%UserProp - t(2)*u3%UserProp ) * scaleFactor + u_out%UserProp = u1%UserProp + b + c * t_out END SUBROUTINE UA_Input_ExtrapInterp2 @@ -5453,12 +5419,12 @@ SUBROUTINE UA_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'UA_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! 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 :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -5471,23 +5437,23 @@ SUBROUTINE UA_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = -(y1%Cn - y2%Cn)/t(2) - y_out%Cn = y1%Cn + b0 * t_out - b0 = -(y1%Cc - y2%Cc)/t(2) - y_out%Cc = y1%Cc + b0 * t_out - b0 = -(y1%Cm - y2%Cm)/t(2) - y_out%Cm = y1%Cm + b0 * t_out - b0 = -(y1%Cl - y2%Cl)/t(2) - y_out%Cl = y1%Cl + b0 * t_out - b0 = -(y1%Cd - y2%Cd)/t(2) - y_out%Cd = y1%Cd + b0 * t_out + + ScaleFactor = t_out / t(2) + b = -(y1%Cn - y2%Cn) + y_out%Cn = y1%Cn + b * ScaleFactor + b = -(y1%Cc - y2%Cc) + y_out%Cc = y1%Cc + b * ScaleFactor + b = -(y1%Cm - y2%Cm) + y_out%Cm = y1%Cm + b * ScaleFactor + b = -(y1%Cl - y2%Cl) + y_out%Cl = y1%Cl + b * ScaleFactor + b = -(y1%Cd - y2%Cd) + y_out%Cd = y1%Cd + b * ScaleFactor IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END IF ! check if allocated END SUBROUTINE UA_Output_ExtrapInterp1 @@ -5518,13 +5484,14 @@ SUBROUTINE UA_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'UA_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -5543,29 +5510,29 @@ SUBROUTINE UA_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = (t(3)**2*(y1%Cn - y2%Cn) + t(2)**2*(-y1%Cn + y3%Cn))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%Cn + t(3)*y2%Cn - t(2)*y3%Cn ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Cn = y1%Cn + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%Cc - y2%Cc) + t(2)**2*(-y1%Cc + y3%Cc))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%Cc + t(3)*y2%Cc - t(2)*y3%Cc ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Cc = y1%Cc + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%Cm - y2%Cm) + t(2)**2*(-y1%Cm + y3%Cm))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%Cm + t(3)*y2%Cm - t(2)*y3%Cm ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Cm = y1%Cm + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%Cl - y2%Cl) + t(2)**2*(-y1%Cl + y3%Cl))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%Cl + t(3)*y2%Cl - t(2)*y3%Cl ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Cl = y1%Cl + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%Cd - y2%Cd) + t(2)**2*(-y1%Cd + y3%Cd))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%Cd + t(3)*y2%Cd - t(2)*y3%Cd ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Cd = y1%Cd + b0 * t_out + c0 * t_out**2 + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) + b = (t(3)**2*(y1%Cn - y2%Cn) + t(2)**2*(-y1%Cn + y3%Cn))* scaleFactor + c = ( (t(2)-t(3))*y1%Cn + t(3)*y2%Cn - t(2)*y3%Cn ) * scaleFactor + y_out%Cn = y1%Cn + b + c * t_out + b = (t(3)**2*(y1%Cc - y2%Cc) + t(2)**2*(-y1%Cc + y3%Cc))* scaleFactor + c = ( (t(2)-t(3))*y1%Cc + t(3)*y2%Cc - t(2)*y3%Cc ) * scaleFactor + y_out%Cc = y1%Cc + b + c * t_out + b = (t(3)**2*(y1%Cm - y2%Cm) + t(2)**2*(-y1%Cm + y3%Cm))* scaleFactor + c = ( (t(2)-t(3))*y1%Cm + t(3)*y2%Cm - t(2)*y3%Cm ) * scaleFactor + y_out%Cm = y1%Cm + b + c * t_out + b = (t(3)**2*(y1%Cl - y2%Cl) + t(2)**2*(-y1%Cl + y3%Cl))* scaleFactor + c = ( (t(2)-t(3))*y1%Cl + t(3)*y2%Cl - t(2)*y3%Cl ) * scaleFactor + y_out%Cl = y1%Cl + b + c * t_out + b = (t(3)**2*(y1%Cd - y2%Cd) + t(2)**2*(-y1%Cd + y3%Cd))* scaleFactor + c = ( (t(2)-t(3))*y1%Cd + t(3)*y2%Cd - t(2)*y3%Cd ) * scaleFactor + y_out%Cd = y1%Cd + b + c * t_out IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END IF ! check if allocated END SUBROUTINE UA_Output_ExtrapInterp2 diff --git a/modules/aerodyn14/src/AeroDyn14_Types.f90 b/modules/aerodyn14/src/AeroDyn14_Types.f90 index 315d478986..ad4321d6bf 100644 --- a/modules/aerodyn14/src/AeroDyn14_Types.f90 +++ b/modules/aerodyn14/src/AeroDyn14_Types.f90 @@ -577,14 +577,24 @@ SUBROUTINE AD14_PackMarker( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Position))-1 ) = PACK(InData%Position,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Position) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Orientation))-1 ) = PACK(InData%Orientation,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Orientation) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TranslationVel))-1 ) = PACK(InData%TranslationVel,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TranslationVel) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RotationVel))-1 ) = PACK(InData%RotationVel,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RotationVel) + DO i1 = LBOUND(InData%Position,1), UBOUND(InData%Position,1) + ReKiBuf(Re_Xferred) = InData%Position(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i2 = LBOUND(InData%Orientation,2), UBOUND(InData%Orientation,2) + DO i1 = LBOUND(InData%Orientation,1), UBOUND(InData%Orientation,1) + ReKiBuf(Re_Xferred) = InData%Orientation(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i1 = LBOUND(InData%TranslationVel,1), UBOUND(InData%TranslationVel,1) + ReKiBuf(Re_Xferred) = InData%TranslationVel(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%RotationVel,1), UBOUND(InData%RotationVel,1) + ReKiBuf(Re_Xferred) = InData%RotationVel(i1) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE AD14_PackMarker SUBROUTINE AD14_UnPackMarker( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -600,12 +610,6 @@ SUBROUTINE AD14_UnPackMarker( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -624,50 +628,32 @@ SUBROUTINE AD14_UnPackMarker( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM Int_Xferred = 1 i1_l = LBOUND(OutData%Position,1) i1_u = UBOUND(OutData%Position,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%Position = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Position))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Position) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Position,1), UBOUND(OutData%Position,1) + OutData%Position(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%Orientation,1) i1_u = UBOUND(OutData%Orientation,1) i2_l = LBOUND(OutData%Orientation,2) i2_u = UBOUND(OutData%Orientation,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%Orientation = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Orientation))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Orientation) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Orientation,2), UBOUND(OutData%Orientation,2) + DO i1 = LBOUND(OutData%Orientation,1), UBOUND(OutData%Orientation,1) + OutData%Orientation(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%TranslationVel,1) i1_u = UBOUND(OutData%TranslationVel,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%TranslationVel = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TranslationVel))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TranslationVel) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TranslationVel,1), UBOUND(OutData%TranslationVel,1) + OutData%TranslationVel(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%RotationVel,1) i1_u = UBOUND(OutData%RotationVel,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%RotationVel = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RotationVel))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RotationVel) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%RotationVel,1), UBOUND(OutData%RotationVel,1) + OutData%RotationVel(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE AD14_UnPackMarker SUBROUTINE AD14_CopyAeroConfig( SrcAeroConfigData, DstAeroConfigData, CtrlCode, ErrStat, ErrMsg ) @@ -1192,8 +1178,8 @@ SUBROUTINE AD14_PackAeroConfig( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%BladeLength - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%BladeLength + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_PackAeroConfig SUBROUTINE AD14_UnPackAeroConfig( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1209,12 +1195,6 @@ SUBROUTINE AD14_UnPackAeroConfig( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1565,8 +1545,8 @@ SUBROUTINE AD14_UnPackAeroConfig( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%BladeLength = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%BladeLength = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_UnPackAeroConfig SUBROUTINE AD14_CopyAirFoil( SrcAirFoilData, DstAirFoilData, CtrlCode, ErrStat, ErrMsg ) @@ -1772,8 +1752,12 @@ SUBROUTINE AD14_PackAirFoil( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AL,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AL)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AL))-1 ) = PACK(InData%AL,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AL) + DO i2 = LBOUND(InData%AL,2), UBOUND(InData%AL,2) + DO i1 = LBOUND(InData%AL,1), UBOUND(InData%AL,1) + ReKiBuf(Re_Xferred) = InData%AL(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%CD) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1791,8 +1775,14 @@ SUBROUTINE AD14_PackAirFoil( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CD,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CD)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CD))-1 ) = PACK(InData%CD,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CD) + DO i3 = LBOUND(InData%CD,3), UBOUND(InData%CD,3) + DO i2 = LBOUND(InData%CD,2), UBOUND(InData%CD,2) + DO i1 = LBOUND(InData%CD,1), UBOUND(InData%CD,1) + ReKiBuf(Re_Xferred) = InData%CD(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%CL) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1810,8 +1800,14 @@ SUBROUTINE AD14_PackAirFoil( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CL,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CL)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CL))-1 ) = PACK(InData%CL,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CL) + DO i3 = LBOUND(InData%CL,3), UBOUND(InData%CL,3) + DO i2 = LBOUND(InData%CL,2), UBOUND(InData%CL,2) + DO i1 = LBOUND(InData%CL,1), UBOUND(InData%CL,1) + ReKiBuf(Re_Xferred) = InData%CL(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%CM) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1829,13 +1825,19 @@ SUBROUTINE AD14_PackAirFoil( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CM,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CM)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CM))-1 ) = PACK(InData%CM,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CM) + DO i3 = LBOUND(InData%CM,3), UBOUND(InData%CM,3) + DO i2 = LBOUND(InData%CM,2), UBOUND(InData%CM,2) + DO i1 = LBOUND(InData%CM,1), UBOUND(InData%CM,1) + ReKiBuf(Re_Xferred) = InData%CM(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PMC - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MulTabLoc - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PMC + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MulTabLoc + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_PackAirFoil SUBROUTINE AD14_UnPackAirFoil( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1851,12 +1853,6 @@ SUBROUTINE AD14_UnPackAirFoil( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -1889,15 +1885,12 @@ SUBROUTINE AD14_UnPackAirFoil( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AL.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%AL)>0) OutData%AL = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AL))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AL) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AL,2), UBOUND(OutData%AL,2) + DO i1 = LBOUND(OutData%AL,1), UBOUND(OutData%AL,1) + OutData%AL(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CD not allocated Int_Xferred = Int_Xferred + 1 @@ -1918,15 +1911,14 @@ SUBROUTINE AD14_UnPackAirFoil( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CD.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%CD)>0) OutData%CD = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CD))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CD) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%CD,3), UBOUND(OutData%CD,3) + DO i2 = LBOUND(OutData%CD,2), UBOUND(OutData%CD,2) + DO i1 = LBOUND(OutData%CD,1), UBOUND(OutData%CD,1) + OutData%CD(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 ! CL not allocated Int_Xferred = Int_Xferred + 1 @@ -1947,15 +1939,14 @@ SUBROUTINE AD14_UnPackAirFoil( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CL.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%CL)>0) OutData%CL = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CL))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CL) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%CL,3), UBOUND(OutData%CL,3) + DO i2 = LBOUND(OutData%CL,2), UBOUND(OutData%CL,2) + DO i1 = LBOUND(OutData%CL,1), UBOUND(OutData%CL,1) + OutData%CL(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 ! CM not allocated Int_Xferred = Int_Xferred + 1 @@ -1976,20 +1967,19 @@ SUBROUTINE AD14_UnPackAirFoil( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CM.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%CM)>0) OutData%CM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CM))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CM) - DEALLOCATE(mask3) - END IF - OutData%PMC = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MulTabLoc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i3 = LBOUND(OutData%CM,3), UBOUND(OutData%CM,3) + DO i2 = LBOUND(OutData%CM,2), UBOUND(OutData%CM,2) + DO i1 = LBOUND(OutData%CM,1), UBOUND(OutData%CM,1) + OutData%CM(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + OutData%PMC = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MulTabLoc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_UnPackAirFoil SUBROUTINE AD14_CopyAirFoilParms( SrcAirFoilParmsData, DstAirFoilParmsData, CtrlCode, ErrStat, ErrMsg ) @@ -2191,8 +2181,8 @@ SUBROUTINE AD14_PackAirFoilParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MaxTable - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MaxTable + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%NTables) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2203,8 +2193,10 @@ SUBROUTINE AD14_PackAirFoilParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NTables,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%NTables)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%NTables))-1 ) = PACK(InData%NTables,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%NTables) + DO i1 = LBOUND(InData%NTables,1), UBOUND(InData%NTables,1) + IntKiBuf(Int_Xferred) = InData%NTables(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%NLift) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2216,13 +2208,15 @@ SUBROUTINE AD14_PackAirFoilParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NLift,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%NLift)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%NLift))-1 ) = PACK(InData%NLift,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%NLift) + DO i1 = LBOUND(InData%NLift,1), UBOUND(InData%NLift,1) + IntKiBuf(Int_Xferred) = InData%NLift(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumCL - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumFoil - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumCL + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumFoil + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%NFoil) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2233,8 +2227,10 @@ SUBROUTINE AD14_PackAirFoilParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NFoil,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%NFoil)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%NFoil))-1 ) = PACK(InData%NFoil,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%NFoil) + DO i1 = LBOUND(InData%NFoil,1), UBOUND(InData%NFoil,1) + IntKiBuf(Int_Xferred) = InData%NFoil(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%MulTabMet) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2249,8 +2245,12 @@ SUBROUTINE AD14_PackAirFoilParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MulTabMet,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%MulTabMet)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MulTabMet))-1 ) = PACK(InData%MulTabMet,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MulTabMet) + DO i2 = LBOUND(InData%MulTabMet,2), UBOUND(InData%MulTabMet,2) + DO i1 = LBOUND(InData%MulTabMet,1), UBOUND(InData%MulTabMet,1) + ReKiBuf(Re_Xferred) = InData%MulTabMet(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FoilNm) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2262,12 +2262,12 @@ SUBROUTINE AD14_PackAirFoilParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FoilNm,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%FoilNm,1), UBOUND(InData%FoilNm,1) + DO i1 = LBOUND(InData%FoilNm,1), UBOUND(InData%FoilNm,1) DO I = 1, LEN(InData%FoilNm) IntKiBuf(Int_Xferred) = ICHAR(InData%FoilNm(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF END SUBROUTINE AD14_PackAirFoilParms @@ -2284,12 +2284,6 @@ SUBROUTINE AD14_UnPackAirFoilParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -2305,8 +2299,8 @@ SUBROUTINE AD14_UnPackAirFoilParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%MaxTable = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%MaxTable = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NTables not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2320,15 +2314,10 @@ SUBROUTINE AD14_UnPackAirFoilParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NTables.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%NTables)>0) OutData%NTables = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%NTables))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%NTables) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%NTables,1), UBOUND(OutData%NTables,1) + OutData%NTables(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NLift not allocated Int_Xferred = Int_Xferred + 1 @@ -2343,20 +2332,15 @@ SUBROUTINE AD14_UnPackAirFoilParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NLift.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%NLift)>0) OutData%NLift = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%NLift))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%NLift) - DEALLOCATE(mask1) - END IF - OutData%NumCL = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumFoil = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%NLift,1), UBOUND(OutData%NLift,1) + OutData%NLift(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + OutData%NumCL = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumFoil = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NFoil not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2370,15 +2354,10 @@ SUBROUTINE AD14_UnPackAirFoilParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NFoil.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%NFoil)>0) OutData%NFoil = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%NFoil))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%NFoil) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%NFoil,1), UBOUND(OutData%NFoil,1) + OutData%NFoil(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MulTabMet not allocated Int_Xferred = Int_Xferred + 1 @@ -2396,15 +2375,12 @@ SUBROUTINE AD14_UnPackAirFoilParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MulTabMet.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%MulTabMet)>0) OutData%MulTabMet = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MulTabMet))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MulTabMet) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%MulTabMet,2), UBOUND(OutData%MulTabMet,2) + DO i1 = LBOUND(OutData%MulTabMet,1), UBOUND(OutData%MulTabMet,1) + OutData%MulTabMet(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FoilNm not allocated Int_Xferred = Int_Xferred + 1 @@ -2419,19 +2395,12 @@ SUBROUTINE AD14_UnPackAirFoilParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FoilNm.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%FoilNm,1), UBOUND(OutData%FoilNm,1) + DO i1 = LBOUND(OutData%FoilNm,1), UBOUND(OutData%FoilNm,1) DO I = 1, LEN(OutData%FoilNm) OutData%FoilNm(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF END SUBROUTINE AD14_UnPackAirFoilParms @@ -3714,8 +3683,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ADOT,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ADOT)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%ADOT))-1 ) = PACK(InData%ADOT,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%ADOT) + DO i2 = LBOUND(InData%ADOT,2), UBOUND(InData%ADOT,2) + DO i1 = LBOUND(InData%ADOT,1), UBOUND(InData%ADOT,1) + ReKiBuf(Re_Xferred) = InData%ADOT(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%ADOT1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3730,8 +3703,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ADOT1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ADOT1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%ADOT1))-1 ) = PACK(InData%ADOT1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%ADOT1) + DO i2 = LBOUND(InData%ADOT1,2), UBOUND(InData%ADOT1,2) + DO i1 = LBOUND(InData%ADOT1,1), UBOUND(InData%ADOT1,1) + ReKiBuf(Re_Xferred) = InData%ADOT1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%AFE) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3746,8 +3723,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFE,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AFE)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AFE))-1 ) = PACK(InData%AFE,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AFE) + DO i2 = LBOUND(InData%AFE,2), UBOUND(InData%AFE,2) + DO i1 = LBOUND(InData%AFE,1), UBOUND(InData%AFE,1) + ReKiBuf(Re_Xferred) = InData%AFE(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%AFE1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3762,11 +3743,15 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFE1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AFE1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AFE1))-1 ) = PACK(InData%AFE1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AFE1) + DO i2 = LBOUND(InData%AFE1,2), UBOUND(InData%AFE1,2) + DO i1 = LBOUND(InData%AFE1,1), UBOUND(InData%AFE1,1) + ReKiBuf(Re_Xferred) = InData%AFE1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AN - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AN + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%ANE) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -3780,8 +3765,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ANE,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ANE)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%ANE))-1 ) = PACK(InData%ANE,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%ANE) + DO i2 = LBOUND(InData%ANE,2), UBOUND(InData%ANE,2) + DO i1 = LBOUND(InData%ANE,1), UBOUND(InData%ANE,1) + ReKiBuf(Re_Xferred) = InData%ANE(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%ANE1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3796,8 +3785,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ANE1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ANE1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%ANE1))-1 ) = PACK(InData%ANE1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%ANE1) + DO i2 = LBOUND(InData%ANE1,2), UBOUND(InData%ANE1,2) + DO i1 = LBOUND(InData%ANE1,1), UBOUND(InData%ANE1,1) + ReKiBuf(Re_Xferred) = InData%ANE1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%AOD) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3812,8 +3805,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AOD,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AOD)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AOD))-1 ) = PACK(InData%AOD,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AOD) + DO i2 = LBOUND(InData%AOD,2), UBOUND(InData%AOD,2) + DO i1 = LBOUND(InData%AOD,1), UBOUND(InData%AOD,1) + ReKiBuf(Re_Xferred) = InData%AOD(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%AOL) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3828,8 +3825,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AOL,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AOL)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AOL))-1 ) = PACK(InData%AOL,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AOL) + DO i2 = LBOUND(InData%AOL,2), UBOUND(InData%AOL,2) + DO i1 = LBOUND(InData%AOL,1), UBOUND(InData%AOL,1) + ReKiBuf(Re_Xferred) = InData%AOL(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%BEDSEP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3844,8 +3845,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BEDSEP,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BEDSEP)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%BEDSEP)-1 ) = TRANSFER(PACK( InData%BEDSEP ,.TRUE.), IntKiBuf(1), SIZE(InData%BEDSEP)) - Int_Xferred = Int_Xferred + SIZE(InData%BEDSEP) + DO i2 = LBOUND(InData%BEDSEP,2), UBOUND(InData%BEDSEP,2) + DO i1 = LBOUND(InData%BEDSEP,1), UBOUND(InData%BEDSEP,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%BEDSEP(i1,i2), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%OLDSEP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3860,11 +3865,15 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDSEP,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%OLDSEP)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%OLDSEP)-1 ) = TRANSFER(PACK( InData%OLDSEP ,.TRUE.), IntKiBuf(1), SIZE(InData%OLDSEP)) - Int_Xferred = Int_Xferred + SIZE(InData%OLDSEP) + DO i2 = LBOUND(InData%OLDSEP,2), UBOUND(InData%OLDSEP,2) + DO i1 = LBOUND(InData%OLDSEP,1), UBOUND(InData%OLDSEP,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%OLDSEP(i1,i2), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CC - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CC + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%CDO) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -3878,15 +3887,19 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CDO,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CDO)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CDO))-1 ) = PACK(InData%CDO,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CDO) + DO i2 = LBOUND(InData%CDO,2), UBOUND(InData%CDO,2) + DO i1 = LBOUND(InData%CDO,1), UBOUND(InData%CDO,1) + ReKiBuf(Re_Xferred) = InData%CDO(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CMI - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CMQ - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CN - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CMI + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CMQ + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CN + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%CNA) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -3900,13 +3913,17 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNA,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CNA)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CNA))-1 ) = PACK(InData%CNA,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CNA) + DO i2 = LBOUND(InData%CNA,2), UBOUND(InData%CNA,2) + DO i1 = LBOUND(InData%CNA,1), UBOUND(InData%CNA,1) + ReKiBuf(Re_Xferred) = InData%CNA(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CNCP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CNIQ - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CNCP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CNIQ + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%CNP) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -3920,8 +3937,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNP,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CNP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CNP))-1 ) = PACK(InData%CNP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CNP) + DO i2 = LBOUND(InData%CNP,2), UBOUND(InData%CNP,2) + DO i1 = LBOUND(InData%CNP,1), UBOUND(InData%CNP,1) + ReKiBuf(Re_Xferred) = InData%CNP(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%CNP1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3936,8 +3957,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNP1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CNP1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CNP1))-1 ) = PACK(InData%CNP1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CNP1) + DO i2 = LBOUND(InData%CNP1,2), UBOUND(InData%CNP1,2) + DO i1 = LBOUND(InData%CNP1,1), UBOUND(InData%CNP1,1) + ReKiBuf(Re_Xferred) = InData%CNP1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%CNPD) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3952,8 +3977,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNPD,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CNPD)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CNPD))-1 ) = PACK(InData%CNPD,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CNPD) + DO i2 = LBOUND(InData%CNPD,2), UBOUND(InData%CNPD,2) + DO i1 = LBOUND(InData%CNPD,1), UBOUND(InData%CNPD,1) + ReKiBuf(Re_Xferred) = InData%CNPD(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%CNPD1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3968,8 +3997,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNPD1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CNPD1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CNPD1))-1 ) = PACK(InData%CNPD1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CNPD1) + DO i2 = LBOUND(InData%CNPD1,2), UBOUND(InData%CNPD1,2) + DO i1 = LBOUND(InData%CNPD1,1), UBOUND(InData%CNPD1,1) + ReKiBuf(Re_Xferred) = InData%CNPD1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%CNPOT) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3984,8 +4017,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNPOT,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CNPOT)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CNPOT))-1 ) = PACK(InData%CNPOT,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CNPOT) + DO i2 = LBOUND(InData%CNPOT,2), UBOUND(InData%CNPOT,2) + DO i1 = LBOUND(InData%CNPOT,1), UBOUND(InData%CNPOT,1) + ReKiBuf(Re_Xferred) = InData%CNPOT(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%CNPOT1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4000,8 +4037,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNPOT1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CNPOT1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CNPOT1))-1 ) = PACK(InData%CNPOT1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CNPOT1) + DO i2 = LBOUND(InData%CNPOT1,2), UBOUND(InData%CNPOT1,2) + DO i1 = LBOUND(InData%CNPOT1,1), UBOUND(InData%CNPOT1,1) + ReKiBuf(Re_Xferred) = InData%CNPOT1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%CNS) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4016,8 +4057,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNS,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CNS)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CNS))-1 ) = PACK(InData%CNS,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CNS) + DO i2 = LBOUND(InData%CNS,2), UBOUND(InData%CNS,2) + DO i1 = LBOUND(InData%CNS,1), UBOUND(InData%CNS,1) + ReKiBuf(Re_Xferred) = InData%CNS(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%CNSL) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4032,8 +4077,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNSL,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CNSL)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CNSL))-1 ) = PACK(InData%CNSL,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CNSL) + DO i2 = LBOUND(InData%CNSL,2), UBOUND(InData%CNSL,2) + DO i1 = LBOUND(InData%CNSL,1), UBOUND(InData%CNSL,1) + ReKiBuf(Re_Xferred) = InData%CNSL(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%CNV) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4048,8 +4097,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNV,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CNV)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CNV))-1 ) = PACK(InData%CNV,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CNV) + DO i2 = LBOUND(InData%CNV,2), UBOUND(InData%CNV,2) + DO i1 = LBOUND(InData%CNV,1), UBOUND(InData%CNV,1) + ReKiBuf(Re_Xferred) = InData%CNV(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%CVN) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4064,8 +4117,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CVN,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CVN)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CVN))-1 ) = PACK(InData%CVN,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CVN) + DO i2 = LBOUND(InData%CVN,2), UBOUND(InData%CVN,2) + DO i1 = LBOUND(InData%CVN,1), UBOUND(InData%CVN,1) + ReKiBuf(Re_Xferred) = InData%CVN(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%CVN1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4080,8 +4137,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CVN1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CVN1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CVN1))-1 ) = PACK(InData%CVN1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CVN1) + DO i2 = LBOUND(InData%CVN1,2), UBOUND(InData%CVN1,2) + DO i1 = LBOUND(InData%CVN1,1), UBOUND(InData%CVN1,1) + ReKiBuf(Re_Xferred) = InData%CVN1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%DF) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4096,8 +4157,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DF,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DF)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DF))-1 ) = PACK(InData%DF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DF) + DO i2 = LBOUND(InData%DF,2), UBOUND(InData%DF,2) + DO i1 = LBOUND(InData%DF,1), UBOUND(InData%DF,1) + ReKiBuf(Re_Xferred) = InData%DF(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%DFAFE) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4112,8 +4177,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DFAFE,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DFAFE)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DFAFE))-1 ) = PACK(InData%DFAFE,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DFAFE) + DO i2 = LBOUND(InData%DFAFE,2), UBOUND(InData%DFAFE,2) + DO i1 = LBOUND(InData%DFAFE,1), UBOUND(InData%DFAFE,1) + ReKiBuf(Re_Xferred) = InData%DFAFE(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%DFAFE1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4128,8 +4197,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DFAFE1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DFAFE1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DFAFE1))-1 ) = PACK(InData%DFAFE1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DFAFE1) + DO i2 = LBOUND(InData%DFAFE1,2), UBOUND(InData%DFAFE1,2) + DO i1 = LBOUND(InData%DFAFE1,1), UBOUND(InData%DFAFE1,1) + ReKiBuf(Re_Xferred) = InData%DFAFE1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%DFC) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4144,8 +4217,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DFC,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DFC)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DFC))-1 ) = PACK(InData%DFC,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DFC) + DO i2 = LBOUND(InData%DFC,2), UBOUND(InData%DFC,2) + DO i1 = LBOUND(InData%DFC,1), UBOUND(InData%DFC,1) + ReKiBuf(Re_Xferred) = InData%DFC(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%DN) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4160,8 +4237,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DN,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DN)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DN))-1 ) = PACK(InData%DN,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DN) + DO i2 = LBOUND(InData%DN,2), UBOUND(InData%DN,2) + DO i1 = LBOUND(InData%DN,1), UBOUND(InData%DN,1) + ReKiBuf(Re_Xferred) = InData%DN(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%DPP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4176,8 +4257,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DPP,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DPP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DPP))-1 ) = PACK(InData%DPP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DPP) + DO i2 = LBOUND(InData%DPP,2), UBOUND(InData%DPP,2) + DO i1 = LBOUND(InData%DPP,1), UBOUND(InData%DPP,1) + ReKiBuf(Re_Xferred) = InData%DPP(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%DQ) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4192,8 +4277,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DQ,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DQ)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DQ))-1 ) = PACK(InData%DQ,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DQ) + DO i2 = LBOUND(InData%DQ,2), UBOUND(InData%DQ,2) + DO i1 = LBOUND(InData%DQ,1), UBOUND(InData%DQ,1) + ReKiBuf(Re_Xferred) = InData%DQ(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%DQP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4208,8 +4297,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DQP,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DQP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DQP))-1 ) = PACK(InData%DQP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DQP) + DO i2 = LBOUND(InData%DQP,2), UBOUND(InData%DQP,2) + DO i1 = LBOUND(InData%DQP,1), UBOUND(InData%DQP,1) + ReKiBuf(Re_Xferred) = InData%DQP(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%DQP1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4224,17 +4317,21 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DQP1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DQP1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DQP1))-1 ) = PACK(InData%DQP1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DQP1) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DS - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FK - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FPC - Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(InData%DQP1,2), UBOUND(InData%DQP1,2) + DO i1 = LBOUND(InData%DQP1,1), UBOUND(InData%DQP1,1) + ReKiBuf(Re_Xferred) = InData%DQP1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + ReKiBuf(Re_Xferred) = InData%DS + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FK + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FPC + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%FSP) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4248,8 +4345,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FSP,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FSP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FSP))-1 ) = PACK(InData%FSP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FSP) + DO i2 = LBOUND(InData%FSP,2), UBOUND(InData%FSP,2) + DO i1 = LBOUND(InData%FSP,1), UBOUND(InData%FSP,1) + ReKiBuf(Re_Xferred) = InData%FSP(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FSP1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4264,8 +4365,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FSP1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FSP1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FSP1))-1 ) = PACK(InData%FSP1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FSP1) + DO i2 = LBOUND(InData%FSP1,2), UBOUND(InData%FSP1,2) + DO i1 = LBOUND(InData%FSP1,1), UBOUND(InData%FSP1,1) + ReKiBuf(Re_Xferred) = InData%FSP1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FSPC) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4280,8 +4385,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FSPC,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FSPC)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FSPC))-1 ) = PACK(InData%FSPC,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FSPC) + DO i2 = LBOUND(InData%FSPC,2), UBOUND(InData%FSPC,2) + DO i1 = LBOUND(InData%FSPC,1), UBOUND(InData%FSPC,1) + ReKiBuf(Re_Xferred) = InData%FSPC(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FSPC1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4296,8 +4405,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FSPC1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FSPC1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FSPC1))-1 ) = PACK(InData%FSPC1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FSPC1) + DO i2 = LBOUND(InData%FSPC1,2), UBOUND(InData%FSPC1,2) + DO i1 = LBOUND(InData%FSPC1,1), UBOUND(InData%FSPC1,1) + ReKiBuf(Re_Xferred) = InData%FSPC1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FTB) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4315,8 +4428,14 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FTB,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FTB)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FTB))-1 ) = PACK(InData%FTB,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FTB) + DO i3 = LBOUND(InData%FTB,3), UBOUND(InData%FTB,3) + DO i2 = LBOUND(InData%FTB,2), UBOUND(InData%FTB,2) + DO i1 = LBOUND(InData%FTB,1), UBOUND(InData%FTB,1) + ReKiBuf(Re_Xferred) = InData%FTB(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FTBC) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4334,8 +4453,14 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FTBC,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FTBC)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FTBC))-1 ) = PACK(InData%FTBC,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FTBC) + DO i3 = LBOUND(InData%FTBC,3), UBOUND(InData%FTBC,3) + DO i2 = LBOUND(InData%FTBC,2), UBOUND(InData%FTBC,2) + DO i1 = LBOUND(InData%FTBC,1), UBOUND(InData%FTBC,1) + ReKiBuf(Re_Xferred) = InData%FTBC(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%OLDCNV) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4350,8 +4475,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDCNV,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%OLDCNV)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%OLDCNV))-1 ) = PACK(InData%OLDCNV,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%OLDCNV) + DO i2 = LBOUND(InData%OLDCNV,2), UBOUND(InData%OLDCNV,2) + DO i1 = LBOUND(InData%OLDCNV,1), UBOUND(InData%OLDCNV,1) + ReKiBuf(Re_Xferred) = InData%OLDCNV(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%OLDDF) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4366,8 +4495,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDDF,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%OLDDF)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%OLDDF))-1 ) = PACK(InData%OLDDF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%OLDDF) + DO i2 = LBOUND(InData%OLDDF,2), UBOUND(InData%OLDDF,2) + DO i1 = LBOUND(InData%OLDDF,1), UBOUND(InData%OLDDF,1) + ReKiBuf(Re_Xferred) = InData%OLDDF(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%OLDDFC) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4382,8 +4515,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDDFC,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%OLDDFC)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%OLDDFC))-1 ) = PACK(InData%OLDDFC,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%OLDDFC) + DO i2 = LBOUND(InData%OLDDFC,2), UBOUND(InData%OLDDFC,2) + DO i1 = LBOUND(InData%OLDDFC,1), UBOUND(InData%OLDDFC,1) + ReKiBuf(Re_Xferred) = InData%OLDDFC(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%OLDDN) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4398,8 +4535,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDDN,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%OLDDN)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%OLDDN))-1 ) = PACK(InData%OLDDN,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%OLDDN) + DO i2 = LBOUND(InData%OLDDN,2), UBOUND(InData%OLDDN,2) + DO i1 = LBOUND(InData%OLDDN,1), UBOUND(InData%OLDDN,1) + ReKiBuf(Re_Xferred) = InData%OLDDN(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%OLDDPP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4414,8 +4555,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDDPP,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%OLDDPP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%OLDDPP))-1 ) = PACK(InData%OLDDPP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%OLDDPP) + DO i2 = LBOUND(InData%OLDDPP,2), UBOUND(InData%OLDDPP,2) + DO i1 = LBOUND(InData%OLDDPP,1), UBOUND(InData%OLDDPP,1) + ReKiBuf(Re_Xferred) = InData%OLDDPP(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%OLDDQ) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4430,8 +4575,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDDQ,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%OLDDQ)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%OLDDQ))-1 ) = PACK(InData%OLDDQ,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%OLDDQ) + DO i2 = LBOUND(InData%OLDDQ,2), UBOUND(InData%OLDDQ,2) + DO i1 = LBOUND(InData%OLDDQ,1), UBOUND(InData%OLDDQ,1) + ReKiBuf(Re_Xferred) = InData%OLDDQ(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%OLDTAU) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4446,8 +4595,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDTAU,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%OLDTAU)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%OLDTAU))-1 ) = PACK(InData%OLDTAU,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%OLDTAU) + DO i2 = LBOUND(InData%OLDTAU,2), UBOUND(InData%OLDTAU,2) + DO i1 = LBOUND(InData%OLDTAU,1), UBOUND(InData%OLDTAU,1) + ReKiBuf(Re_Xferred) = InData%OLDTAU(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%OLDXN) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4462,8 +4615,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDXN,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%OLDXN)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%OLDXN))-1 ) = PACK(InData%OLDXN,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%OLDXN) + DO i2 = LBOUND(InData%OLDXN,2), UBOUND(InData%OLDXN,2) + DO i1 = LBOUND(InData%OLDXN,1), UBOUND(InData%OLDXN,1) + ReKiBuf(Re_Xferred) = InData%OLDXN(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%OLDYN) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4478,8 +4635,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDYN,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%OLDYN)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%OLDYN))-1 ) = PACK(InData%OLDYN,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%OLDYN) + DO i2 = LBOUND(InData%OLDYN,2), UBOUND(InData%OLDYN,2) + DO i1 = LBOUND(InData%OLDYN,1), UBOUND(InData%OLDYN,1) + ReKiBuf(Re_Xferred) = InData%OLDYN(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%QX) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4494,8 +4655,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QX,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%QX)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%QX))-1 ) = PACK(InData%QX,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%QX) + DO i2 = LBOUND(InData%QX,2), UBOUND(InData%QX,2) + DO i1 = LBOUND(InData%QX,1), UBOUND(InData%QX,1) + ReKiBuf(Re_Xferred) = InData%QX(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%QX1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4510,8 +4675,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QX1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%QX1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%QX1))-1 ) = PACK(InData%QX1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%QX1) + DO i2 = LBOUND(InData%QX1,2), UBOUND(InData%QX1,2) + DO i1 = LBOUND(InData%QX1,1), UBOUND(InData%QX1,1) + ReKiBuf(Re_Xferred) = InData%QX1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%TAU) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4526,8 +4695,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TAU,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TAU)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TAU))-1 ) = PACK(InData%TAU,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TAU) + DO i2 = LBOUND(InData%TAU,2), UBOUND(InData%TAU,2) + DO i1 = LBOUND(InData%TAU,1), UBOUND(InData%TAU,1) + ReKiBuf(Re_Xferred) = InData%TAU(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%XN) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4542,8 +4715,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%XN,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%XN)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%XN))-1 ) = PACK(InData%XN,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%XN) + DO i2 = LBOUND(InData%XN,2), UBOUND(InData%XN,2) + DO i1 = LBOUND(InData%XN,1), UBOUND(InData%XN,1) + ReKiBuf(Re_Xferred) = InData%XN(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%YN) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4558,13 +4735,17 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%YN,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%YN)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%YN))-1 ) = PACK(InData%YN,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%YN) + DO i2 = LBOUND(InData%YN,2), UBOUND(InData%YN,2) + DO i1 = LBOUND(InData%YN,1), UBOUND(InData%YN,1) + ReKiBuf(Re_Xferred) = InData%YN(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%SHIFT , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%VOR , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%SHIFT, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%VOR, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE AD14_PackBeddoes SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -4580,12 +4761,6 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -4618,15 +4793,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ADOT.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%ADOT)>0) OutData%ADOT = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%ADOT))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%ADOT) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%ADOT,2), UBOUND(OutData%ADOT,2) + DO i1 = LBOUND(OutData%ADOT,1), UBOUND(OutData%ADOT,1) + OutData%ADOT(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ADOT1 not allocated Int_Xferred = Int_Xferred + 1 @@ -4644,15 +4816,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ADOT1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%ADOT1)>0) OutData%ADOT1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%ADOT1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%ADOT1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%ADOT1,2), UBOUND(OutData%ADOT1,2) + DO i1 = LBOUND(OutData%ADOT1,1), UBOUND(OutData%ADOT1,1) + OutData%ADOT1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AFE not allocated Int_Xferred = Int_Xferred + 1 @@ -4670,15 +4839,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%AFE)>0) OutData%AFE = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AFE))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AFE) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AFE,2), UBOUND(OutData%AFE,2) + DO i1 = LBOUND(OutData%AFE,1), UBOUND(OutData%AFE,1) + OutData%AFE(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AFE1 not allocated Int_Xferred = Int_Xferred + 1 @@ -4696,18 +4862,15 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFE1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%AFE1)>0) OutData%AFE1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AFE1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AFE1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AFE1,2), UBOUND(OutData%AFE1,2) + DO i1 = LBOUND(OutData%AFE1,1), UBOUND(OutData%AFE1,1) + OutData%AFE1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%AN = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%AN = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ANE not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -4724,15 +4887,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ANE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%ANE)>0) OutData%ANE = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%ANE))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%ANE) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%ANE,2), UBOUND(OutData%ANE,2) + DO i1 = LBOUND(OutData%ANE,1), UBOUND(OutData%ANE,1) + OutData%ANE(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ANE1 not allocated Int_Xferred = Int_Xferred + 1 @@ -4750,15 +4910,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ANE1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%ANE1)>0) OutData%ANE1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%ANE1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%ANE1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%ANE1,2), UBOUND(OutData%ANE1,2) + DO i1 = LBOUND(OutData%ANE1,1), UBOUND(OutData%ANE1,1) + OutData%ANE1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AOD not allocated Int_Xferred = Int_Xferred + 1 @@ -4776,15 +4933,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AOD.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%AOD)>0) OutData%AOD = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AOD))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AOD) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AOD,2), UBOUND(OutData%AOD,2) + DO i1 = LBOUND(OutData%AOD,1), UBOUND(OutData%AOD,1) + OutData%AOD(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AOL not allocated Int_Xferred = Int_Xferred + 1 @@ -4802,15 +4956,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AOL.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%AOL)>0) OutData%AOL = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AOL))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AOL) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AOL,2), UBOUND(OutData%AOL,2) + DO i1 = LBOUND(OutData%AOL,1), UBOUND(OutData%AOL,1) + OutData%AOL(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BEDSEP not allocated Int_Xferred = Int_Xferred + 1 @@ -4828,15 +4979,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BEDSEP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%BEDSEP)>0) OutData%BEDSEP = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%BEDSEP))-1 ), OutData%BEDSEP), mask2,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%BEDSEP) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%BEDSEP,2), UBOUND(OutData%BEDSEP,2) + DO i1 = LBOUND(OutData%BEDSEP,1), UBOUND(OutData%BEDSEP,1) + OutData%BEDSEP(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%BEDSEP(i1,i2)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLDSEP not allocated Int_Xferred = Int_Xferred + 1 @@ -4854,18 +5002,15 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDSEP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%OLDSEP)>0) OutData%OLDSEP = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%OLDSEP))-1 ), OutData%OLDSEP), mask2,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%OLDSEP) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%OLDSEP,2), UBOUND(OutData%OLDSEP,2) + DO i1 = LBOUND(OutData%OLDSEP,1), UBOUND(OutData%OLDSEP,1) + OutData%OLDSEP(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%OLDSEP(i1,i2)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF - OutData%CC = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%CC = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CDO not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -4882,22 +5027,19 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CDO.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%CDO)>0) OutData%CDO = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CDO))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CDO) - DEALLOCATE(mask2) - END IF - OutData%CMI = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%CMQ = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%CN = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(OutData%CDO,2), UBOUND(OutData%CDO,2) + DO i1 = LBOUND(OutData%CDO,1), UBOUND(OutData%CDO,1) + OutData%CDO(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%CMI = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%CMQ = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%CN = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNA not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -4914,20 +5056,17 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNA.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%CNA)>0) OutData%CNA = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CNA))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CNA) - DEALLOCATE(mask2) - END IF - OutData%CNCP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%CNIQ = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(OutData%CNA,2), UBOUND(OutData%CNA,2) + DO i1 = LBOUND(OutData%CNA,1), UBOUND(OutData%CNA,1) + OutData%CNA(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%CNCP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%CNIQ = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNP not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -4944,15 +5083,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%CNP)>0) OutData%CNP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CNP))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CNP) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%CNP,2), UBOUND(OutData%CNP,2) + DO i1 = LBOUND(OutData%CNP,1), UBOUND(OutData%CNP,1) + OutData%CNP(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNP1 not allocated Int_Xferred = Int_Xferred + 1 @@ -4970,15 +5106,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNP1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%CNP1)>0) OutData%CNP1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CNP1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CNP1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%CNP1,2), UBOUND(OutData%CNP1,2) + DO i1 = LBOUND(OutData%CNP1,1), UBOUND(OutData%CNP1,1) + OutData%CNP1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNPD not allocated Int_Xferred = Int_Xferred + 1 @@ -4996,15 +5129,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNPD.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%CNPD)>0) OutData%CNPD = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CNPD))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CNPD) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%CNPD,2), UBOUND(OutData%CNPD,2) + DO i1 = LBOUND(OutData%CNPD,1), UBOUND(OutData%CNPD,1) + OutData%CNPD(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNPD1 not allocated Int_Xferred = Int_Xferred + 1 @@ -5022,15 +5152,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNPD1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%CNPD1)>0) OutData%CNPD1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CNPD1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CNPD1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%CNPD1,2), UBOUND(OutData%CNPD1,2) + DO i1 = LBOUND(OutData%CNPD1,1), UBOUND(OutData%CNPD1,1) + OutData%CNPD1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNPOT not allocated Int_Xferred = Int_Xferred + 1 @@ -5048,15 +5175,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNPOT.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%CNPOT)>0) OutData%CNPOT = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CNPOT))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CNPOT) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%CNPOT,2), UBOUND(OutData%CNPOT,2) + DO i1 = LBOUND(OutData%CNPOT,1), UBOUND(OutData%CNPOT,1) + OutData%CNPOT(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNPOT1 not allocated Int_Xferred = Int_Xferred + 1 @@ -5074,15 +5198,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNPOT1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%CNPOT1)>0) OutData%CNPOT1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CNPOT1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CNPOT1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%CNPOT1,2), UBOUND(OutData%CNPOT1,2) + DO i1 = LBOUND(OutData%CNPOT1,1), UBOUND(OutData%CNPOT1,1) + OutData%CNPOT1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNS not allocated Int_Xferred = Int_Xferred + 1 @@ -5100,15 +5221,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNS.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%CNS)>0) OutData%CNS = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CNS))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CNS) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%CNS,2), UBOUND(OutData%CNS,2) + DO i1 = LBOUND(OutData%CNS,1), UBOUND(OutData%CNS,1) + OutData%CNS(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNSL not allocated Int_Xferred = Int_Xferred + 1 @@ -5126,15 +5244,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNSL.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%CNSL)>0) OutData%CNSL = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CNSL))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CNSL) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%CNSL,2), UBOUND(OutData%CNSL,2) + DO i1 = LBOUND(OutData%CNSL,1), UBOUND(OutData%CNSL,1) + OutData%CNSL(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNV not allocated Int_Xferred = Int_Xferred + 1 @@ -5152,15 +5267,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNV.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%CNV)>0) OutData%CNV = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CNV))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CNV) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%CNV,2), UBOUND(OutData%CNV,2) + DO i1 = LBOUND(OutData%CNV,1), UBOUND(OutData%CNV,1) + OutData%CNV(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CVN not allocated Int_Xferred = Int_Xferred + 1 @@ -5178,15 +5290,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CVN.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%CVN)>0) OutData%CVN = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CVN))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CVN) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%CVN,2), UBOUND(OutData%CVN,2) + DO i1 = LBOUND(OutData%CVN,1), UBOUND(OutData%CVN,1) + OutData%CVN(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CVN1 not allocated Int_Xferred = Int_Xferred + 1 @@ -5204,15 +5313,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CVN1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%CVN1)>0) OutData%CVN1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CVN1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CVN1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%CVN1,2), UBOUND(OutData%CVN1,2) + DO i1 = LBOUND(OutData%CVN1,1), UBOUND(OutData%CVN1,1) + OutData%CVN1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DF not allocated Int_Xferred = Int_Xferred + 1 @@ -5230,15 +5336,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%DF)>0) OutData%DF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DF))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DF) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%DF,2), UBOUND(OutData%DF,2) + DO i1 = LBOUND(OutData%DF,1), UBOUND(OutData%DF,1) + OutData%DF(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DFAFE not allocated Int_Xferred = Int_Xferred + 1 @@ -5256,15 +5359,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DFAFE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%DFAFE)>0) OutData%DFAFE = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DFAFE))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DFAFE) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%DFAFE,2), UBOUND(OutData%DFAFE,2) + DO i1 = LBOUND(OutData%DFAFE,1), UBOUND(OutData%DFAFE,1) + OutData%DFAFE(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DFAFE1 not allocated Int_Xferred = Int_Xferred + 1 @@ -5282,15 +5382,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DFAFE1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%DFAFE1)>0) OutData%DFAFE1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DFAFE1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DFAFE1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%DFAFE1,2), UBOUND(OutData%DFAFE1,2) + DO i1 = LBOUND(OutData%DFAFE1,1), UBOUND(OutData%DFAFE1,1) + OutData%DFAFE1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DFC not allocated Int_Xferred = Int_Xferred + 1 @@ -5308,15 +5405,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DFC.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%DFC)>0) OutData%DFC = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DFC))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DFC) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%DFC,2), UBOUND(OutData%DFC,2) + DO i1 = LBOUND(OutData%DFC,1), UBOUND(OutData%DFC,1) + OutData%DFC(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DN not allocated Int_Xferred = Int_Xferred + 1 @@ -5334,15 +5428,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DN.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%DN)>0) OutData%DN = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DN))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DN) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%DN,2), UBOUND(OutData%DN,2) + DO i1 = LBOUND(OutData%DN,1), UBOUND(OutData%DN,1) + OutData%DN(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DPP not allocated Int_Xferred = Int_Xferred + 1 @@ -5360,15 +5451,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DPP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%DPP)>0) OutData%DPP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DPP))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DPP) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%DPP,2), UBOUND(OutData%DPP,2) + DO i1 = LBOUND(OutData%DPP,1), UBOUND(OutData%DPP,1) + OutData%DPP(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DQ not allocated Int_Xferred = Int_Xferred + 1 @@ -5386,15 +5474,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DQ.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%DQ)>0) OutData%DQ = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DQ))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DQ) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%DQ,2), UBOUND(OutData%DQ,2) + DO i1 = LBOUND(OutData%DQ,1), UBOUND(OutData%DQ,1) + OutData%DQ(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DQP not allocated Int_Xferred = Int_Xferred + 1 @@ -5412,15 +5497,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DQP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%DQP)>0) OutData%DQP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DQP))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DQP) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%DQP,2), UBOUND(OutData%DQP,2) + DO i1 = LBOUND(OutData%DQP,1), UBOUND(OutData%DQP,1) + OutData%DQP(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DQP1 not allocated Int_Xferred = Int_Xferred + 1 @@ -5438,24 +5520,21 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DQP1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%DQP1)>0) OutData%DQP1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DQP1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DQP1) - DEALLOCATE(mask2) - END IF - OutData%DS = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%FK = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%FP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%FPC = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(OutData%DQP1,2), UBOUND(OutData%DQP1,2) + DO i1 = LBOUND(OutData%DQP1,1), UBOUND(OutData%DQP1,1) + OutData%DQP1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%DS = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%FK = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%FP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%FPC = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FSP not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5472,15 +5551,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FSP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%FSP)>0) OutData%FSP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FSP))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FSP) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%FSP,2), UBOUND(OutData%FSP,2) + DO i1 = LBOUND(OutData%FSP,1), UBOUND(OutData%FSP,1) + OutData%FSP(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FSP1 not allocated Int_Xferred = Int_Xferred + 1 @@ -5498,15 +5574,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FSP1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%FSP1)>0) OutData%FSP1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FSP1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FSP1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%FSP1,2), UBOUND(OutData%FSP1,2) + DO i1 = LBOUND(OutData%FSP1,1), UBOUND(OutData%FSP1,1) + OutData%FSP1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FSPC not allocated Int_Xferred = Int_Xferred + 1 @@ -5524,15 +5597,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FSPC.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%FSPC)>0) OutData%FSPC = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FSPC))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FSPC) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%FSPC,2), UBOUND(OutData%FSPC,2) + DO i1 = LBOUND(OutData%FSPC,1), UBOUND(OutData%FSPC,1) + OutData%FSPC(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FSPC1 not allocated Int_Xferred = Int_Xferred + 1 @@ -5550,15 +5620,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FSPC1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%FSPC1)>0) OutData%FSPC1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FSPC1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FSPC1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%FSPC1,2), UBOUND(OutData%FSPC1,2) + DO i1 = LBOUND(OutData%FSPC1,1), UBOUND(OutData%FSPC1,1) + OutData%FSPC1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FTB not allocated Int_Xferred = Int_Xferred + 1 @@ -5579,15 +5646,14 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FTB.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%FTB)>0) OutData%FTB = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FTB))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FTB) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%FTB,3), UBOUND(OutData%FTB,3) + DO i2 = LBOUND(OutData%FTB,2), UBOUND(OutData%FTB,2) + DO i1 = LBOUND(OutData%FTB,1), UBOUND(OutData%FTB,1) + OutData%FTB(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 ! FTBC not allocated Int_Xferred = Int_Xferred + 1 @@ -5608,15 +5674,14 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FTBC.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%FTBC)>0) OutData%FTBC = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FTBC))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FTBC) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%FTBC,3), UBOUND(OutData%FTBC,3) + DO i2 = LBOUND(OutData%FTBC,2), UBOUND(OutData%FTBC,2) + DO i1 = LBOUND(OutData%FTBC,1), UBOUND(OutData%FTBC,1) + OutData%FTBC(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 ! OLDCNV not allocated Int_Xferred = Int_Xferred + 1 @@ -5634,15 +5699,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDCNV.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%OLDCNV)>0) OutData%OLDCNV = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%OLDCNV))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%OLDCNV) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%OLDCNV,2), UBOUND(OutData%OLDCNV,2) + DO i1 = LBOUND(OutData%OLDCNV,1), UBOUND(OutData%OLDCNV,1) + OutData%OLDCNV(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLDDF not allocated Int_Xferred = Int_Xferred + 1 @@ -5660,15 +5722,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDDF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%OLDDF)>0) OutData%OLDDF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%OLDDF))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%OLDDF) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%OLDDF,2), UBOUND(OutData%OLDDF,2) + DO i1 = LBOUND(OutData%OLDDF,1), UBOUND(OutData%OLDDF,1) + OutData%OLDDF(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLDDFC not allocated Int_Xferred = Int_Xferred + 1 @@ -5686,15 +5745,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDDFC.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%OLDDFC)>0) OutData%OLDDFC = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%OLDDFC))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%OLDDFC) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%OLDDFC,2), UBOUND(OutData%OLDDFC,2) + DO i1 = LBOUND(OutData%OLDDFC,1), UBOUND(OutData%OLDDFC,1) + OutData%OLDDFC(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLDDN not allocated Int_Xferred = Int_Xferred + 1 @@ -5712,15 +5768,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDDN.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%OLDDN)>0) OutData%OLDDN = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%OLDDN))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%OLDDN) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%OLDDN,2), UBOUND(OutData%OLDDN,2) + DO i1 = LBOUND(OutData%OLDDN,1), UBOUND(OutData%OLDDN,1) + OutData%OLDDN(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLDDPP not allocated Int_Xferred = Int_Xferred + 1 @@ -5738,15 +5791,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDDPP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%OLDDPP)>0) OutData%OLDDPP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%OLDDPP))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%OLDDPP) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%OLDDPP,2), UBOUND(OutData%OLDDPP,2) + DO i1 = LBOUND(OutData%OLDDPP,1), UBOUND(OutData%OLDDPP,1) + OutData%OLDDPP(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLDDQ not allocated Int_Xferred = Int_Xferred + 1 @@ -5764,15 +5814,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDDQ.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%OLDDQ)>0) OutData%OLDDQ = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%OLDDQ))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%OLDDQ) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%OLDDQ,2), UBOUND(OutData%OLDDQ,2) + DO i1 = LBOUND(OutData%OLDDQ,1), UBOUND(OutData%OLDDQ,1) + OutData%OLDDQ(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLDTAU not allocated Int_Xferred = Int_Xferred + 1 @@ -5790,15 +5837,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDTAU.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%OLDTAU)>0) OutData%OLDTAU = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%OLDTAU))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%OLDTAU) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%OLDTAU,2), UBOUND(OutData%OLDTAU,2) + DO i1 = LBOUND(OutData%OLDTAU,1), UBOUND(OutData%OLDTAU,1) + OutData%OLDTAU(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLDXN not allocated Int_Xferred = Int_Xferred + 1 @@ -5816,15 +5860,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDXN.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%OLDXN)>0) OutData%OLDXN = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%OLDXN))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%OLDXN) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%OLDXN,2), UBOUND(OutData%OLDXN,2) + DO i1 = LBOUND(OutData%OLDXN,1), UBOUND(OutData%OLDXN,1) + OutData%OLDXN(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLDYN not allocated Int_Xferred = Int_Xferred + 1 @@ -5842,15 +5883,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDYN.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%OLDYN)>0) OutData%OLDYN = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%OLDYN))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%OLDYN) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%OLDYN,2), UBOUND(OutData%OLDYN,2) + DO i1 = LBOUND(OutData%OLDYN,1), UBOUND(OutData%OLDYN,1) + OutData%OLDYN(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QX not allocated Int_Xferred = Int_Xferred + 1 @@ -5868,15 +5906,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QX.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%QX)>0) OutData%QX = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%QX))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%QX) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%QX,2), UBOUND(OutData%QX,2) + DO i1 = LBOUND(OutData%QX,1), UBOUND(OutData%QX,1) + OutData%QX(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QX1 not allocated Int_Xferred = Int_Xferred + 1 @@ -5894,15 +5929,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QX1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%QX1)>0) OutData%QX1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%QX1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%QX1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%QX1,2), UBOUND(OutData%QX1,2) + DO i1 = LBOUND(OutData%QX1,1), UBOUND(OutData%QX1,1) + OutData%QX1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TAU not allocated Int_Xferred = Int_Xferred + 1 @@ -5920,15 +5952,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TAU.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%TAU)>0) OutData%TAU = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TAU))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TAU) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%TAU,2), UBOUND(OutData%TAU,2) + DO i1 = LBOUND(OutData%TAU,1), UBOUND(OutData%TAU,1) + OutData%TAU(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! XN not allocated Int_Xferred = Int_Xferred + 1 @@ -5946,15 +5975,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%XN.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%XN)>0) OutData%XN = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%XN))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%XN) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%XN,2), UBOUND(OutData%XN,2) + DO i1 = LBOUND(OutData%XN,1), UBOUND(OutData%XN,1) + OutData%XN(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! YN not allocated Int_Xferred = Int_Xferred + 1 @@ -5972,20 +5998,17 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%YN.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%YN)>0) OutData%YN = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%YN))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%YN) - DEALLOCATE(mask2) - END IF - OutData%SHIFT = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%VOR = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(OutData%YN,2), UBOUND(OutData%YN,2) + DO i1 = LBOUND(OutData%YN,1), UBOUND(OutData%YN,1) + OutData%YN(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%SHIFT = TRANSFER(IntKiBuf(Int_Xferred), OutData%SHIFT) + Int_Xferred = Int_Xferred + 1 + OutData%VOR = TRANSFER(IntKiBuf(Int_Xferred), OutData%VOR) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE AD14_UnPackBeddoes SUBROUTINE AD14_CopyBeddoesParms( SrcBeddoesParmsData, DstBeddoesParmsData, CtrlCode, ErrStat, ErrMsg ) @@ -6087,16 +6110,16 @@ SUBROUTINE AD14_PackBeddoesParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AS - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TF - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TV - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TVL - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AS + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TF + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TV + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TVL + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_PackBeddoesParms SUBROUTINE AD14_UnPackBeddoesParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -6112,12 +6135,6 @@ SUBROUTINE AD14_UnPackBeddoesParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackBeddoesParms' @@ -6131,16 +6148,16 @@ SUBROUTINE AD14_UnPackBeddoesParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%AS = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TF = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TV = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TVL = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%AS = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TF = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TV = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TVL = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_UnPackBeddoesParms SUBROUTINE AD14_CopyBladeParms( SrcBladeParmsData, DstBladeParmsData, CtrlCode, ErrStat, ErrMsg ) @@ -6287,8 +6304,10 @@ SUBROUTINE AD14_PackBladeParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%C)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%C))-1 ) = PACK(InData%C,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%C) + DO i1 = LBOUND(InData%C,1), UBOUND(InData%C,1) + ReKiBuf(Re_Xferred) = InData%C(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%DR) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6300,13 +6319,15 @@ SUBROUTINE AD14_PackBladeParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DR,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DR)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DR))-1 ) = PACK(InData%DR,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DR) + DO i1 = LBOUND(InData%DR,1), UBOUND(InData%DR,1) + ReKiBuf(Re_Xferred) = InData%DR(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%R - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%BladeLength - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%R + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%BladeLength + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_PackBladeParms SUBROUTINE AD14_UnPackBladeParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -6322,12 +6343,6 @@ SUBROUTINE AD14_UnPackBladeParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -6355,15 +6370,10 @@ SUBROUTINE AD14_UnPackBladeParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%C)>0) OutData%C = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%C))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%C) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%C,1), UBOUND(OutData%C,1) + OutData%C(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DR not allocated Int_Xferred = Int_Xferred + 1 @@ -6378,20 +6388,15 @@ SUBROUTINE AD14_UnPackBladeParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DR.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%DR)>0) OutData%DR = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DR))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DR) - DEALLOCATE(mask1) - END IF - OutData%R = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%BladeLength = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%DR,1), UBOUND(OutData%DR,1) + OutData%DR(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%R = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%BladeLength = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_UnPackBladeParms SUBROUTINE AD14_CopyDynInflow( SrcDynInflowData, DstDynInflowData, CtrlCode, ErrStat, ErrMsg ) @@ -6582,26 +6587,42 @@ SUBROUTINE AD14_PackDynInflow( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%dAlph_dt))-1 ) = PACK(InData%dAlph_dt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%dAlph_dt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%dBeta_dt))-1 ) = PACK(InData%dBeta_dt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%dBeta_dt) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DTO - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%old_Alph))-1 ) = PACK(InData%old_Alph,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%old_Alph) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%old_Beta))-1 ) = PACK(InData%old_Beta,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%old_Beta) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%old_LmdM - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%oldKai - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PhiLqC))-1 ) = PACK(InData%PhiLqC,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PhiLqC) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PhiLqS))-1 ) = PACK(InData%PhiLqS,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PhiLqS) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Pzero - Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(InData%dAlph_dt,2), UBOUND(InData%dAlph_dt,2) + DO i1 = LBOUND(InData%dAlph_dt,1), UBOUND(InData%dAlph_dt,1) + ReKiBuf(Re_Xferred) = InData%dAlph_dt(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%dBeta_dt,2), UBOUND(InData%dBeta_dt,2) + DO i1 = LBOUND(InData%dBeta_dt,1), UBOUND(InData%dBeta_dt,1) + ReKiBuf(Re_Xferred) = InData%dBeta_dt(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + ReKiBuf(Re_Xferred) = InData%DTO + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%old_Alph,1), UBOUND(InData%old_Alph,1) + ReKiBuf(Re_Xferred) = InData%old_Alph(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%old_Beta,1), UBOUND(InData%old_Beta,1) + ReKiBuf(Re_Xferred) = InData%old_Beta(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%old_LmdM + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%oldKai + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%PhiLqC,1), UBOUND(InData%PhiLqC,1) + ReKiBuf(Re_Xferred) = InData%PhiLqC(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%PhiLqS,1), UBOUND(InData%PhiLqS,1) + ReKiBuf(Re_Xferred) = InData%PhiLqS(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%Pzero + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%RMC_SAVE) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -6618,8 +6639,14 @@ SUBROUTINE AD14_PackDynInflow( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RMC_SAVE,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RMC_SAVE)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RMC_SAVE))-1 ) = PACK(InData%RMC_SAVE,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RMC_SAVE) + DO i3 = LBOUND(InData%RMC_SAVE,3), UBOUND(InData%RMC_SAVE,3) + DO i2 = LBOUND(InData%RMC_SAVE,2), UBOUND(InData%RMC_SAVE,2) + DO i1 = LBOUND(InData%RMC_SAVE,1), UBOUND(InData%RMC_SAVE,1) + ReKiBuf(Re_Xferred) = InData%RMC_SAVE(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%RMS_SAVE) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6637,37 +6664,71 @@ SUBROUTINE AD14_PackDynInflow( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RMS_SAVE,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RMS_SAVE)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RMS_SAVE))-1 ) = PACK(InData%RMS_SAVE,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RMS_SAVE) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TipSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%totalInf - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Vparam - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Vtotal - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%xAlpha))-1 ) = PACK(InData%xAlpha,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%xAlpha) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%xBeta))-1 ) = PACK(InData%xBeta,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%xBeta) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%xKai - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%XLAMBDA_M - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%xLcos))-1 ) = PACK(InData%xLcos,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%xLcos) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%xLsin))-1 ) = PACK(InData%xLsin,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%xLsin) - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%MminR))-1 ) = PACK(InData%MminR,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%MminR) - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%MminusR))-1 ) = PACK(InData%MminusR,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%MminusR) - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%MplusR))-1 ) = PACK(InData%MplusR,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%MplusR) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GAMMA))-1 ) = PACK(InData%GAMMA,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GAMMA) + DO i3 = LBOUND(InData%RMS_SAVE,3), UBOUND(InData%RMS_SAVE,3) + DO i2 = LBOUND(InData%RMS_SAVE,2), UBOUND(InData%RMS_SAVE,2) + DO i1 = LBOUND(InData%RMS_SAVE,1), UBOUND(InData%RMS_SAVE,1) + ReKiBuf(Re_Xferred) = InData%RMS_SAVE(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + ReKiBuf(Re_Xferred) = InData%TipSpeed + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%totalInf + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Vparam + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Vtotal + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%xAlpha,1), UBOUND(InData%xAlpha,1) + ReKiBuf(Re_Xferred) = InData%xAlpha(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%xBeta,1), UBOUND(InData%xBeta,1) + ReKiBuf(Re_Xferred) = InData%xBeta(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%xKai + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%XLAMBDA_M + Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(InData%xLcos,2), UBOUND(InData%xLcos,2) + DO i1 = LBOUND(InData%xLcos,1), UBOUND(InData%xLcos,1) + ReKiBuf(Re_Xferred) = InData%xLcos(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%xLsin,2), UBOUND(InData%xLsin,2) + DO i1 = LBOUND(InData%xLsin,1), UBOUND(InData%xLsin,1) + ReKiBuf(Re_Xferred) = InData%xLsin(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%MminR,2), UBOUND(InData%MminR,2) + DO i1 = LBOUND(InData%MminR,1), UBOUND(InData%MminR,1) + IntKiBuf(Int_Xferred) = InData%MminR(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%MminusR,2), UBOUND(InData%MminusR,2) + DO i1 = LBOUND(InData%MminusR,1), UBOUND(InData%MminusR,1) + IntKiBuf(Int_Xferred) = InData%MminusR(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%MplusR,2), UBOUND(InData%MplusR,2) + DO i1 = LBOUND(InData%MplusR,1), UBOUND(InData%MplusR,1) + IntKiBuf(Int_Xferred) = InData%MplusR(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%GAMMA,2), UBOUND(InData%GAMMA,2) + DO i1 = LBOUND(InData%GAMMA,1), UBOUND(InData%GAMMA,1) + ReKiBuf(Re_Xferred) = InData%GAMMA(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END SUBROUTINE AD14_PackDynInflow SUBROUTINE AD14_UnPackDynInflow( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -6683,12 +6744,6 @@ SUBROUTINE AD14_UnPackDynInflow( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -6709,80 +6764,54 @@ SUBROUTINE AD14_UnPackDynInflow( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E i1_u = UBOUND(OutData%dAlph_dt,1) i2_l = LBOUND(OutData%dAlph_dt,2) i2_u = UBOUND(OutData%dAlph_dt,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%dAlph_dt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%dAlph_dt))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%dAlph_dt) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%dAlph_dt,2), UBOUND(OutData%dAlph_dt,2) + DO i1 = LBOUND(OutData%dAlph_dt,1), UBOUND(OutData%dAlph_dt,1) + OutData%dAlph_dt(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%dBeta_dt,1) i1_u = UBOUND(OutData%dBeta_dt,1) i2_l = LBOUND(OutData%dBeta_dt,2) i2_u = UBOUND(OutData%dBeta_dt,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%dBeta_dt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%dBeta_dt))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%dBeta_dt) - DEALLOCATE(mask2) - OutData%DTO = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(OutData%dBeta_dt,2), UBOUND(OutData%dBeta_dt,2) + DO i1 = LBOUND(OutData%dBeta_dt,1), UBOUND(OutData%dBeta_dt,1) + OutData%dBeta_dt(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + OutData%DTO = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%old_Alph,1) i1_u = UBOUND(OutData%old_Alph,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%old_Alph = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%old_Alph))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%old_Alph) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%old_Alph,1), UBOUND(OutData%old_Alph,1) + OutData%old_Alph(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%old_Beta,1) i1_u = UBOUND(OutData%old_Beta,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%old_Beta = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%old_Beta))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%old_Beta) - DEALLOCATE(mask1) - OutData%old_LmdM = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%oldKai = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%old_Beta,1), UBOUND(OutData%old_Beta,1) + OutData%old_Beta(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%old_LmdM = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%oldKai = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%PhiLqC,1) i1_u = UBOUND(OutData%PhiLqC,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%PhiLqC = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PhiLqC))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PhiLqC) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%PhiLqC,1), UBOUND(OutData%PhiLqC,1) + OutData%PhiLqC(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%PhiLqS,1) i1_u = UBOUND(OutData%PhiLqS,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%PhiLqS = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PhiLqS))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PhiLqS) - DEALLOCATE(mask1) - OutData%Pzero = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%PhiLqS,1), UBOUND(OutData%PhiLqS,1) + OutData%PhiLqS(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%Pzero = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RMC_SAVE not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -6802,15 +6831,14 @@ SUBROUTINE AD14_UnPackDynInflow( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RMC_SAVE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%RMC_SAVE)>0) OutData%RMC_SAVE = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RMC_SAVE))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RMC_SAVE) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%RMC_SAVE,3), UBOUND(OutData%RMC_SAVE,3) + DO i2 = LBOUND(OutData%RMC_SAVE,2), UBOUND(OutData%RMC_SAVE,2) + DO i1 = LBOUND(OutData%RMC_SAVE,1), UBOUND(OutData%RMC_SAVE,1) + OutData%RMC_SAVE(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 ! RMS_SAVE not allocated Int_Xferred = Int_Xferred + 1 @@ -6831,128 +6859,99 @@ SUBROUTINE AD14_UnPackDynInflow( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RMS_SAVE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%RMS_SAVE)>0) OutData%RMS_SAVE = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RMS_SAVE))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RMS_SAVE) - DEALLOCATE(mask3) - END IF - OutData%TipSpeed = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%totalInf = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Vparam = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Vtotal = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i3 = LBOUND(OutData%RMS_SAVE,3), UBOUND(OutData%RMS_SAVE,3) + DO i2 = LBOUND(OutData%RMS_SAVE,2), UBOUND(OutData%RMS_SAVE,2) + DO i1 = LBOUND(OutData%RMS_SAVE,1), UBOUND(OutData%RMS_SAVE,1) + OutData%RMS_SAVE(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + OutData%TipSpeed = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%totalInf = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Vparam = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Vtotal = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%xAlpha,1) i1_u = UBOUND(OutData%xAlpha,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%xAlpha = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%xAlpha))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%xAlpha) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%xAlpha,1), UBOUND(OutData%xAlpha,1) + OutData%xAlpha(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%xBeta,1) i1_u = UBOUND(OutData%xBeta,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%xBeta = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%xBeta))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%xBeta) - DEALLOCATE(mask1) - OutData%xKai = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%XLAMBDA_M = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%xBeta,1), UBOUND(OutData%xBeta,1) + OutData%xBeta(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%xKai = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%XLAMBDA_M = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%xLcos,1) i1_u = UBOUND(OutData%xLcos,1) i2_l = LBOUND(OutData%xLcos,2) i2_u = UBOUND(OutData%xLcos,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%xLcos = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%xLcos))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%xLcos) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%xLcos,2), UBOUND(OutData%xLcos,2) + DO i1 = LBOUND(OutData%xLcos,1), UBOUND(OutData%xLcos,1) + OutData%xLcos(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%xLsin,1) i1_u = UBOUND(OutData%xLsin,1) i2_l = LBOUND(OutData%xLsin,2) i2_u = UBOUND(OutData%xLsin,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%xLsin = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%xLsin))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%xLsin) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%xLsin,2), UBOUND(OutData%xLsin,2) + DO i1 = LBOUND(OutData%xLsin,1), UBOUND(OutData%xLsin,1) + OutData%xLsin(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%MminR,1) i1_u = UBOUND(OutData%MminR,1) i2_l = LBOUND(OutData%MminR,2) i2_u = UBOUND(OutData%MminR,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%MminR = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%MminR))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%MminR) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%MminR,2), UBOUND(OutData%MminR,2) + DO i1 = LBOUND(OutData%MminR,1), UBOUND(OutData%MminR,1) + OutData%MminR(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%MminusR,1) i1_u = UBOUND(OutData%MminusR,1) i2_l = LBOUND(OutData%MminusR,2) i2_u = UBOUND(OutData%MminusR,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%MminusR = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%MminusR))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%MminusR) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%MminusR,2), UBOUND(OutData%MminusR,2) + DO i1 = LBOUND(OutData%MminusR,1), UBOUND(OutData%MminusR,1) + OutData%MminusR(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%MplusR,1) i1_u = UBOUND(OutData%MplusR,1) i2_l = LBOUND(OutData%MplusR,2) i2_u = UBOUND(OutData%MplusR,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%MplusR = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%MplusR))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%MplusR) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%MplusR,2), UBOUND(OutData%MplusR,2) + DO i1 = LBOUND(OutData%MplusR,1), UBOUND(OutData%MplusR,1) + OutData%MplusR(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%GAMMA,1) i1_u = UBOUND(OutData%GAMMA,1) i2_l = LBOUND(OutData%GAMMA,2) i2_u = UBOUND(OutData%GAMMA,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%GAMMA = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GAMMA))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GAMMA) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%GAMMA,2), UBOUND(OutData%GAMMA,2) + DO i1 = LBOUND(OutData%GAMMA,1), UBOUND(OutData%GAMMA,1) + OutData%GAMMA(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END SUBROUTINE AD14_UnPackDynInflow SUBROUTINE AD14_CopyDynInflowParms( SrcDynInflowParmsData, DstDynInflowParmsData, CtrlCode, ErrStat, ErrMsg ) @@ -7049,10 +7048,12 @@ SUBROUTINE AD14_PackDynInflowParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MAXINFLO - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%xMinv))-1 ) = PACK(InData%xMinv,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%xMinv) + IntKiBuf(Int_Xferred) = InData%MAXINFLO + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%xMinv,1), UBOUND(InData%xMinv,1) + ReKiBuf(Re_Xferred) = InData%xMinv(i1) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE AD14_PackDynInflowParms SUBROUTINE AD14_UnPackDynInflowParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -7068,12 +7069,6 @@ SUBROUTINE AD14_UnPackDynInflowParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -7088,19 +7083,14 @@ SUBROUTINE AD14_UnPackDynInflowParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%MAXINFLO = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%MAXINFLO = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%xMinv,1) i1_u = UBOUND(OutData%xMinv,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%xMinv = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%xMinv))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%xMinv) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%xMinv,1), UBOUND(OutData%xMinv,1) + OutData%xMinv(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE AD14_UnPackDynInflowParms SUBROUTINE AD14_CopyElement( SrcElementData, DstElementData, CtrlCode, ErrStat, ErrMsg ) @@ -7341,8 +7331,12 @@ SUBROUTINE AD14_PackElement( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%A,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%A)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%A))-1 ) = PACK(InData%A,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%A) + DO i2 = LBOUND(InData%A,2), UBOUND(InData%A,2) + DO i1 = LBOUND(InData%A,1), UBOUND(InData%A,1) + ReKiBuf(Re_Xferred) = InData%A(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%AP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7357,8 +7351,12 @@ SUBROUTINE AD14_PackElement( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AP,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AP))-1 ) = PACK(InData%AP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AP) + DO i2 = LBOUND(InData%AP,2), UBOUND(InData%AP,2) + DO i1 = LBOUND(InData%AP,1), UBOUND(InData%AP,1) + ReKiBuf(Re_Xferred) = InData%AP(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%ALPHA) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7373,8 +7371,12 @@ SUBROUTINE AD14_PackElement( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ALPHA,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ALPHA)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%ALPHA))-1 ) = PACK(InData%ALPHA,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%ALPHA) + DO i2 = LBOUND(InData%ALPHA,2), UBOUND(InData%ALPHA,2) + DO i1 = LBOUND(InData%ALPHA,1), UBOUND(InData%ALPHA,1) + ReKiBuf(Re_Xferred) = InData%ALPHA(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%W2) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7389,8 +7391,12 @@ SUBROUTINE AD14_PackElement( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%W2,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%W2)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%W2))-1 ) = PACK(InData%W2,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%W2) + DO i2 = LBOUND(InData%W2,2), UBOUND(InData%W2,2) + DO i1 = LBOUND(InData%W2,1), UBOUND(InData%W2,1) + ReKiBuf(Re_Xferred) = InData%W2(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%OLD_A_NS) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7405,8 +7411,12 @@ SUBROUTINE AD14_PackElement( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLD_A_NS,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%OLD_A_NS)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%OLD_A_NS))-1 ) = PACK(InData%OLD_A_NS,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%OLD_A_NS) + DO i2 = LBOUND(InData%OLD_A_NS,2), UBOUND(InData%OLD_A_NS,2) + DO i1 = LBOUND(InData%OLD_A_NS,1), UBOUND(InData%OLD_A_NS,1) + ReKiBuf(Re_Xferred) = InData%OLD_A_NS(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%OLD_AP_NS) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7421,11 +7431,15 @@ SUBROUTINE AD14_PackElement( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLD_AP_NS,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%OLD_AP_NS)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%OLD_AP_NS))-1 ) = PACK(InData%OLD_AP_NS,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%OLD_AP_NS) + DO i2 = LBOUND(InData%OLD_AP_NS,2), UBOUND(InData%OLD_AP_NS,2) + DO i1 = LBOUND(InData%OLD_AP_NS,1), UBOUND(InData%OLD_AP_NS,1) + ReKiBuf(Re_Xferred) = InData%OLD_AP_NS(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PITNOW - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PITNOW + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_PackElement SUBROUTINE AD14_UnPackElement( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -7441,12 +7455,6 @@ SUBROUTINE AD14_UnPackElement( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -7478,15 +7486,12 @@ SUBROUTINE AD14_UnPackElement( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%A.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%A)>0) OutData%A = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%A))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%A) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%A,2), UBOUND(OutData%A,2) + DO i1 = LBOUND(OutData%A,1), UBOUND(OutData%A,1) + OutData%A(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AP not allocated Int_Xferred = Int_Xferred + 1 @@ -7504,15 +7509,12 @@ SUBROUTINE AD14_UnPackElement( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%AP)>0) OutData%AP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AP))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AP) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AP,2), UBOUND(OutData%AP,2) + DO i1 = LBOUND(OutData%AP,1), UBOUND(OutData%AP,1) + OutData%AP(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ALPHA not allocated Int_Xferred = Int_Xferred + 1 @@ -7530,15 +7532,12 @@ SUBROUTINE AD14_UnPackElement( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ALPHA.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%ALPHA)>0) OutData%ALPHA = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%ALPHA))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%ALPHA) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%ALPHA,2), UBOUND(OutData%ALPHA,2) + DO i1 = LBOUND(OutData%ALPHA,1), UBOUND(OutData%ALPHA,1) + OutData%ALPHA(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! W2 not allocated Int_Xferred = Int_Xferred + 1 @@ -7556,15 +7555,12 @@ SUBROUTINE AD14_UnPackElement( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%W2.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%W2)>0) OutData%W2 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%W2))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%W2) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%W2,2), UBOUND(OutData%W2,2) + DO i1 = LBOUND(OutData%W2,1), UBOUND(OutData%W2,1) + OutData%W2(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLD_A_NS not allocated Int_Xferred = Int_Xferred + 1 @@ -7582,15 +7578,12 @@ SUBROUTINE AD14_UnPackElement( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLD_A_NS.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%OLD_A_NS)>0) OutData%OLD_A_NS = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%OLD_A_NS))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%OLD_A_NS) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%OLD_A_NS,2), UBOUND(OutData%OLD_A_NS,2) + DO i1 = LBOUND(OutData%OLD_A_NS,1), UBOUND(OutData%OLD_A_NS,1) + OutData%OLD_A_NS(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLD_AP_NS not allocated Int_Xferred = Int_Xferred + 1 @@ -7608,18 +7601,15 @@ SUBROUTINE AD14_UnPackElement( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLD_AP_NS.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%OLD_AP_NS)>0) OutData%OLD_AP_NS = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%OLD_AP_NS))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%OLD_AP_NS) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%OLD_AP_NS,2), UBOUND(OutData%OLD_AP_NS,2) + DO i1 = LBOUND(OutData%OLD_AP_NS,1), UBOUND(OutData%OLD_AP_NS,1) + OutData%OLD_AP_NS(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%PITNOW = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%PITNOW = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_UnPackElement SUBROUTINE AD14_CopyElementParms( SrcElementParmsData, DstElementParmsData, CtrlCode, ErrStat, ErrMsg ) @@ -7794,8 +7784,8 @@ SUBROUTINE AD14_PackElementParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NELM - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NELM + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%TWIST) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -7806,8 +7796,10 @@ SUBROUTINE AD14_PackElementParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TWIST,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TWIST)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TWIST))-1 ) = PACK(InData%TWIST,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TWIST) + DO i1 = LBOUND(InData%TWIST,1), UBOUND(InData%TWIST,1) + ReKiBuf(Re_Xferred) = InData%TWIST(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%RELM) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7819,8 +7811,10 @@ SUBROUTINE AD14_PackElementParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RELM,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RELM)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RELM))-1 ) = PACK(InData%RELM,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RELM) + DO i1 = LBOUND(InData%RELM,1), UBOUND(InData%RELM,1) + ReKiBuf(Re_Xferred) = InData%RELM(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%HLCNST) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7832,8 +7826,10 @@ SUBROUTINE AD14_PackElementParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HLCNST,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%HLCNST)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%HLCNST))-1 ) = PACK(InData%HLCNST,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%HLCNST) + DO i1 = LBOUND(InData%HLCNST,1), UBOUND(InData%HLCNST,1) + ReKiBuf(Re_Xferred) = InData%HLCNST(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TLCNST) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7845,8 +7841,10 @@ SUBROUTINE AD14_PackElementParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TLCNST,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TLCNST)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TLCNST))-1 ) = PACK(InData%TLCNST,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TLCNST) + DO i1 = LBOUND(InData%TLCNST,1), UBOUND(InData%TLCNST,1) + ReKiBuf(Re_Xferred) = InData%TLCNST(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE AD14_PackElementParms @@ -7863,12 +7861,6 @@ SUBROUTINE AD14_UnPackElementParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -7883,8 +7875,8 @@ SUBROUTINE AD14_UnPackElementParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%NELM = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NELM = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TWIST not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -7898,15 +7890,10 @@ SUBROUTINE AD14_UnPackElementParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TWIST.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TWIST)>0) OutData%TWIST = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TWIST))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TWIST) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TWIST,1), UBOUND(OutData%TWIST,1) + OutData%TWIST(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RELM not allocated Int_Xferred = Int_Xferred + 1 @@ -7921,15 +7908,10 @@ SUBROUTINE AD14_UnPackElementParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RELM.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RELM)>0) OutData%RELM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RELM))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RELM) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%RELM,1), UBOUND(OutData%RELM,1) + OutData%RELM(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! HLCNST not allocated Int_Xferred = Int_Xferred + 1 @@ -7944,15 +7926,10 @@ SUBROUTINE AD14_UnPackElementParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%HLCNST.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%HLCNST)>0) OutData%HLCNST = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%HLCNST))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%HLCNST) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%HLCNST,1), UBOUND(OutData%HLCNST,1) + OutData%HLCNST(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TLCNST not allocated Int_Xferred = Int_Xferred + 1 @@ -7967,15 +7944,10 @@ SUBROUTINE AD14_UnPackElementParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TLCNST.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TLCNST)>0) OutData%TLCNST = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TLCNST))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TLCNST) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TLCNST,1), UBOUND(OutData%TLCNST,1) + OutData%TLCNST(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE AD14_UnPackElementParms @@ -8516,8 +8488,10 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AAA,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AAA)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AAA))-1 ) = PACK(InData%AAA,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AAA) + DO i1 = LBOUND(InData%AAA,1), UBOUND(InData%AAA,1) + ReKiBuf(Re_Xferred) = InData%AAA(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%AAP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8529,8 +8503,10 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AAP,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AAP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AAP))-1 ) = PACK(InData%AAP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AAP) + DO i1 = LBOUND(InData%AAP,1), UBOUND(InData%AAP,1) + ReKiBuf(Re_Xferred) = InData%AAP(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%ALF) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8542,8 +8518,10 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ALF,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ALF)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%ALF))-1 ) = PACK(InData%ALF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%ALF) + DO i1 = LBOUND(InData%ALF,1), UBOUND(InData%ALF,1) + ReKiBuf(Re_Xferred) = InData%ALF(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%CDD) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8555,8 +8533,10 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CDD,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CDD)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CDD))-1 ) = PACK(InData%CDD,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CDD) + DO i1 = LBOUND(InData%CDD,1), UBOUND(InData%CDD,1) + ReKiBuf(Re_Xferred) = InData%CDD(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%CLL) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8568,8 +8548,10 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CLL,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CLL)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CLL))-1 ) = PACK(InData%CLL,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CLL) + DO i1 = LBOUND(InData%CLL,1), UBOUND(InData%CLL,1) + ReKiBuf(Re_Xferred) = InData%CLL(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%CMM) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8581,8 +8563,10 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CMM,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CMM)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CMM))-1 ) = PACK(InData%CMM,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CMM) + DO i1 = LBOUND(InData%CMM,1), UBOUND(InData%CMM,1) + ReKiBuf(Re_Xferred) = InData%CMM(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%CNN) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8594,8 +8578,10 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNN,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CNN)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CNN))-1 ) = PACK(InData%CNN,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CNN) + DO i1 = LBOUND(InData%CNN,1), UBOUND(InData%CNN,1) + ReKiBuf(Re_Xferred) = InData%CNN(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%CTT) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8607,8 +8593,10 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CTT,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CTT)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CTT))-1 ) = PACK(InData%CTT,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CTT) + DO i1 = LBOUND(InData%CTT,1), UBOUND(InData%CTT,1) + ReKiBuf(Re_Xferred) = InData%CTT(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%DFNSAV) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8620,8 +8608,10 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DFNSAV,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DFNSAV)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DFNSAV))-1 ) = PACK(InData%DFNSAV,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DFNSAV) + DO i1 = LBOUND(InData%DFNSAV,1), UBOUND(InData%DFNSAV,1) + ReKiBuf(Re_Xferred) = InData%DFNSAV(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%DFTSAV) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8633,8 +8623,10 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DFTSAV,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DFTSAV)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DFTSAV))-1 ) = PACK(InData%DFTSAV,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DFTSAV) + DO i1 = LBOUND(InData%DFTSAV,1), UBOUND(InData%DFTSAV,1) + ReKiBuf(Re_Xferred) = InData%DFTSAV(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%DynPres) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8646,8 +8638,10 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DynPres,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DynPres)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DynPres))-1 ) = PACK(InData%DynPres,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DynPres) + DO i1 = LBOUND(InData%DynPres,1), UBOUND(InData%DynPres,1) + ReKiBuf(Re_Xferred) = InData%DynPres(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%PMM) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8659,8 +8653,10 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMM,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PMM)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PMM))-1 ) = PACK(InData%PMM,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PMM) + DO i1 = LBOUND(InData%PMM,1), UBOUND(InData%PMM,1) + ReKiBuf(Re_Xferred) = InData%PMM(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%PITSAV) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8672,8 +8668,10 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PITSAV,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PITSAV)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PITSAV))-1 ) = PACK(InData%PITSAV,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PITSAV) + DO i1 = LBOUND(InData%PITSAV,1), UBOUND(InData%PITSAV,1) + ReKiBuf(Re_Xferred) = InData%PITSAV(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%ReyNum) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8685,8 +8683,10 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ReyNum,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ReyNum)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%ReyNum))-1 ) = PACK(InData%ReyNum,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%ReyNum) + DO i1 = LBOUND(InData%ReyNum,1), UBOUND(InData%ReyNum,1) + ReKiBuf(Re_Xferred) = InData%ReyNum(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%SaveVX) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8701,8 +8701,12 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SaveVX,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%SaveVX)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SaveVX))-1 ) = PACK(InData%SaveVX,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SaveVX) + DO i2 = LBOUND(InData%SaveVX,2), UBOUND(InData%SaveVX,2) + DO i1 = LBOUND(InData%SaveVX,1), UBOUND(InData%SaveVX,1) + ReKiBuf(Re_Xferred) = InData%SaveVX(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%SaveVY) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8717,8 +8721,12 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SaveVY,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%SaveVY)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SaveVY))-1 ) = PACK(InData%SaveVY,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SaveVY) + DO i2 = LBOUND(InData%SaveVY,2), UBOUND(InData%SaveVY,2) + DO i1 = LBOUND(InData%SaveVY,1), UBOUND(InData%SaveVY,1) + ReKiBuf(Re_Xferred) = InData%SaveVY(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%SaveVZ) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8733,17 +8741,21 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SaveVZ,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%SaveVZ)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SaveVZ))-1 ) = PACK(InData%SaveVZ,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SaveVZ) + DO i2 = LBOUND(InData%SaveVZ,2), UBOUND(InData%SaveVZ,2) + DO i1 = LBOUND(InData%SaveVZ,1), UBOUND(InData%SaveVZ,1) + ReKiBuf(Re_Xferred) = InData%SaveVZ(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%VXSAV - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%VYSAV - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%VZSAV - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumWndElOut - Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VXSAV + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VYSAV + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VZSAV + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumWndElOut + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WndElPrList) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -8754,8 +8766,10 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WndElPrList,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WndElPrList)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%WndElPrList))-1 ) = PACK(InData%WndElPrList,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%WndElPrList) + DO i1 = LBOUND(InData%WndElPrList,1), UBOUND(InData%WndElPrList,1) + IntKiBuf(Int_Xferred) = InData%WndElPrList(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WndElPrNum) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8767,8 +8781,10 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WndElPrNum,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WndElPrNum)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%WndElPrNum))-1 ) = PACK(InData%WndElPrNum,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%WndElPrNum) + DO i1 = LBOUND(InData%WndElPrNum,1), UBOUND(InData%WndElPrNum,1) + IntKiBuf(Int_Xferred) = InData%WndElPrNum(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%ElPrList) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8780,8 +8796,10 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElPrList,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ElPrList)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%ElPrList))-1 ) = PACK(InData%ElPrList,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%ElPrList) + DO i1 = LBOUND(InData%ElPrList,1), UBOUND(InData%ElPrList,1) + IntKiBuf(Int_Xferred) = InData%ElPrList(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%ElPrNum) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8793,11 +8811,13 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElPrNum,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ElPrNum)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%ElPrNum))-1 ) = PACK(InData%ElPrNum,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%ElPrNum) + DO i1 = LBOUND(InData%ElPrNum,1), UBOUND(InData%ElPrNum,1) + IntKiBuf(Int_Xferred) = InData%ElPrNum(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumElOut - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumElOut + Int_Xferred = Int_Xferred + 1 END SUBROUTINE AD14_PackElOutParms SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -8813,12 +8833,6 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -8847,15 +8861,10 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AAA.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%AAA)>0) OutData%AAA = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AAA))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AAA) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AAA,1), UBOUND(OutData%AAA,1) + OutData%AAA(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AAP not allocated Int_Xferred = Int_Xferred + 1 @@ -8870,15 +8879,10 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AAP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%AAP)>0) OutData%AAP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AAP))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AAP) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AAP,1), UBOUND(OutData%AAP,1) + OutData%AAP(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ALF not allocated Int_Xferred = Int_Xferred + 1 @@ -8888,20 +8892,15 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 IF (ALLOCATED(OutData%ALF)) DEALLOCATE(OutData%ALF) - ALLOCATE(OutData%ALF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ALF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) + ALLOCATE(OutData%ALF(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ALF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask1 = .TRUE. - IF (SIZE(OutData%ALF)>0) OutData%ALF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%ALF))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%ALF) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%ALF,1), UBOUND(OutData%ALF,1) + OutData%ALF(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CDD not allocated Int_Xferred = Int_Xferred + 1 @@ -8916,15 +8915,10 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CDD.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%CDD)>0) OutData%CDD = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CDD))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CDD) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%CDD,1), UBOUND(OutData%CDD,1) + OutData%CDD(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CLL not allocated Int_Xferred = Int_Xferred + 1 @@ -8939,15 +8933,10 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CLL.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%CLL)>0) OutData%CLL = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CLL))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CLL) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%CLL,1), UBOUND(OutData%CLL,1) + OutData%CLL(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CMM not allocated Int_Xferred = Int_Xferred + 1 @@ -8962,15 +8951,10 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CMM.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%CMM)>0) OutData%CMM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CMM))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CMM) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%CMM,1), UBOUND(OutData%CMM,1) + OutData%CMM(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNN not allocated Int_Xferred = Int_Xferred + 1 @@ -8985,15 +8969,10 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNN.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%CNN)>0) OutData%CNN = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CNN))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CNN) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%CNN,1), UBOUND(OutData%CNN,1) + OutData%CNN(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CTT not allocated Int_Xferred = Int_Xferred + 1 @@ -9008,15 +8987,10 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CTT.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%CTT)>0) OutData%CTT = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CTT))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CTT) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%CTT,1), UBOUND(OutData%CTT,1) + OutData%CTT(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DFNSAV not allocated Int_Xferred = Int_Xferred + 1 @@ -9031,15 +9005,10 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DFNSAV.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%DFNSAV)>0) OutData%DFNSAV = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DFNSAV))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DFNSAV) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%DFNSAV,1), UBOUND(OutData%DFNSAV,1) + OutData%DFNSAV(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DFTSAV not allocated Int_Xferred = Int_Xferred + 1 @@ -9054,15 +9023,10 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DFTSAV.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%DFTSAV)>0) OutData%DFTSAV = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DFTSAV))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DFTSAV) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%DFTSAV,1), UBOUND(OutData%DFTSAV,1) + OutData%DFTSAV(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DynPres not allocated Int_Xferred = Int_Xferred + 1 @@ -9077,15 +9041,10 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DynPres.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%DynPres)>0) OutData%DynPres = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DynPres))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DynPres) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%DynPres,1), UBOUND(OutData%DynPres,1) + OutData%DynPres(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PMM not allocated Int_Xferred = Int_Xferred + 1 @@ -9100,15 +9059,10 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMM.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%PMM)>0) OutData%PMM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PMM))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PMM) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%PMM,1), UBOUND(OutData%PMM,1) + OutData%PMM(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PITSAV not allocated Int_Xferred = Int_Xferred + 1 @@ -9123,15 +9077,10 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PITSAV.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%PITSAV)>0) OutData%PITSAV = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PITSAV))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PITSAV) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%PITSAV,1), UBOUND(OutData%PITSAV,1) + OutData%PITSAV(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ReyNum not allocated Int_Xferred = Int_Xferred + 1 @@ -9146,15 +9095,10 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ReyNum.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%ReyNum)>0) OutData%ReyNum = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%ReyNum))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%ReyNum) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%ReyNum,1), UBOUND(OutData%ReyNum,1) + OutData%ReyNum(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SaveVX not allocated Int_Xferred = Int_Xferred + 1 @@ -9172,15 +9116,12 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SaveVX.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%SaveVX)>0) OutData%SaveVX = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SaveVX))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SaveVX) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%SaveVX,2), UBOUND(OutData%SaveVX,2) + DO i1 = LBOUND(OutData%SaveVX,1), UBOUND(OutData%SaveVX,1) + OutData%SaveVX(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SaveVY not allocated Int_Xferred = Int_Xferred + 1 @@ -9198,15 +9139,12 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SaveVY.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%SaveVY)>0) OutData%SaveVY = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SaveVY))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SaveVY) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%SaveVY,2), UBOUND(OutData%SaveVY,2) + DO i1 = LBOUND(OutData%SaveVY,1), UBOUND(OutData%SaveVY,1) + OutData%SaveVY(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SaveVZ not allocated Int_Xferred = Int_Xferred + 1 @@ -9224,24 +9162,21 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SaveVZ.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%SaveVZ)>0) OutData%SaveVZ = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SaveVZ))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SaveVZ) - DEALLOCATE(mask2) - END IF - OutData%VXSAV = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%VYSAV = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%VZSAV = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NumWndElOut = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(OutData%SaveVZ,2), UBOUND(OutData%SaveVZ,2) + DO i1 = LBOUND(OutData%SaveVZ,1), UBOUND(OutData%SaveVZ,1) + OutData%SaveVZ(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%VXSAV = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%VYSAV = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%VZSAV = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NumWndElOut = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WndElPrList not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -9255,15 +9190,10 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WndElPrList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WndElPrList)>0) OutData%WndElPrList = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%WndElPrList))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%WndElPrList) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WndElPrList,1), UBOUND(OutData%WndElPrList,1) + OutData%WndElPrList(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WndElPrNum not allocated Int_Xferred = Int_Xferred + 1 @@ -9278,15 +9208,10 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WndElPrNum.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WndElPrNum)>0) OutData%WndElPrNum = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%WndElPrNum))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%WndElPrNum) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WndElPrNum,1), UBOUND(OutData%WndElPrNum,1) + OutData%WndElPrNum(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ElPrList not allocated Int_Xferred = Int_Xferred + 1 @@ -9301,15 +9226,10 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElPrList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%ElPrList)>0) OutData%ElPrList = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%ElPrList))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%ElPrList) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%ElPrList,1), UBOUND(OutData%ElPrList,1) + OutData%ElPrList(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ElPrNum not allocated Int_Xferred = Int_Xferred + 1 @@ -9324,18 +9244,13 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElPrNum.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%ElPrNum)>0) OutData%ElPrNum = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%ElPrNum))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%ElPrNum) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%ElPrNum,1), UBOUND(OutData%ElPrNum,1) + OutData%ElPrNum(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF - OutData%NumElOut = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NumElOut = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE AD14_UnPackElOutParms SUBROUTINE AD14_CopyInducedVel( SrcInducedVelData, DstInducedVelData, CtrlCode, ErrStat, ErrMsg ) @@ -9429,8 +9344,8 @@ SUBROUTINE AD14_PackInducedVel( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SumInFl - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SumInFl + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_PackInducedVel SUBROUTINE AD14_UnPackInducedVel( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -9446,12 +9361,6 @@ SUBROUTINE AD14_UnPackInducedVel( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackInducedVel' @@ -9465,8 +9374,8 @@ SUBROUTINE AD14_UnPackInducedVel( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%SumInFl = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%SumInFl = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_UnPackInducedVel SUBROUTINE AD14_CopyInducedVelParms( SrcInducedVelParmsData, DstInducedVelParmsData, CtrlCode, ErrStat, ErrMsg ) @@ -9572,20 +9481,20 @@ SUBROUTINE AD14_PackInducedVelParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AToler - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%EqAIDmult - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%EquilDA , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%EquilDT , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TLoss , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%GTech , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%HLoss , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AToler + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%EqAIDmult + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%EquilDA, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%EquilDT, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TLoss, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%GTech, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%HLoss, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE AD14_PackInducedVelParms SUBROUTINE AD14_UnPackInducedVelParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -9601,12 +9510,6 @@ SUBROUTINE AD14_UnPackInducedVelParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackInducedVelParms' @@ -9620,20 +9523,20 @@ SUBROUTINE AD14_UnPackInducedVelParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%AToler = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%EqAIDmult = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%EquilDA = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%EquilDT = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%TLoss = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%GTech = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%HLoss = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%AToler = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%EqAIDmult = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%EquilDA = TRANSFER(IntKiBuf(Int_Xferred), OutData%EquilDA) + Int_Xferred = Int_Xferred + 1 + OutData%EquilDT = TRANSFER(IntKiBuf(Int_Xferred), OutData%EquilDT) + Int_Xferred = Int_Xferred + 1 + OutData%TLoss = TRANSFER(IntKiBuf(Int_Xferred), OutData%TLoss) + Int_Xferred = Int_Xferred + 1 + OutData%GTech = TRANSFER(IntKiBuf(Int_Xferred), OutData%GTech) + Int_Xferred = Int_Xferred + 1 + OutData%HLoss = TRANSFER(IntKiBuf(Int_Xferred), OutData%HLoss) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE AD14_UnPackInducedVelParms SUBROUTINE AD14_CopyRotor( SrcRotorData, DstRotorData, CtrlCode, ErrStat, ErrMsg ) @@ -9743,24 +9646,24 @@ SUBROUTINE AD14_PackRotor( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AVGINFL - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CTILT - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CYaw - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%REVS - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%STILT - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SYaw - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TILT - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawAng - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawVEL - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AVGINFL + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CTILT + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CYaw + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%REVS + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%STILT + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SYaw + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TILT + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawAng + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawVEL + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_PackRotor SUBROUTINE AD14_UnPackRotor( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -9776,12 +9679,6 @@ SUBROUTINE AD14_UnPackRotor( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackRotor' @@ -9795,24 +9692,24 @@ SUBROUTINE AD14_UnPackRotor( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%AVGINFL = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%CTILT = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%CYaw = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%REVS = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%STILT = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SYaw = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TILT = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawAng = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawVEL = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%AVGINFL = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%CTILT = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%CYaw = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%REVS = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%STILT = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SYaw = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TILT = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawAng = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawVEL = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_UnPackRotor SUBROUTINE AD14_CopyRotorParms( SrcRotorParmsData, DstRotorParmsData, CtrlCode, ErrStat, ErrMsg ) @@ -9906,8 +9803,8 @@ SUBROUTINE AD14_PackRotorParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HH - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HH + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_PackRotorParms SUBROUTINE AD14_UnPackRotorParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -9923,12 +9820,6 @@ SUBROUTINE AD14_UnPackRotorParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackRotorParms' @@ -9942,8 +9833,8 @@ SUBROUTINE AD14_UnPackRotorParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%HH = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%HH = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_UnPackRotorParms SUBROUTINE AD14_CopyTwrPropsParms( SrcTwrPropsParmsData, DstTwrPropsParmsData, CtrlCode, ErrStat, ErrMsg ) @@ -10201,8 +10092,10 @@ SUBROUTINE AD14_PackTwrPropsParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrHtFr,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwrHtFr)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwrHtFr))-1 ) = PACK(InData%TwrHtFr,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwrHtFr) + DO i1 = LBOUND(InData%TwrHtFr,1), UBOUND(InData%TwrHtFr,1) + ReKiBuf(Re_Xferred) = InData%TwrHtFr(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TwrWid) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10214,8 +10107,10 @@ SUBROUTINE AD14_PackTwrPropsParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrWid,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwrWid)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwrWid))-1 ) = PACK(InData%TwrWid,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwrWid) + DO i1 = LBOUND(InData%TwrWid,1), UBOUND(InData%TwrWid,1) + ReKiBuf(Re_Xferred) = InData%TwrWid(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TwrCD) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10230,8 +10125,12 @@ SUBROUTINE AD14_PackTwrPropsParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrCD,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwrCD)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwrCD))-1 ) = PACK(InData%TwrCD,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwrCD) + DO i2 = LBOUND(InData%TwrCD,2), UBOUND(InData%TwrCD,2) + DO i1 = LBOUND(InData%TwrCD,1), UBOUND(InData%TwrCD,1) + ReKiBuf(Re_Xferred) = InData%TwrCD(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%TwrRe) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10243,13 +10142,17 @@ SUBROUTINE AD14_PackTwrPropsParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrRe,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwrRe)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwrRe))-1 ) = PACK(InData%TwrRe,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwrRe) + DO i1 = LBOUND(InData%TwrRe,1), UBOUND(InData%TwrRe,1) + ReKiBuf(Re_Xferred) = InData%TwrRe(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%VTwr))-1 ) = PACK(InData%VTwr,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%VTwr) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Tower_Wake_Constant - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%VTwr,1), UBOUND(InData%VTwr,1) + ReKiBuf(Re_Xferred) = InData%VTwr(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%Tower_Wake_Constant + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%NTwrCDCol) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -10260,39 +10163,41 @@ SUBROUTINE AD14_PackTwrPropsParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NTwrCDCol,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%NTwrCDCol)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%NTwrCDCol))-1 ) = PACK(InData%NTwrCDCol,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%NTwrCDCol) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NTwrHT - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NTwrRe - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NTwrCD - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TwrPotent , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TwrShadow , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ShadHWid - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TShadC1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TShadC2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TwrShad - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PJM_Version , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%TwrFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%TwrFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%T_Shad_Refpt - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%CalcTwrAero , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumTwrNodes - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%NTwrCDCol,1), UBOUND(InData%NTwrCDCol,1) + IntKiBuf(Int_Xferred) = InData%NTwrCDCol(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = InData%NTwrHT + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NTwrRe + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NTwrCD + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TwrPotent, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TwrShadow, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ShadHWid + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TShadC1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TShadC2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TwrShad + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PJM_Version, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%TwrFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%TwrFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + ReKiBuf(Re_Xferred) = InData%T_Shad_Refpt + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%CalcTwrAero, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumTwrNodes + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%TwrNodeWidth) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -10303,8 +10208,10 @@ SUBROUTINE AD14_PackTwrPropsParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrNodeWidth,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwrNodeWidth)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwrNodeWidth))-1 ) = PACK(InData%TwrNodeWidth,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwrNodeWidth) + DO i1 = LBOUND(InData%TwrNodeWidth,1), UBOUND(InData%TwrNodeWidth,1) + ReKiBuf(Re_Xferred) = InData%TwrNodeWidth(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE AD14_PackTwrPropsParms @@ -10321,12 +10228,6 @@ SUBROUTINE AD14_UnPackTwrPropsParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -10355,15 +10256,10 @@ SUBROUTINE AD14_UnPackTwrPropsParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrHtFr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwrHtFr)>0) OutData%TwrHtFr = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwrHtFr))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwrHtFr) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwrHtFr,1), UBOUND(OutData%TwrHtFr,1) + OutData%TwrHtFr(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrWid not allocated Int_Xferred = Int_Xferred + 1 @@ -10378,15 +10274,10 @@ SUBROUTINE AD14_UnPackTwrPropsParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrWid.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwrWid)>0) OutData%TwrWid = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwrWid))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwrWid) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwrWid,1), UBOUND(OutData%TwrWid,1) + OutData%TwrWid(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrCD not allocated Int_Xferred = Int_Xferred + 1 @@ -10404,15 +10295,12 @@ SUBROUTINE AD14_UnPackTwrPropsParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrCD.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%TwrCD)>0) OutData%TwrCD = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwrCD))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwrCD) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%TwrCD,2), UBOUND(OutData%TwrCD,2) + DO i1 = LBOUND(OutData%TwrCD,1), UBOUND(OutData%TwrCD,1) + OutData%TwrCD(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrRe not allocated Int_Xferred = Int_Xferred + 1 @@ -10427,29 +10315,19 @@ SUBROUTINE AD14_UnPackTwrPropsParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrRe.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwrRe)>0) OutData%TwrRe = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwrRe))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwrRe) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwrRe,1), UBOUND(OutData%TwrRe,1) + OutData%TwrRe(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF i1_l = LBOUND(OutData%VTwr,1) i1_u = UBOUND(OutData%VTwr,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%VTwr = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%VTwr))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%VTwr) - DEALLOCATE(mask1) - OutData%Tower_Wake_Constant = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%VTwr,1), UBOUND(OutData%VTwr,1) + OutData%VTwr(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%Tower_Wake_Constant = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NTwrCDCol not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -10463,46 +10341,41 @@ SUBROUTINE AD14_UnPackTwrPropsParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NTwrCDCol.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%NTwrCDCol)>0) OutData%NTwrCDCol = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%NTwrCDCol))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%NTwrCDCol) - DEALLOCATE(mask1) - END IF - OutData%NTwrHT = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NTwrRe = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NTwrCD = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TwrPotent = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%TwrShadow = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%ShadHWid = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TShadC1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TShadC2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TwrShad = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PJM_Version = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%TwrFile) - OutData%TwrFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%T_Shad_Refpt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%CalcTwrAero = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NumTwrNodes = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%NTwrCDCol,1), UBOUND(OutData%NTwrCDCol,1) + OutData%NTwrCDCol(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + OutData%NTwrHT = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NTwrRe = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NTwrCD = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TwrPotent = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwrPotent) + Int_Xferred = Int_Xferred + 1 + OutData%TwrShadow = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwrShadow) + Int_Xferred = Int_Xferred + 1 + OutData%ShadHWid = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TShadC1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TShadC2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TwrShad = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PJM_Version = TRANSFER(IntKiBuf(Int_Xferred), OutData%PJM_Version) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%TwrFile) + OutData%TwrFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%T_Shad_Refpt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%CalcTwrAero = TRANSFER(IntKiBuf(Int_Xferred), OutData%CalcTwrAero) + Int_Xferred = Int_Xferred + 1 + OutData%NumTwrNodes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrNodeWidth not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -10516,15 +10389,10 @@ SUBROUTINE AD14_UnPackTwrPropsParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrNodeWidth.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwrNodeWidth)>0) OutData%TwrNodeWidth = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwrNodeWidth))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwrNodeWidth) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwrNodeWidth,1), UBOUND(OutData%TwrNodeWidth,1) + OutData%TwrNodeWidth(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE AD14_UnPackTwrPropsParms @@ -10629,18 +10497,18 @@ SUBROUTINE AD14_PackWind( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ANGFLW - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CDEL - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%VROTORX - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%VROTORY - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%VROTORZ - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SDEL - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ANGFLW + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CDEL + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VROTORX + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VROTORY + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VROTORZ + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SDEL + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_PackWind SUBROUTINE AD14_UnPackWind( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -10656,12 +10524,6 @@ SUBROUTINE AD14_UnPackWind( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackWind' @@ -10675,18 +10537,18 @@ SUBROUTINE AD14_UnPackWind( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%ANGFLW = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%CDEL = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%VROTORX = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%VROTORY = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%VROTORZ = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SDEL = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%ANGFLW = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%CDEL = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%VROTORX = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%VROTORY = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%VROTORZ = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SDEL = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_UnPackWind SUBROUTINE AD14_CopyWindParms( SrcWindParmsData, DstWindParmsData, CtrlCode, ErrStat, ErrMsg ) @@ -10782,10 +10644,10 @@ SUBROUTINE AD14_PackWindParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Rho - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%KinVisc - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Rho + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%KinVisc + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_PackWindParms SUBROUTINE AD14_UnPackWindParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -10801,12 +10663,6 @@ SUBROUTINE AD14_UnPackWindParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackWindParms' @@ -10820,10 +10676,10 @@ SUBROUTINE AD14_UnPackWindParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%Rho = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%KinVisc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%Rho = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%KinVisc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_UnPackWindParms SUBROUTINE AD14_CopyPositionType( SrcPositionTypeData, DstPositionTypeData, CtrlCode, ErrStat, ErrMsg ) @@ -10918,8 +10774,10 @@ SUBROUTINE AD14_PackPositionType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Pos))-1 ) = PACK(InData%Pos,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Pos) + DO i1 = LBOUND(InData%Pos,1), UBOUND(InData%Pos,1) + ReKiBuf(Re_Xferred) = InData%Pos(i1) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE AD14_PackPositionType SUBROUTINE AD14_UnPackPositionType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -10935,12 +10793,6 @@ SUBROUTINE AD14_UnPackPositionType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -10957,15 +10809,10 @@ SUBROUTINE AD14_UnPackPositionType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Xferred = 1 i1_l = LBOUND(OutData%Pos,1) i1_u = UBOUND(OutData%Pos,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%Pos = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Pos))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Pos) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Pos,1), UBOUND(OutData%Pos,1) + OutData%Pos(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE AD14_UnPackPositionType SUBROUTINE AD14_CopyOrientationType( SrcOrientationTypeData, DstOrientationTypeData, CtrlCode, ErrStat, ErrMsg ) @@ -11061,8 +10908,12 @@ SUBROUTINE AD14_PackOrientationType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Orient))-1 ) = PACK(InData%Orient,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Orient) + DO i2 = LBOUND(InData%Orient,2), UBOUND(InData%Orient,2) + DO i1 = LBOUND(InData%Orient,1), UBOUND(InData%Orient,1) + ReKiBuf(Re_Xferred) = InData%Orient(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END SUBROUTINE AD14_PackOrientationType SUBROUTINE AD14_UnPackOrientationType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -11078,12 +10929,6 @@ SUBROUTINE AD14_UnPackOrientationType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -11103,15 +10948,12 @@ SUBROUTINE AD14_UnPackOrientationType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS i1_u = UBOUND(OutData%Orient,1) i2_l = LBOUND(OutData%Orient,2) i2_u = UBOUND(OutData%Orient,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%Orient = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Orient))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Orient) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Orient,2), UBOUND(OutData%Orient,2) + DO i1 = LBOUND(OutData%Orient,1), UBOUND(OutData%Orient,1) + OutData%Orient(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END SUBROUTINE AD14_UnPackOrientationType SUBROUTINE AD14_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) @@ -11290,28 +11132,28 @@ SUBROUTINE AD14_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%Title) - IntKiBuf(Int_Xferred) = ICHAR(InData%Title(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutRootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutRootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%ADFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%ADFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%WrSumFile , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumBl - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%BladeLength - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%LinearizeFlag , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%UseDWM , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%Title) + IntKiBuf(Int_Xferred) = ICHAR(InData%Title(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%OutRootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutRootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%ADFileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%ADFileName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%WrSumFile, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumBl + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%BladeLength + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%LinearizeFlag, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%UseDWM, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 CALL AD14_Packaeroconfig( Re_Buf, Db_Buf, Int_Buf, InData%TurbineComponents, ErrStat2, ErrMsg2, OnlySize ) ! TurbineComponents CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -11340,8 +11182,8 @@ SUBROUTINE AD14_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumTwrNodes - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumTwrNodes + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%TwrNodeLocs) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -11355,11 +11197,15 @@ SUBROUTINE AD14_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrNodeLocs,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwrNodeLocs)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwrNodeLocs))-1 ) = PACK(InData%TwrNodeLocs,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwrNodeLocs) + DO i2 = LBOUND(InData%TwrNodeLocs,2), UBOUND(InData%TwrNodeLocs,2) + DO i1 = LBOUND(InData%TwrNodeLocs,1), UBOUND(InData%TwrNodeLocs,1) + ReKiBuf(Re_Xferred) = InData%TwrNodeLocs(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HubHt - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HubHt + Re_Xferred = Re_Xferred + 1 CALL DWM_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%DWM, ErrStat2, ErrMsg2, OnlySize ) ! DWM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -11403,12 +11249,6 @@ SUBROUTINE AD14_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -11424,28 +11264,28 @@ SUBROUTINE AD14_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%Title) - OutData%Title(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutRootName) - OutData%OutRootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%ADFileName) - OutData%ADFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%WrSumFile = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NumBl = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%BladeLength = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%LinearizeFlag = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%UseDWM = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%Title) + OutData%Title(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%OutRootName) + OutData%OutRootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%ADFileName) + OutData%ADFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%WrSumFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%WrSumFile) + Int_Xferred = Int_Xferred + 1 + OutData%NumBl = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%BladeLength = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LinearizeFlag = TRANSFER(IntKiBuf(Int_Xferred), OutData%LinearizeFlag) + Int_Xferred = Int_Xferred + 1 + OutData%UseDWM = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseDWM) + Int_Xferred = Int_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -11486,8 +11326,8 @@ SUBROUTINE AD14_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%NumTwrNodes = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NumTwrNodes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrNodeLocs not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -11504,18 +11344,15 @@ SUBROUTINE AD14_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrNodeLocs.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%TwrNodeLocs)>0) OutData%TwrNodeLocs = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwrNodeLocs))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwrNodeLocs) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%TwrNodeLocs,2), UBOUND(OutData%TwrNodeLocs,2) + DO i1 = LBOUND(OutData%TwrNodeLocs,1), UBOUND(OutData%TwrNodeLocs,1) + OutData%TwrNodeLocs(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%HubHt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%HubHt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -11748,8 +11585,8 @@ SUBROUTINE AD14_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AirDens - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AirDens + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_PackInitOutput SUBROUTINE AD14_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -11765,12 +11602,6 @@ SUBROUTINE AD14_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackInitOutput' @@ -11864,8 +11695,8 @@ SUBROUTINE AD14_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%AirDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%AirDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_UnPackInitOutput SUBROUTINE AD14_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) @@ -12022,12 +11853,6 @@ SUBROUTINE AD14_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackContState' @@ -12237,12 +12062,6 @@ SUBROUTINE AD14_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackDiscState' @@ -12452,12 +12271,6 @@ SUBROUTINE AD14_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackConstrState' @@ -12667,12 +12480,6 @@ SUBROUTINE AD14_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackOtherState' @@ -13236,8 +13043,8 @@ SUBROUTINE AD14_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 IF ( .NOT. ALLOCATED(InData%ElPrNum) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -13248,33 +13055,35 @@ SUBROUTINE AD14_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElPrNum,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ElPrNum)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%ElPrNum))-1 ) = PACK(InData%ElPrNum,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%ElPrNum) - END IF - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%OldTime - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HubLoss - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Loss - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TipLoss - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TLpt7 - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%FirstPassGTL , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%SuperSonic , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%AFLAGVinderr , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%AFLAGTwrInflu , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%OnePassDynDbg , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%NoLoadsCalculated , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NERRORS - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%ElPrNum,1), UBOUND(InData%ElPrNum,1) + IntKiBuf(Int_Xferred) = InData%ElPrNum(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + DbKiBuf(Db_Xferred) = InData%OldTime + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HubLoss + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Loss + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TipLoss + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TLpt7 + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%FirstPassGTL, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%SuperSonic, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%AFLAGVinderr, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%AFLAGTwrInflu, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%OnePassDynDbg, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%NoLoadsCalculated, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NERRORS + Int_Xferred = Int_Xferred + 1 CALL AD14_Packairfoil( Re_Buf, Db_Buf, Int_Buf, InData%AirFoil, ErrStat2, ErrMsg2, OnlySize ) ! AirFoil CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -13499,12 +13308,12 @@ SUBROUTINE AD14_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Skew , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%DynInit , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%FirstWarn , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%Skew, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%DynInit, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%FirstWarn, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%StoredForces) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -13521,8 +13330,14 @@ SUBROUTINE AD14_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StoredForces,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%StoredForces)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%StoredForces))-1 ) = PACK(InData%StoredForces,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%StoredForces) + DO i3 = LBOUND(InData%StoredForces,3), UBOUND(InData%StoredForces,3) + DO i2 = LBOUND(InData%StoredForces,2), UBOUND(InData%StoredForces,2) + DO i1 = LBOUND(InData%StoredForces,1), UBOUND(InData%StoredForces,1) + ReKiBuf(Re_Xferred) = InData%StoredForces(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%StoredMoments) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -13540,8 +13355,14 @@ SUBROUTINE AD14_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StoredMoments,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%StoredMoments)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%StoredMoments))-1 ) = PACK(InData%StoredMoments,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%StoredMoments) + DO i3 = LBOUND(InData%StoredMoments,3), UBOUND(InData%StoredMoments,3) + DO i2 = LBOUND(InData%StoredMoments,2), UBOUND(InData%StoredMoments,2) + DO i1 = LBOUND(InData%StoredMoments,1), UBOUND(InData%StoredMoments,1) + ReKiBuf(Re_Xferred) = InData%StoredMoments(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF END SUBROUTINE AD14_PackMisc @@ -13558,12 +13379,6 @@ SUBROUTINE AD14_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -13700,8 +13515,8 @@ SUBROUTINE AD14_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ElPrNum not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -13715,40 +13530,35 @@ SUBROUTINE AD14_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElPrNum.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%ElPrNum)>0) OutData%ElPrNum = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%ElPrNum))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%ElPrNum) - DEALLOCATE(mask1) - END IF - OutData%OldTime = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%HubLoss = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Loss = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TipLoss = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TLpt7 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%FirstPassGTL = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%SuperSonic = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%AFLAGVinderr = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%AFLAGTwrInflu = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%OnePassDynDbg = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NoLoadsCalculated = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NERRORS = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%ElPrNum,1), UBOUND(OutData%ElPrNum,1) + OutData%ElPrNum(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + OutData%OldTime = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%HubLoss = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Loss = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TipLoss = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TLpt7 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%FirstPassGTL = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstPassGTL) + Int_Xferred = Int_Xferred + 1 + OutData%SuperSonic = TRANSFER(IntKiBuf(Int_Xferred), OutData%SuperSonic) + Int_Xferred = Int_Xferred + 1 + OutData%AFLAGVinderr = TRANSFER(IntKiBuf(Int_Xferred), OutData%AFLAGVinderr) + Int_Xferred = Int_Xferred + 1 + OutData%AFLAGTwrInflu = TRANSFER(IntKiBuf(Int_Xferred), OutData%AFLAGTwrInflu) + Int_Xferred = Int_Xferred + 1 + OutData%OnePassDynDbg = TRANSFER(IntKiBuf(Int_Xferred), OutData%OnePassDynDbg) + Int_Xferred = Int_Xferred + 1 + OutData%NoLoadsCalculated = TRANSFER(IntKiBuf(Int_Xferred), OutData%NoLoadsCalculated) + Int_Xferred = Int_Xferred + 1 + OutData%NERRORS = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -14069,12 +13879,12 @@ SUBROUTINE AD14_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%Skew = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%DynInit = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%FirstWarn = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%Skew = TRANSFER(IntKiBuf(Int_Xferred), OutData%Skew) + Int_Xferred = Int_Xferred + 1 + OutData%DynInit = TRANSFER(IntKiBuf(Int_Xferred), OutData%DynInit) + Int_Xferred = Int_Xferred + 1 + OutData%FirstWarn = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstWarn) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StoredForces not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -14094,15 +13904,14 @@ SUBROUTINE AD14_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StoredForces.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%StoredForces)>0) OutData%StoredForces = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%StoredForces))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%StoredForces) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%StoredForces,3), UBOUND(OutData%StoredForces,3) + DO i2 = LBOUND(OutData%StoredForces,2), UBOUND(OutData%StoredForces,2) + DO i1 = LBOUND(OutData%StoredForces,1), UBOUND(OutData%StoredForces,1) + OutData%StoredForces(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 ! StoredMoments not allocated Int_Xferred = Int_Xferred + 1 @@ -14123,15 +13932,14 @@ SUBROUTINE AD14_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StoredMoments.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%StoredMoments)>0) OutData%StoredMoments = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%StoredMoments))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%StoredMoments) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%StoredMoments,3), UBOUND(OutData%StoredMoments,3) + DO i2 = LBOUND(OutData%StoredMoments,2), UBOUND(OutData%StoredMoments,2) + DO i1 = LBOUND(OutData%StoredMoments,1), UBOUND(OutData%StoredMoments,1) + OutData%StoredMoments(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF END SUBROUTINE AD14_UnPackMisc @@ -14485,58 +14293,58 @@ SUBROUTINE AD14_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%Title) - IntKiBuf(Int_Xferred) = ICHAR(InData%Title(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%SIUnit , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Echo , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%MultiTab , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%LinearizeFlag , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%OutputPlottingInfo , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%UseDWM , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TwoPiNB - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumBl - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NBlInpSt - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%ElemPrn , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%DStall , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PMoment , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Reynolds , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%DynInfl , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Wake , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Swirl , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DtAero - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HubRad - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UnEc - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UnElem - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UnWndOut - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MAXICOUNT - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%WrOptFile , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DEFAULT_Wind - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%Title) + IntKiBuf(Int_Xferred) = ICHAR(InData%Title(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%SIUnit, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%Echo, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%MultiTab, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%LinearizeFlag, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%OutputPlottingInfo, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%UseDWM, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TwoPiNB + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumBl + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NBlInpSt + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%ElemPrn, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%DStall, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PMoment, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%Reynolds, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%DynInfl, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%Wake, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%Swirl, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DtAero + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HubRad + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%UnEc + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%UnElem + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%UnWndOut + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MAXICOUNT + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%WrOptFile, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DEFAULT_Wind + Int_Xferred = Int_Xferred + 1 CALL AD14_Packairfoilparms( Re_Buf, Db_Buf, Int_Buf, InData%AirFoil, ErrStat2, ErrMsg2, OnlySize ) ! AirFoil CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -14832,12 +14640,6 @@ SUBROUTINE AD14_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackParam' @@ -14851,58 +14653,58 @@ SUBROUTINE AD14_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%Title) - OutData%Title(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%SIUnit = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%Echo = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%MultiTab = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%LinearizeFlag = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%OutputPlottingInfo = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%UseDWM = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%TwoPiNB = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NumBl = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NBlInpSt = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ElemPrn = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%DStall = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%PMoment = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%Reynolds = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%DynInfl = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%Wake = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%Swirl = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%DtAero = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%HubRad = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%UnEc = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%UnElem = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%UnWndOut = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%MAXICOUNT = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%WrOptFile = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%DEFAULT_Wind = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%Title) + OutData%Title(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%SIUnit = TRANSFER(IntKiBuf(Int_Xferred), OutData%SIUnit) + Int_Xferred = Int_Xferred + 1 + OutData%Echo = TRANSFER(IntKiBuf(Int_Xferred), OutData%Echo) + Int_Xferred = Int_Xferred + 1 + OutData%MultiTab = TRANSFER(IntKiBuf(Int_Xferred), OutData%MultiTab) + Int_Xferred = Int_Xferred + 1 + OutData%LinearizeFlag = TRANSFER(IntKiBuf(Int_Xferred), OutData%LinearizeFlag) + Int_Xferred = Int_Xferred + 1 + OutData%OutputPlottingInfo = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutputPlottingInfo) + Int_Xferred = Int_Xferred + 1 + OutData%UseDWM = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseDWM) + Int_Xferred = Int_Xferred + 1 + OutData%TwoPiNB = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NumBl = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NBlInpSt = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ElemPrn = TRANSFER(IntKiBuf(Int_Xferred), OutData%ElemPrn) + Int_Xferred = Int_Xferred + 1 + OutData%DStall = TRANSFER(IntKiBuf(Int_Xferred), OutData%DStall) + Int_Xferred = Int_Xferred + 1 + OutData%PMoment = TRANSFER(IntKiBuf(Int_Xferred), OutData%PMoment) + Int_Xferred = Int_Xferred + 1 + OutData%Reynolds = TRANSFER(IntKiBuf(Int_Xferred), OutData%Reynolds) + Int_Xferred = Int_Xferred + 1 + OutData%DynInfl = TRANSFER(IntKiBuf(Int_Xferred), OutData%DynInfl) + Int_Xferred = Int_Xferred + 1 + OutData%Wake = TRANSFER(IntKiBuf(Int_Xferred), OutData%Wake) + Int_Xferred = Int_Xferred + 1 + OutData%Swirl = TRANSFER(IntKiBuf(Int_Xferred), OutData%Swirl) + Int_Xferred = Int_Xferred + 1 + OutData%DtAero = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%HubRad = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%UnEc = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%UnElem = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%UnWndOut = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%MAXICOUNT = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WrOptFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%WrOptFile) + Int_Xferred = Int_Xferred + 1 + OutData%DEFAULT_Wind = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -15640,8 +15442,12 @@ SUBROUTINE AD14_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MulTabLoc,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%MulTabLoc)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MulTabLoc))-1 ) = PACK(InData%MulTabLoc,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MulTabLoc) + DO i2 = LBOUND(InData%MulTabLoc,2), UBOUND(InData%MulTabLoc,2) + DO i1 = LBOUND(InData%MulTabLoc,1), UBOUND(InData%MulTabLoc,1) + ReKiBuf(Re_Xferred) = InData%MulTabLoc(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%InflowVelocity) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -15656,11 +15462,17 @@ SUBROUTINE AD14_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InflowVelocity,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%InflowVelocity)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%InflowVelocity))-1 ) = PACK(InData%InflowVelocity,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%InflowVelocity) + DO i2 = LBOUND(InData%InflowVelocity,2), UBOUND(InData%InflowVelocity,2) + DO i1 = LBOUND(InData%InflowVelocity,1), UBOUND(InData%InflowVelocity,1) + ReKiBuf(Re_Xferred) = InData%InflowVelocity(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AvgInfVel))-1 ) = PACK(InData%AvgInfVel,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AvgInfVel) + DO i1 = LBOUND(InData%AvgInfVel,1), UBOUND(InData%AvgInfVel,1) + ReKiBuf(Re_Xferred) = InData%AvgInfVel(i1) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE AD14_PackInput SUBROUTINE AD14_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -15676,12 +15488,6 @@ SUBROUTINE AD14_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -15849,15 +15655,12 @@ SUBROUTINE AD14_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MulTabLoc.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%MulTabLoc)>0) OutData%MulTabLoc = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MulTabLoc))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MulTabLoc) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%MulTabLoc,2), UBOUND(OutData%MulTabLoc,2) + DO i1 = LBOUND(OutData%MulTabLoc,1), UBOUND(OutData%MulTabLoc,1) + OutData%MulTabLoc(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InflowVelocity not allocated Int_Xferred = Int_Xferred + 1 @@ -15875,27 +15678,19 @@ SUBROUTINE AD14_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InflowVelocity.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%InflowVelocity)>0) OutData%InflowVelocity = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%InflowVelocity))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%InflowVelocity) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%InflowVelocity,2), UBOUND(OutData%InflowVelocity,2) + DO i1 = LBOUND(OutData%InflowVelocity,1), UBOUND(OutData%InflowVelocity,1) + OutData%InflowVelocity(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF i1_l = LBOUND(OutData%AvgInfVel,1) i1_u = UBOUND(OutData%AvgInfVel,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%AvgInfVel = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AvgInfVel))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AvgInfVel) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AvgInfVel,1), UBOUND(OutData%AvgInfVel,1) + OutData%AvgInfVel(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE AD14_UnPackInput SUBROUTINE AD14_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -16139,12 +15934,6 @@ SUBROUTINE AD14_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -16332,16 +16121,16 @@ SUBROUTINE AD14_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'AD14_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! 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 = "" @@ -16354,9 +16143,11 @@ SUBROUTINE AD14_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ALLOCATED(u_out%InputMarkers) .AND. ALLOCATED(u1%InputMarkers)) THEN - DO i01 = LBOUND(u_out%InputMarkers,1),UBOUND(u_out%InputMarkers,1) - CALL MeshExtrapInterp1(u1%InputMarkers(i01), u2%InputMarkers(i01), tin, u_out%InputMarkers(i01), tin_out, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(u_out%InputMarkers,1),UBOUND(u_out%InputMarkers,1) + CALL MeshExtrapInterp1(u1%InputMarkers(i1), u2%InputMarkers(i1), tin, u_out%InputMarkers(i1), tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) ENDDO END IF ! check if allocated @@ -16364,230 +16155,180 @@ SUBROUTINE AD14_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(u_out%TurbineComponents%Blade) .AND. ALLOCATED(u1%TurbineComponents%Blade)) THEN DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Blade(i11)%Position,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Blade(i11)%Position,1))) - b1 = -(u1%TurbineComponents%Blade(i11)%Position - u2%TurbineComponents%Blade(i11)%Position)/t(2) - u_out%TurbineComponents%Blade(i11)%Position = u1%TurbineComponents%Blade(i11)%Position + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%TurbineComponents%Blade(i11)%Position,1),UBOUND(u_out%TurbineComponents%Blade(i11)%Position,1) + b = -(u1%TurbineComponents%Blade(i11)%Position(i1) - u2%TurbineComponents%Blade(i11)%Position(i1)) + u_out%TurbineComponents%Blade(i11)%Position(i1) = u1%TurbineComponents%Blade(i11)%Position(i1) + b * ScaleFactor + END DO ENDDO DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) - ALLOCATE(b2(SIZE(u_out%TurbineComponents%Blade(i11)%Orientation,1),SIZE(u_out%TurbineComponents%Blade(i11)%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%TurbineComponents%Blade(i11)%Orientation,1),SIZE(u_out%TurbineComponents%Blade(i11)%Orientation,2) )) - b2 = -(u1%TurbineComponents%Blade(i11)%Orientation - u2%TurbineComponents%Blade(i11)%Orientation)/t(2) - u_out%TurbineComponents%Blade(i11)%Orientation = u1%TurbineComponents%Blade(i11)%Orientation + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%TurbineComponents%Blade(i11)%Orientation,2),UBOUND(u_out%TurbineComponents%Blade(i11)%Orientation,2) + DO i1 = LBOUND(u_out%TurbineComponents%Blade(i11)%Orientation,1),UBOUND(u_out%TurbineComponents%Blade(i11)%Orientation,1) + b = -(u1%TurbineComponents%Blade(i11)%Orientation(i1,i2) - u2%TurbineComponents%Blade(i11)%Orientation(i1,i2)) + u_out%TurbineComponents%Blade(i11)%Orientation(i1,i2) = u1%TurbineComponents%Blade(i11)%Orientation(i1,i2) + b * ScaleFactor + END DO + END DO ENDDO DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Blade(i11)%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Blade(i11)%TranslationVel,1))) - b1 = -(u1%TurbineComponents%Blade(i11)%TranslationVel - u2%TurbineComponents%Blade(i11)%TranslationVel)/t(2) - u_out%TurbineComponents%Blade(i11)%TranslationVel = u1%TurbineComponents%Blade(i11)%TranslationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%TurbineComponents%Blade(i11)%TranslationVel,1),UBOUND(u_out%TurbineComponents%Blade(i11)%TranslationVel,1) + b = -(u1%TurbineComponents%Blade(i11)%TranslationVel(i1) - u2%TurbineComponents%Blade(i11)%TranslationVel(i1)) + u_out%TurbineComponents%Blade(i11)%TranslationVel(i1) = u1%TurbineComponents%Blade(i11)%TranslationVel(i1) + b * ScaleFactor + END DO ENDDO DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Blade(i11)%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Blade(i11)%RotationVel,1))) - b1 = -(u1%TurbineComponents%Blade(i11)%RotationVel - u2%TurbineComponents%Blade(i11)%RotationVel)/t(2) - u_out%TurbineComponents%Blade(i11)%RotationVel = u1%TurbineComponents%Blade(i11)%RotationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%TurbineComponents%Blade(i11)%RotationVel,1),UBOUND(u_out%TurbineComponents%Blade(i11)%RotationVel,1) + b = -(u1%TurbineComponents%Blade(i11)%RotationVel(i1) - u2%TurbineComponents%Blade(i11)%RotationVel(i1)) + u_out%TurbineComponents%Blade(i11)%RotationVel(i1) = u1%TurbineComponents%Blade(i11)%RotationVel(i1) + b * ScaleFactor + END DO ENDDO END IF ! check if allocated - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Hub%Position,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Hub%Position,1))) - b1 = -(u1%TurbineComponents%Hub%Position - u2%TurbineComponents%Hub%Position)/t(2) - u_out%TurbineComponents%Hub%Position = u1%TurbineComponents%Hub%Position + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b2(SIZE(u_out%TurbineComponents%Hub%Orientation,1),SIZE(u_out%TurbineComponents%Hub%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%TurbineComponents%Hub%Orientation,1),SIZE(u_out%TurbineComponents%Hub%Orientation,2) )) - b2 = -(u1%TurbineComponents%Hub%Orientation - u2%TurbineComponents%Hub%Orientation)/t(2) - u_out%TurbineComponents%Hub%Orientation = u1%TurbineComponents%Hub%Orientation + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Hub%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Hub%TranslationVel,1))) - b1 = -(u1%TurbineComponents%Hub%TranslationVel - u2%TurbineComponents%Hub%TranslationVel)/t(2) - u_out%TurbineComponents%Hub%TranslationVel = u1%TurbineComponents%Hub%TranslationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Hub%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Hub%RotationVel,1))) - b1 = -(u1%TurbineComponents%Hub%RotationVel - u2%TurbineComponents%Hub%RotationVel)/t(2) - u_out%TurbineComponents%Hub%RotationVel = u1%TurbineComponents%Hub%RotationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%RotorFurl%Position,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%RotorFurl%Position,1))) - b1 = -(u1%TurbineComponents%RotorFurl%Position - u2%TurbineComponents%RotorFurl%Position)/t(2) - u_out%TurbineComponents%RotorFurl%Position = u1%TurbineComponents%RotorFurl%Position + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b2(SIZE(u_out%TurbineComponents%RotorFurl%Orientation,1),SIZE(u_out%TurbineComponents%RotorFurl%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%TurbineComponents%RotorFurl%Orientation,1),SIZE(u_out%TurbineComponents%RotorFurl%Orientation,2) )) - b2 = -(u1%TurbineComponents%RotorFurl%Orientation - u2%TurbineComponents%RotorFurl%Orientation)/t(2) - u_out%TurbineComponents%RotorFurl%Orientation = u1%TurbineComponents%RotorFurl%Orientation + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%RotorFurl%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%RotorFurl%TranslationVel,1))) - b1 = -(u1%TurbineComponents%RotorFurl%TranslationVel - u2%TurbineComponents%RotorFurl%TranslationVel)/t(2) - u_out%TurbineComponents%RotorFurl%TranslationVel = u1%TurbineComponents%RotorFurl%TranslationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%RotorFurl%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%RotorFurl%RotationVel,1))) - b1 = -(u1%TurbineComponents%RotorFurl%RotationVel - u2%TurbineComponents%RotorFurl%RotationVel)/t(2) - u_out%TurbineComponents%RotorFurl%RotationVel = u1%TurbineComponents%RotorFurl%RotationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Nacelle%Position,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Nacelle%Position,1))) - b1 = -(u1%TurbineComponents%Nacelle%Position - u2%TurbineComponents%Nacelle%Position)/t(2) - u_out%TurbineComponents%Nacelle%Position = u1%TurbineComponents%Nacelle%Position + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b2(SIZE(u_out%TurbineComponents%Nacelle%Orientation,1),SIZE(u_out%TurbineComponents%Nacelle%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%TurbineComponents%Nacelle%Orientation,1),SIZE(u_out%TurbineComponents%Nacelle%Orientation,2) )) - b2 = -(u1%TurbineComponents%Nacelle%Orientation - u2%TurbineComponents%Nacelle%Orientation)/t(2) - u_out%TurbineComponents%Nacelle%Orientation = u1%TurbineComponents%Nacelle%Orientation + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Nacelle%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Nacelle%TranslationVel,1))) - b1 = -(u1%TurbineComponents%Nacelle%TranslationVel - u2%TurbineComponents%Nacelle%TranslationVel)/t(2) - u_out%TurbineComponents%Nacelle%TranslationVel = u1%TurbineComponents%Nacelle%TranslationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Nacelle%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Nacelle%RotationVel,1))) - b1 = -(u1%TurbineComponents%Nacelle%RotationVel - u2%TurbineComponents%Nacelle%RotationVel)/t(2) - u_out%TurbineComponents%Nacelle%RotationVel = u1%TurbineComponents%Nacelle%RotationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%TailFin%Position,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%TailFin%Position,1))) - b1 = -(u1%TurbineComponents%TailFin%Position - u2%TurbineComponents%TailFin%Position)/t(2) - u_out%TurbineComponents%TailFin%Position = u1%TurbineComponents%TailFin%Position + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b2(SIZE(u_out%TurbineComponents%TailFin%Orientation,1),SIZE(u_out%TurbineComponents%TailFin%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%TurbineComponents%TailFin%Orientation,1),SIZE(u_out%TurbineComponents%TailFin%Orientation,2) )) - b2 = -(u1%TurbineComponents%TailFin%Orientation - u2%TurbineComponents%TailFin%Orientation)/t(2) - u_out%TurbineComponents%TailFin%Orientation = u1%TurbineComponents%TailFin%Orientation + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%TailFin%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%TailFin%TranslationVel,1))) - b1 = -(u1%TurbineComponents%TailFin%TranslationVel - u2%TurbineComponents%TailFin%TranslationVel)/t(2) - u_out%TurbineComponents%TailFin%TranslationVel = u1%TurbineComponents%TailFin%TranslationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%TailFin%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%TailFin%RotationVel,1))) - b1 = -(u1%TurbineComponents%TailFin%RotationVel - u2%TurbineComponents%TailFin%RotationVel)/t(2) - u_out%TurbineComponents%TailFin%RotationVel = u1%TurbineComponents%TailFin%RotationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Tower%Position,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Tower%Position,1))) - b1 = -(u1%TurbineComponents%Tower%Position - u2%TurbineComponents%Tower%Position)/t(2) - u_out%TurbineComponents%Tower%Position = u1%TurbineComponents%Tower%Position + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b2(SIZE(u_out%TurbineComponents%Tower%Orientation,1),SIZE(u_out%TurbineComponents%Tower%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%TurbineComponents%Tower%Orientation,1),SIZE(u_out%TurbineComponents%Tower%Orientation,2) )) - b2 = -(u1%TurbineComponents%Tower%Orientation - u2%TurbineComponents%Tower%Orientation)/t(2) - u_out%TurbineComponents%Tower%Orientation = u1%TurbineComponents%Tower%Orientation + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Tower%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Tower%TranslationVel,1))) - b1 = -(u1%TurbineComponents%Tower%TranslationVel - u2%TurbineComponents%Tower%TranslationVel)/t(2) - u_out%TurbineComponents%Tower%TranslationVel = u1%TurbineComponents%Tower%TranslationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Tower%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Tower%RotationVel,1))) - b1 = -(u1%TurbineComponents%Tower%RotationVel - u2%TurbineComponents%Tower%RotationVel)/t(2) - u_out%TurbineComponents%Tower%RotationVel = u1%TurbineComponents%Tower%RotationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%SubStructure%Position,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%SubStructure%Position,1))) - b1 = -(u1%TurbineComponents%SubStructure%Position - u2%TurbineComponents%SubStructure%Position)/t(2) - u_out%TurbineComponents%SubStructure%Position = u1%TurbineComponents%SubStructure%Position + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b2(SIZE(u_out%TurbineComponents%SubStructure%Orientation,1),SIZE(u_out%TurbineComponents%SubStructure%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%TurbineComponents%SubStructure%Orientation,1),SIZE(u_out%TurbineComponents%SubStructure%Orientation,2) )) - b2 = -(u1%TurbineComponents%SubStructure%Orientation - u2%TurbineComponents%SubStructure%Orientation)/t(2) - u_out%TurbineComponents%SubStructure%Orientation = u1%TurbineComponents%SubStructure%Orientation + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%SubStructure%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%SubStructure%TranslationVel,1))) - b1 = -(u1%TurbineComponents%SubStructure%TranslationVel - u2%TurbineComponents%SubStructure%TranslationVel)/t(2) - u_out%TurbineComponents%SubStructure%TranslationVel = u1%TurbineComponents%SubStructure%TranslationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%SubStructure%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%SubStructure%RotationVel,1))) - b1 = -(u1%TurbineComponents%SubStructure%RotationVel - u2%TurbineComponents%SubStructure%RotationVel)/t(2) - u_out%TurbineComponents%SubStructure%RotationVel = u1%TurbineComponents%SubStructure%RotationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Foundation%Position,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Foundation%Position,1))) - b1 = -(u1%TurbineComponents%Foundation%Position - u2%TurbineComponents%Foundation%Position)/t(2) - u_out%TurbineComponents%Foundation%Position = u1%TurbineComponents%Foundation%Position + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b2(SIZE(u_out%TurbineComponents%Foundation%Orientation,1),SIZE(u_out%TurbineComponents%Foundation%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%TurbineComponents%Foundation%Orientation,1),SIZE(u_out%TurbineComponents%Foundation%Orientation,2) )) - b2 = -(u1%TurbineComponents%Foundation%Orientation - u2%TurbineComponents%Foundation%Orientation)/t(2) - u_out%TurbineComponents%Foundation%Orientation = u1%TurbineComponents%Foundation%Orientation + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Foundation%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Foundation%TranslationVel,1))) - b1 = -(u1%TurbineComponents%Foundation%TranslationVel - u2%TurbineComponents%Foundation%TranslationVel)/t(2) - u_out%TurbineComponents%Foundation%TranslationVel = u1%TurbineComponents%Foundation%TranslationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Foundation%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Foundation%RotationVel,1))) - b1 = -(u1%TurbineComponents%Foundation%RotationVel - u2%TurbineComponents%Foundation%RotationVel)/t(2) - u_out%TurbineComponents%Foundation%RotationVel = u1%TurbineComponents%Foundation%RotationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - b0 = -(u1%TurbineComponents%BladeLength - u2%TurbineComponents%BladeLength)/t(2) - u_out%TurbineComponents%BladeLength = u1%TurbineComponents%BladeLength + b0 * t_out + DO i1 = LBOUND(u_out%TurbineComponents%Hub%Position,1),UBOUND(u_out%TurbineComponents%Hub%Position,1) + b = -(u1%TurbineComponents%Hub%Position(i1) - u2%TurbineComponents%Hub%Position(i1)) + u_out%TurbineComponents%Hub%Position(i1) = u1%TurbineComponents%Hub%Position(i1) + b * ScaleFactor + END DO + DO i2 = LBOUND(u_out%TurbineComponents%Hub%Orientation,2),UBOUND(u_out%TurbineComponents%Hub%Orientation,2) + DO i1 = LBOUND(u_out%TurbineComponents%Hub%Orientation,1),UBOUND(u_out%TurbineComponents%Hub%Orientation,1) + b = -(u1%TurbineComponents%Hub%Orientation(i1,i2) - u2%TurbineComponents%Hub%Orientation(i1,i2)) + u_out%TurbineComponents%Hub%Orientation(i1,i2) = u1%TurbineComponents%Hub%Orientation(i1,i2) + b * ScaleFactor + END DO + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Hub%TranslationVel,1),UBOUND(u_out%TurbineComponents%Hub%TranslationVel,1) + b = -(u1%TurbineComponents%Hub%TranslationVel(i1) - u2%TurbineComponents%Hub%TranslationVel(i1)) + u_out%TurbineComponents%Hub%TranslationVel(i1) = u1%TurbineComponents%Hub%TranslationVel(i1) + b * ScaleFactor + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Hub%RotationVel,1),UBOUND(u_out%TurbineComponents%Hub%RotationVel,1) + b = -(u1%TurbineComponents%Hub%RotationVel(i1) - u2%TurbineComponents%Hub%RotationVel(i1)) + u_out%TurbineComponents%Hub%RotationVel(i1) = u1%TurbineComponents%Hub%RotationVel(i1) + b * ScaleFactor + END DO + DO i1 = LBOUND(u_out%TurbineComponents%RotorFurl%Position,1),UBOUND(u_out%TurbineComponents%RotorFurl%Position,1) + b = -(u1%TurbineComponents%RotorFurl%Position(i1) - u2%TurbineComponents%RotorFurl%Position(i1)) + u_out%TurbineComponents%RotorFurl%Position(i1) = u1%TurbineComponents%RotorFurl%Position(i1) + b * ScaleFactor + END DO + DO i2 = LBOUND(u_out%TurbineComponents%RotorFurl%Orientation,2),UBOUND(u_out%TurbineComponents%RotorFurl%Orientation,2) + DO i1 = LBOUND(u_out%TurbineComponents%RotorFurl%Orientation,1),UBOUND(u_out%TurbineComponents%RotorFurl%Orientation,1) + b = -(u1%TurbineComponents%RotorFurl%Orientation(i1,i2) - u2%TurbineComponents%RotorFurl%Orientation(i1,i2)) + u_out%TurbineComponents%RotorFurl%Orientation(i1,i2) = u1%TurbineComponents%RotorFurl%Orientation(i1,i2) + b * ScaleFactor + END DO + END DO + DO i1 = LBOUND(u_out%TurbineComponents%RotorFurl%TranslationVel,1),UBOUND(u_out%TurbineComponents%RotorFurl%TranslationVel,1) + b = -(u1%TurbineComponents%RotorFurl%TranslationVel(i1) - u2%TurbineComponents%RotorFurl%TranslationVel(i1)) + u_out%TurbineComponents%RotorFurl%TranslationVel(i1) = u1%TurbineComponents%RotorFurl%TranslationVel(i1) + b * ScaleFactor + END DO + DO i1 = LBOUND(u_out%TurbineComponents%RotorFurl%RotationVel,1),UBOUND(u_out%TurbineComponents%RotorFurl%RotationVel,1) + b = -(u1%TurbineComponents%RotorFurl%RotationVel(i1) - u2%TurbineComponents%RotorFurl%RotationVel(i1)) + u_out%TurbineComponents%RotorFurl%RotationVel(i1) = u1%TurbineComponents%RotorFurl%RotationVel(i1) + b * ScaleFactor + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Nacelle%Position,1),UBOUND(u_out%TurbineComponents%Nacelle%Position,1) + b = -(u1%TurbineComponents%Nacelle%Position(i1) - u2%TurbineComponents%Nacelle%Position(i1)) + u_out%TurbineComponents%Nacelle%Position(i1) = u1%TurbineComponents%Nacelle%Position(i1) + b * ScaleFactor + END DO + DO i2 = LBOUND(u_out%TurbineComponents%Nacelle%Orientation,2),UBOUND(u_out%TurbineComponents%Nacelle%Orientation,2) + DO i1 = LBOUND(u_out%TurbineComponents%Nacelle%Orientation,1),UBOUND(u_out%TurbineComponents%Nacelle%Orientation,1) + b = -(u1%TurbineComponents%Nacelle%Orientation(i1,i2) - u2%TurbineComponents%Nacelle%Orientation(i1,i2)) + u_out%TurbineComponents%Nacelle%Orientation(i1,i2) = u1%TurbineComponents%Nacelle%Orientation(i1,i2) + b * ScaleFactor + END DO + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Nacelle%TranslationVel,1),UBOUND(u_out%TurbineComponents%Nacelle%TranslationVel,1) + b = -(u1%TurbineComponents%Nacelle%TranslationVel(i1) - u2%TurbineComponents%Nacelle%TranslationVel(i1)) + u_out%TurbineComponents%Nacelle%TranslationVel(i1) = u1%TurbineComponents%Nacelle%TranslationVel(i1) + b * ScaleFactor + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Nacelle%RotationVel,1),UBOUND(u_out%TurbineComponents%Nacelle%RotationVel,1) + b = -(u1%TurbineComponents%Nacelle%RotationVel(i1) - u2%TurbineComponents%Nacelle%RotationVel(i1)) + u_out%TurbineComponents%Nacelle%RotationVel(i1) = u1%TurbineComponents%Nacelle%RotationVel(i1) + b * ScaleFactor + END DO + DO i1 = LBOUND(u_out%TurbineComponents%TailFin%Position,1),UBOUND(u_out%TurbineComponents%TailFin%Position,1) + b = -(u1%TurbineComponents%TailFin%Position(i1) - u2%TurbineComponents%TailFin%Position(i1)) + u_out%TurbineComponents%TailFin%Position(i1) = u1%TurbineComponents%TailFin%Position(i1) + b * ScaleFactor + END DO + DO i2 = LBOUND(u_out%TurbineComponents%TailFin%Orientation,2),UBOUND(u_out%TurbineComponents%TailFin%Orientation,2) + DO i1 = LBOUND(u_out%TurbineComponents%TailFin%Orientation,1),UBOUND(u_out%TurbineComponents%TailFin%Orientation,1) + b = -(u1%TurbineComponents%TailFin%Orientation(i1,i2) - u2%TurbineComponents%TailFin%Orientation(i1,i2)) + u_out%TurbineComponents%TailFin%Orientation(i1,i2) = u1%TurbineComponents%TailFin%Orientation(i1,i2) + b * ScaleFactor + END DO + END DO + DO i1 = LBOUND(u_out%TurbineComponents%TailFin%TranslationVel,1),UBOUND(u_out%TurbineComponents%TailFin%TranslationVel,1) + b = -(u1%TurbineComponents%TailFin%TranslationVel(i1) - u2%TurbineComponents%TailFin%TranslationVel(i1)) + u_out%TurbineComponents%TailFin%TranslationVel(i1) = u1%TurbineComponents%TailFin%TranslationVel(i1) + b * ScaleFactor + END DO + DO i1 = LBOUND(u_out%TurbineComponents%TailFin%RotationVel,1),UBOUND(u_out%TurbineComponents%TailFin%RotationVel,1) + b = -(u1%TurbineComponents%TailFin%RotationVel(i1) - u2%TurbineComponents%TailFin%RotationVel(i1)) + u_out%TurbineComponents%TailFin%RotationVel(i1) = u1%TurbineComponents%TailFin%RotationVel(i1) + b * ScaleFactor + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Tower%Position,1),UBOUND(u_out%TurbineComponents%Tower%Position,1) + b = -(u1%TurbineComponents%Tower%Position(i1) - u2%TurbineComponents%Tower%Position(i1)) + u_out%TurbineComponents%Tower%Position(i1) = u1%TurbineComponents%Tower%Position(i1) + b * ScaleFactor + END DO + DO i2 = LBOUND(u_out%TurbineComponents%Tower%Orientation,2),UBOUND(u_out%TurbineComponents%Tower%Orientation,2) + DO i1 = LBOUND(u_out%TurbineComponents%Tower%Orientation,1),UBOUND(u_out%TurbineComponents%Tower%Orientation,1) + b = -(u1%TurbineComponents%Tower%Orientation(i1,i2) - u2%TurbineComponents%Tower%Orientation(i1,i2)) + u_out%TurbineComponents%Tower%Orientation(i1,i2) = u1%TurbineComponents%Tower%Orientation(i1,i2) + b * ScaleFactor + END DO + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Tower%TranslationVel,1),UBOUND(u_out%TurbineComponents%Tower%TranslationVel,1) + b = -(u1%TurbineComponents%Tower%TranslationVel(i1) - u2%TurbineComponents%Tower%TranslationVel(i1)) + u_out%TurbineComponents%Tower%TranslationVel(i1) = u1%TurbineComponents%Tower%TranslationVel(i1) + b * ScaleFactor + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Tower%RotationVel,1),UBOUND(u_out%TurbineComponents%Tower%RotationVel,1) + b = -(u1%TurbineComponents%Tower%RotationVel(i1) - u2%TurbineComponents%Tower%RotationVel(i1)) + u_out%TurbineComponents%Tower%RotationVel(i1) = u1%TurbineComponents%Tower%RotationVel(i1) + b * ScaleFactor + END DO + DO i1 = LBOUND(u_out%TurbineComponents%SubStructure%Position,1),UBOUND(u_out%TurbineComponents%SubStructure%Position,1) + b = -(u1%TurbineComponents%SubStructure%Position(i1) - u2%TurbineComponents%SubStructure%Position(i1)) + u_out%TurbineComponents%SubStructure%Position(i1) = u1%TurbineComponents%SubStructure%Position(i1) + b * ScaleFactor + END DO + DO i2 = LBOUND(u_out%TurbineComponents%SubStructure%Orientation,2),UBOUND(u_out%TurbineComponents%SubStructure%Orientation,2) + DO i1 = LBOUND(u_out%TurbineComponents%SubStructure%Orientation,1),UBOUND(u_out%TurbineComponents%SubStructure%Orientation,1) + b = -(u1%TurbineComponents%SubStructure%Orientation(i1,i2) - u2%TurbineComponents%SubStructure%Orientation(i1,i2)) + u_out%TurbineComponents%SubStructure%Orientation(i1,i2) = u1%TurbineComponents%SubStructure%Orientation(i1,i2) + b * ScaleFactor + END DO + END DO + DO i1 = LBOUND(u_out%TurbineComponents%SubStructure%TranslationVel,1),UBOUND(u_out%TurbineComponents%SubStructure%TranslationVel,1) + b = -(u1%TurbineComponents%SubStructure%TranslationVel(i1) - u2%TurbineComponents%SubStructure%TranslationVel(i1)) + u_out%TurbineComponents%SubStructure%TranslationVel(i1) = u1%TurbineComponents%SubStructure%TranslationVel(i1) + b * ScaleFactor + END DO + DO i1 = LBOUND(u_out%TurbineComponents%SubStructure%RotationVel,1),UBOUND(u_out%TurbineComponents%SubStructure%RotationVel,1) + b = -(u1%TurbineComponents%SubStructure%RotationVel(i1) - u2%TurbineComponents%SubStructure%RotationVel(i1)) + u_out%TurbineComponents%SubStructure%RotationVel(i1) = u1%TurbineComponents%SubStructure%RotationVel(i1) + b * ScaleFactor + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Foundation%Position,1),UBOUND(u_out%TurbineComponents%Foundation%Position,1) + b = -(u1%TurbineComponents%Foundation%Position(i1) - u2%TurbineComponents%Foundation%Position(i1)) + u_out%TurbineComponents%Foundation%Position(i1) = u1%TurbineComponents%Foundation%Position(i1) + b * ScaleFactor + END DO + DO i2 = LBOUND(u_out%TurbineComponents%Foundation%Orientation,2),UBOUND(u_out%TurbineComponents%Foundation%Orientation,2) + DO i1 = LBOUND(u_out%TurbineComponents%Foundation%Orientation,1),UBOUND(u_out%TurbineComponents%Foundation%Orientation,1) + b = -(u1%TurbineComponents%Foundation%Orientation(i1,i2) - u2%TurbineComponents%Foundation%Orientation(i1,i2)) + u_out%TurbineComponents%Foundation%Orientation(i1,i2) = u1%TurbineComponents%Foundation%Orientation(i1,i2) + b * ScaleFactor + END DO + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Foundation%TranslationVel,1),UBOUND(u_out%TurbineComponents%Foundation%TranslationVel,1) + b = -(u1%TurbineComponents%Foundation%TranslationVel(i1) - u2%TurbineComponents%Foundation%TranslationVel(i1)) + u_out%TurbineComponents%Foundation%TranslationVel(i1) = u1%TurbineComponents%Foundation%TranslationVel(i1) + b * ScaleFactor + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Foundation%RotationVel,1),UBOUND(u_out%TurbineComponents%Foundation%RotationVel,1) + b = -(u1%TurbineComponents%Foundation%RotationVel(i1) - u2%TurbineComponents%Foundation%RotationVel(i1)) + u_out%TurbineComponents%Foundation%RotationVel(i1) = u1%TurbineComponents%Foundation%RotationVel(i1) + b * ScaleFactor + END DO + b = -(u1%TurbineComponents%BladeLength - u2%TurbineComponents%BladeLength) + u_out%TurbineComponents%BladeLength = u1%TurbineComponents%BladeLength + b * ScaleFactor IF (ALLOCATED(u_out%MulTabLoc) .AND. ALLOCATED(u1%MulTabLoc)) THEN - ALLOCATE(b2(SIZE(u_out%MulTabLoc,1),SIZE(u_out%MulTabLoc,2) )) - ALLOCATE(c2(SIZE(u_out%MulTabLoc,1),SIZE(u_out%MulTabLoc,2) )) - b2 = -(u1%MulTabLoc - u2%MulTabLoc)/t(2) - u_out%MulTabLoc = u1%MulTabLoc + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%MulTabLoc,2),UBOUND(u_out%MulTabLoc,2) + DO i1 = LBOUND(u_out%MulTabLoc,1),UBOUND(u_out%MulTabLoc,1) + b = -(u1%MulTabLoc(i1,i2) - u2%MulTabLoc(i1,i2)) + u_out%MulTabLoc(i1,i2) = u1%MulTabLoc(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated IF (ALLOCATED(u_out%InflowVelocity) .AND. ALLOCATED(u1%InflowVelocity)) THEN - ALLOCATE(b2(SIZE(u_out%InflowVelocity,1),SIZE(u_out%InflowVelocity,2) )) - ALLOCATE(c2(SIZE(u_out%InflowVelocity,1),SIZE(u_out%InflowVelocity,2) )) - b2 = -(u1%InflowVelocity - u2%InflowVelocity)/t(2) - u_out%InflowVelocity = u1%InflowVelocity + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%InflowVelocity,2),UBOUND(u_out%InflowVelocity,2) + DO i1 = LBOUND(u_out%InflowVelocity,1),UBOUND(u_out%InflowVelocity,1) + b = -(u1%InflowVelocity(i1,i2) - u2%InflowVelocity(i1,i2)) + u_out%InflowVelocity(i1,i2) = u1%InflowVelocity(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated - ALLOCATE(b1(SIZE(u_out%AvgInfVel,1))) - ALLOCATE(c1(SIZE(u_out%AvgInfVel,1))) - b1 = -(u1%AvgInfVel - u2%AvgInfVel)/t(2) - u_out%AvgInfVel = u1%AvgInfVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%AvgInfVel,1),UBOUND(u_out%AvgInfVel,1) + b = -(u1%AvgInfVel(i1) - u2%AvgInfVel(i1)) + u_out%AvgInfVel(i1) = u1%AvgInfVel(i1) + b * ScaleFactor + END DO END SUBROUTINE AD14_Input_ExtrapInterp1 @@ -16617,17 +16358,18 @@ SUBROUTINE AD14_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'AD14_Input_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 = "" @@ -16646,9 +16388,11 @@ SUBROUTINE AD14_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ALLOCATED(u_out%InputMarkers) .AND. ALLOCATED(u1%InputMarkers)) THEN - DO i01 = LBOUND(u_out%InputMarkers,1),UBOUND(u_out%InputMarkers,1) - CALL MeshExtrapInterp2(u1%InputMarkers(i01), u2%InputMarkers(i01), u3%InputMarkers(i01), tin, u_out%InputMarkers(i01), tin_out, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(u_out%InputMarkers,1),UBOUND(u_out%InputMarkers,1) + CALL MeshExtrapInterp2(u1%InputMarkers(i1), u2%InputMarkers(i1), u3%InputMarkers(i1), tin, u_out%InputMarkers(i1), tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) ENDDO END IF ! check if allocated @@ -16656,266 +16400,216 @@ SUBROUTINE AD14_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(u_out%TurbineComponents%Blade) .AND. ALLOCATED(u1%TurbineComponents%Blade)) THEN DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Blade(i11)%Position,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Blade(i11)%Position,1))) - b1 = (t(3)**2*(u1%TurbineComponents%Blade(i11)%Position - u2%TurbineComponents%Blade(i11)%Position) + t(2)**2*(-u1%TurbineComponents%Blade(i11)%Position + u3%TurbineComponents%Blade(i11)%Position))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%Blade(i11)%Position + t(3)*u2%TurbineComponents%Blade(i11)%Position - t(2)*u3%TurbineComponents%Blade(i11)%Position ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%Blade(i11)%Position = u1%TurbineComponents%Blade(i11)%Position + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%TurbineComponents%Blade(i11)%Position,1),UBOUND(u_out%TurbineComponents%Blade(i11)%Position,1) + b = (t(3)**2*(u1%TurbineComponents%Blade(i11)%Position(i1) - u2%TurbineComponents%Blade(i11)%Position(i1)) + t(2)**2*(-u1%TurbineComponents%Blade(i11)%Position(i1) + u3%TurbineComponents%Blade(i11)%Position(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%Blade(i11)%Position(i1) + t(3)*u2%TurbineComponents%Blade(i11)%Position(i1) - t(2)*u3%TurbineComponents%Blade(i11)%Position(i1) ) * scaleFactor + u_out%TurbineComponents%Blade(i11)%Position(i1) = u1%TurbineComponents%Blade(i11)%Position(i1) + b + c * t_out + END DO ENDDO DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) - ALLOCATE(b2(SIZE(u_out%TurbineComponents%Blade(i11)%Orientation,1),SIZE(u_out%TurbineComponents%Blade(i11)%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%TurbineComponents%Blade(i11)%Orientation,1),SIZE(u_out%TurbineComponents%Blade(i11)%Orientation,2) )) - b2 = (t(3)**2*(u1%TurbineComponents%Blade(i11)%Orientation - u2%TurbineComponents%Blade(i11)%Orientation) + t(2)**2*(-u1%TurbineComponents%Blade(i11)%Orientation + u3%TurbineComponents%Blade(i11)%Orientation))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%TurbineComponents%Blade(i11)%Orientation + t(3)*u2%TurbineComponents%Blade(i11)%Orientation - t(2)*u3%TurbineComponents%Blade(i11)%Orientation ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%Blade(i11)%Orientation = u1%TurbineComponents%Blade(i11)%Orientation + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%TurbineComponents%Blade(i11)%Orientation,2),UBOUND(u_out%TurbineComponents%Blade(i11)%Orientation,2) + DO i1 = LBOUND(u_out%TurbineComponents%Blade(i11)%Orientation,1),UBOUND(u_out%TurbineComponents%Blade(i11)%Orientation,1) + b = (t(3)**2*(u1%TurbineComponents%Blade(i11)%Orientation(i1,i2) - u2%TurbineComponents%Blade(i11)%Orientation(i1,i2)) + t(2)**2*(-u1%TurbineComponents%Blade(i11)%Orientation(i1,i2) + u3%TurbineComponents%Blade(i11)%Orientation(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%Blade(i11)%Orientation(i1,i2) + t(3)*u2%TurbineComponents%Blade(i11)%Orientation(i1,i2) - t(2)*u3%TurbineComponents%Blade(i11)%Orientation(i1,i2) ) * scaleFactor + u_out%TurbineComponents%Blade(i11)%Orientation(i1,i2) = u1%TurbineComponents%Blade(i11)%Orientation(i1,i2) + b + c * t_out + END DO + END DO ENDDO DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Blade(i11)%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Blade(i11)%TranslationVel,1))) - b1 = (t(3)**2*(u1%TurbineComponents%Blade(i11)%TranslationVel - u2%TurbineComponents%Blade(i11)%TranslationVel) + t(2)**2*(-u1%TurbineComponents%Blade(i11)%TranslationVel + u3%TurbineComponents%Blade(i11)%TranslationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%Blade(i11)%TranslationVel + t(3)*u2%TurbineComponents%Blade(i11)%TranslationVel - t(2)*u3%TurbineComponents%Blade(i11)%TranslationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%Blade(i11)%TranslationVel = u1%TurbineComponents%Blade(i11)%TranslationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%TurbineComponents%Blade(i11)%TranslationVel,1),UBOUND(u_out%TurbineComponents%Blade(i11)%TranslationVel,1) + b = (t(3)**2*(u1%TurbineComponents%Blade(i11)%TranslationVel(i1) - u2%TurbineComponents%Blade(i11)%TranslationVel(i1)) + t(2)**2*(-u1%TurbineComponents%Blade(i11)%TranslationVel(i1) + u3%TurbineComponents%Blade(i11)%TranslationVel(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%Blade(i11)%TranslationVel(i1) + t(3)*u2%TurbineComponents%Blade(i11)%TranslationVel(i1) - t(2)*u3%TurbineComponents%Blade(i11)%TranslationVel(i1) ) * scaleFactor + u_out%TurbineComponents%Blade(i11)%TranslationVel(i1) = u1%TurbineComponents%Blade(i11)%TranslationVel(i1) + b + c * t_out + END DO ENDDO DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Blade(i11)%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Blade(i11)%RotationVel,1))) - b1 = (t(3)**2*(u1%TurbineComponents%Blade(i11)%RotationVel - u2%TurbineComponents%Blade(i11)%RotationVel) + t(2)**2*(-u1%TurbineComponents%Blade(i11)%RotationVel + u3%TurbineComponents%Blade(i11)%RotationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%Blade(i11)%RotationVel + t(3)*u2%TurbineComponents%Blade(i11)%RotationVel - t(2)*u3%TurbineComponents%Blade(i11)%RotationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%Blade(i11)%RotationVel = u1%TurbineComponents%Blade(i11)%RotationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%TurbineComponents%Blade(i11)%RotationVel,1),UBOUND(u_out%TurbineComponents%Blade(i11)%RotationVel,1) + b = (t(3)**2*(u1%TurbineComponents%Blade(i11)%RotationVel(i1) - u2%TurbineComponents%Blade(i11)%RotationVel(i1)) + t(2)**2*(-u1%TurbineComponents%Blade(i11)%RotationVel(i1) + u3%TurbineComponents%Blade(i11)%RotationVel(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%Blade(i11)%RotationVel(i1) + t(3)*u2%TurbineComponents%Blade(i11)%RotationVel(i1) - t(2)*u3%TurbineComponents%Blade(i11)%RotationVel(i1) ) * scaleFactor + u_out%TurbineComponents%Blade(i11)%RotationVel(i1) = u1%TurbineComponents%Blade(i11)%RotationVel(i1) + b + c * t_out + END DO ENDDO END IF ! check if allocated - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Hub%Position,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Hub%Position,1))) - b1 = (t(3)**2*(u1%TurbineComponents%Hub%Position - u2%TurbineComponents%Hub%Position) + t(2)**2*(-u1%TurbineComponents%Hub%Position + u3%TurbineComponents%Hub%Position))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%Hub%Position + t(3)*u2%TurbineComponents%Hub%Position - t(2)*u3%TurbineComponents%Hub%Position ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%Hub%Position = u1%TurbineComponents%Hub%Position + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b2(SIZE(u_out%TurbineComponents%Hub%Orientation,1),SIZE(u_out%TurbineComponents%Hub%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%TurbineComponents%Hub%Orientation,1),SIZE(u_out%TurbineComponents%Hub%Orientation,2) )) - b2 = (t(3)**2*(u1%TurbineComponents%Hub%Orientation - u2%TurbineComponents%Hub%Orientation) + t(2)**2*(-u1%TurbineComponents%Hub%Orientation + u3%TurbineComponents%Hub%Orientation))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%TurbineComponents%Hub%Orientation + t(3)*u2%TurbineComponents%Hub%Orientation - t(2)*u3%TurbineComponents%Hub%Orientation ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%Hub%Orientation = u1%TurbineComponents%Hub%Orientation + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Hub%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Hub%TranslationVel,1))) - b1 = (t(3)**2*(u1%TurbineComponents%Hub%TranslationVel - u2%TurbineComponents%Hub%TranslationVel) + t(2)**2*(-u1%TurbineComponents%Hub%TranslationVel + u3%TurbineComponents%Hub%TranslationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%Hub%TranslationVel + t(3)*u2%TurbineComponents%Hub%TranslationVel - t(2)*u3%TurbineComponents%Hub%TranslationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%Hub%TranslationVel = u1%TurbineComponents%Hub%TranslationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Hub%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Hub%RotationVel,1))) - b1 = (t(3)**2*(u1%TurbineComponents%Hub%RotationVel - u2%TurbineComponents%Hub%RotationVel) + t(2)**2*(-u1%TurbineComponents%Hub%RotationVel + u3%TurbineComponents%Hub%RotationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%Hub%RotationVel + t(3)*u2%TurbineComponents%Hub%RotationVel - t(2)*u3%TurbineComponents%Hub%RotationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%Hub%RotationVel = u1%TurbineComponents%Hub%RotationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%RotorFurl%Position,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%RotorFurl%Position,1))) - b1 = (t(3)**2*(u1%TurbineComponents%RotorFurl%Position - u2%TurbineComponents%RotorFurl%Position) + t(2)**2*(-u1%TurbineComponents%RotorFurl%Position + u3%TurbineComponents%RotorFurl%Position))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%RotorFurl%Position + t(3)*u2%TurbineComponents%RotorFurl%Position - t(2)*u3%TurbineComponents%RotorFurl%Position ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%RotorFurl%Position = u1%TurbineComponents%RotorFurl%Position + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b2(SIZE(u_out%TurbineComponents%RotorFurl%Orientation,1),SIZE(u_out%TurbineComponents%RotorFurl%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%TurbineComponents%RotorFurl%Orientation,1),SIZE(u_out%TurbineComponents%RotorFurl%Orientation,2) )) - b2 = (t(3)**2*(u1%TurbineComponents%RotorFurl%Orientation - u2%TurbineComponents%RotorFurl%Orientation) + t(2)**2*(-u1%TurbineComponents%RotorFurl%Orientation + u3%TurbineComponents%RotorFurl%Orientation))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%TurbineComponents%RotorFurl%Orientation + t(3)*u2%TurbineComponents%RotorFurl%Orientation - t(2)*u3%TurbineComponents%RotorFurl%Orientation ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%RotorFurl%Orientation = u1%TurbineComponents%RotorFurl%Orientation + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%RotorFurl%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%RotorFurl%TranslationVel,1))) - b1 = (t(3)**2*(u1%TurbineComponents%RotorFurl%TranslationVel - u2%TurbineComponents%RotorFurl%TranslationVel) + t(2)**2*(-u1%TurbineComponents%RotorFurl%TranslationVel + u3%TurbineComponents%RotorFurl%TranslationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%RotorFurl%TranslationVel + t(3)*u2%TurbineComponents%RotorFurl%TranslationVel - t(2)*u3%TurbineComponents%RotorFurl%TranslationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%RotorFurl%TranslationVel = u1%TurbineComponents%RotorFurl%TranslationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%RotorFurl%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%RotorFurl%RotationVel,1))) - b1 = (t(3)**2*(u1%TurbineComponents%RotorFurl%RotationVel - u2%TurbineComponents%RotorFurl%RotationVel) + t(2)**2*(-u1%TurbineComponents%RotorFurl%RotationVel + u3%TurbineComponents%RotorFurl%RotationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%RotorFurl%RotationVel + t(3)*u2%TurbineComponents%RotorFurl%RotationVel - t(2)*u3%TurbineComponents%RotorFurl%RotationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%RotorFurl%RotationVel = u1%TurbineComponents%RotorFurl%RotationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Nacelle%Position,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Nacelle%Position,1))) - b1 = (t(3)**2*(u1%TurbineComponents%Nacelle%Position - u2%TurbineComponents%Nacelle%Position) + t(2)**2*(-u1%TurbineComponents%Nacelle%Position + u3%TurbineComponents%Nacelle%Position))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%Nacelle%Position + t(3)*u2%TurbineComponents%Nacelle%Position - t(2)*u3%TurbineComponents%Nacelle%Position ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%Nacelle%Position = u1%TurbineComponents%Nacelle%Position + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b2(SIZE(u_out%TurbineComponents%Nacelle%Orientation,1),SIZE(u_out%TurbineComponents%Nacelle%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%TurbineComponents%Nacelle%Orientation,1),SIZE(u_out%TurbineComponents%Nacelle%Orientation,2) )) - b2 = (t(3)**2*(u1%TurbineComponents%Nacelle%Orientation - u2%TurbineComponents%Nacelle%Orientation) + t(2)**2*(-u1%TurbineComponents%Nacelle%Orientation + u3%TurbineComponents%Nacelle%Orientation))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%TurbineComponents%Nacelle%Orientation + t(3)*u2%TurbineComponents%Nacelle%Orientation - t(2)*u3%TurbineComponents%Nacelle%Orientation ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%Nacelle%Orientation = u1%TurbineComponents%Nacelle%Orientation + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Nacelle%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Nacelle%TranslationVel,1))) - b1 = (t(3)**2*(u1%TurbineComponents%Nacelle%TranslationVel - u2%TurbineComponents%Nacelle%TranslationVel) + t(2)**2*(-u1%TurbineComponents%Nacelle%TranslationVel + u3%TurbineComponents%Nacelle%TranslationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%Nacelle%TranslationVel + t(3)*u2%TurbineComponents%Nacelle%TranslationVel - t(2)*u3%TurbineComponents%Nacelle%TranslationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%Nacelle%TranslationVel = u1%TurbineComponents%Nacelle%TranslationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Nacelle%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Nacelle%RotationVel,1))) - b1 = (t(3)**2*(u1%TurbineComponents%Nacelle%RotationVel - u2%TurbineComponents%Nacelle%RotationVel) + t(2)**2*(-u1%TurbineComponents%Nacelle%RotationVel + u3%TurbineComponents%Nacelle%RotationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%Nacelle%RotationVel + t(3)*u2%TurbineComponents%Nacelle%RotationVel - t(2)*u3%TurbineComponents%Nacelle%RotationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%Nacelle%RotationVel = u1%TurbineComponents%Nacelle%RotationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%TailFin%Position,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%TailFin%Position,1))) - b1 = (t(3)**2*(u1%TurbineComponents%TailFin%Position - u2%TurbineComponents%TailFin%Position) + t(2)**2*(-u1%TurbineComponents%TailFin%Position + u3%TurbineComponents%TailFin%Position))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%TailFin%Position + t(3)*u2%TurbineComponents%TailFin%Position - t(2)*u3%TurbineComponents%TailFin%Position ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%TailFin%Position = u1%TurbineComponents%TailFin%Position + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b2(SIZE(u_out%TurbineComponents%TailFin%Orientation,1),SIZE(u_out%TurbineComponents%TailFin%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%TurbineComponents%TailFin%Orientation,1),SIZE(u_out%TurbineComponents%TailFin%Orientation,2) )) - b2 = (t(3)**2*(u1%TurbineComponents%TailFin%Orientation - u2%TurbineComponents%TailFin%Orientation) + t(2)**2*(-u1%TurbineComponents%TailFin%Orientation + u3%TurbineComponents%TailFin%Orientation))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%TurbineComponents%TailFin%Orientation + t(3)*u2%TurbineComponents%TailFin%Orientation - t(2)*u3%TurbineComponents%TailFin%Orientation ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%TailFin%Orientation = u1%TurbineComponents%TailFin%Orientation + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%TailFin%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%TailFin%TranslationVel,1))) - b1 = (t(3)**2*(u1%TurbineComponents%TailFin%TranslationVel - u2%TurbineComponents%TailFin%TranslationVel) + t(2)**2*(-u1%TurbineComponents%TailFin%TranslationVel + u3%TurbineComponents%TailFin%TranslationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%TailFin%TranslationVel + t(3)*u2%TurbineComponents%TailFin%TranslationVel - t(2)*u3%TurbineComponents%TailFin%TranslationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%TailFin%TranslationVel = u1%TurbineComponents%TailFin%TranslationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%TailFin%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%TailFin%RotationVel,1))) - b1 = (t(3)**2*(u1%TurbineComponents%TailFin%RotationVel - u2%TurbineComponents%TailFin%RotationVel) + t(2)**2*(-u1%TurbineComponents%TailFin%RotationVel + u3%TurbineComponents%TailFin%RotationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%TailFin%RotationVel + t(3)*u2%TurbineComponents%TailFin%RotationVel - t(2)*u3%TurbineComponents%TailFin%RotationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%TailFin%RotationVel = u1%TurbineComponents%TailFin%RotationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Tower%Position,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Tower%Position,1))) - b1 = (t(3)**2*(u1%TurbineComponents%Tower%Position - u2%TurbineComponents%Tower%Position) + t(2)**2*(-u1%TurbineComponents%Tower%Position + u3%TurbineComponents%Tower%Position))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%Tower%Position + t(3)*u2%TurbineComponents%Tower%Position - t(2)*u3%TurbineComponents%Tower%Position ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%Tower%Position = u1%TurbineComponents%Tower%Position + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b2(SIZE(u_out%TurbineComponents%Tower%Orientation,1),SIZE(u_out%TurbineComponents%Tower%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%TurbineComponents%Tower%Orientation,1),SIZE(u_out%TurbineComponents%Tower%Orientation,2) )) - b2 = (t(3)**2*(u1%TurbineComponents%Tower%Orientation - u2%TurbineComponents%Tower%Orientation) + t(2)**2*(-u1%TurbineComponents%Tower%Orientation + u3%TurbineComponents%Tower%Orientation))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%TurbineComponents%Tower%Orientation + t(3)*u2%TurbineComponents%Tower%Orientation - t(2)*u3%TurbineComponents%Tower%Orientation ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%Tower%Orientation = u1%TurbineComponents%Tower%Orientation + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Tower%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Tower%TranslationVel,1))) - b1 = (t(3)**2*(u1%TurbineComponents%Tower%TranslationVel - u2%TurbineComponents%Tower%TranslationVel) + t(2)**2*(-u1%TurbineComponents%Tower%TranslationVel + u3%TurbineComponents%Tower%TranslationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%Tower%TranslationVel + t(3)*u2%TurbineComponents%Tower%TranslationVel - t(2)*u3%TurbineComponents%Tower%TranslationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%Tower%TranslationVel = u1%TurbineComponents%Tower%TranslationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Tower%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Tower%RotationVel,1))) - b1 = (t(3)**2*(u1%TurbineComponents%Tower%RotationVel - u2%TurbineComponents%Tower%RotationVel) + t(2)**2*(-u1%TurbineComponents%Tower%RotationVel + u3%TurbineComponents%Tower%RotationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%Tower%RotationVel + t(3)*u2%TurbineComponents%Tower%RotationVel - t(2)*u3%TurbineComponents%Tower%RotationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%Tower%RotationVel = u1%TurbineComponents%Tower%RotationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%SubStructure%Position,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%SubStructure%Position,1))) - b1 = (t(3)**2*(u1%TurbineComponents%SubStructure%Position - u2%TurbineComponents%SubStructure%Position) + t(2)**2*(-u1%TurbineComponents%SubStructure%Position + u3%TurbineComponents%SubStructure%Position))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%SubStructure%Position + t(3)*u2%TurbineComponents%SubStructure%Position - t(2)*u3%TurbineComponents%SubStructure%Position ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%SubStructure%Position = u1%TurbineComponents%SubStructure%Position + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b2(SIZE(u_out%TurbineComponents%SubStructure%Orientation,1),SIZE(u_out%TurbineComponents%SubStructure%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%TurbineComponents%SubStructure%Orientation,1),SIZE(u_out%TurbineComponents%SubStructure%Orientation,2) )) - b2 = (t(3)**2*(u1%TurbineComponents%SubStructure%Orientation - u2%TurbineComponents%SubStructure%Orientation) + t(2)**2*(-u1%TurbineComponents%SubStructure%Orientation + u3%TurbineComponents%SubStructure%Orientation))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%TurbineComponents%SubStructure%Orientation + t(3)*u2%TurbineComponents%SubStructure%Orientation - t(2)*u3%TurbineComponents%SubStructure%Orientation ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%SubStructure%Orientation = u1%TurbineComponents%SubStructure%Orientation + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%SubStructure%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%SubStructure%TranslationVel,1))) - b1 = (t(3)**2*(u1%TurbineComponents%SubStructure%TranslationVel - u2%TurbineComponents%SubStructure%TranslationVel) + t(2)**2*(-u1%TurbineComponents%SubStructure%TranslationVel + u3%TurbineComponents%SubStructure%TranslationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%SubStructure%TranslationVel + t(3)*u2%TurbineComponents%SubStructure%TranslationVel - t(2)*u3%TurbineComponents%SubStructure%TranslationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%SubStructure%TranslationVel = u1%TurbineComponents%SubStructure%TranslationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%SubStructure%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%SubStructure%RotationVel,1))) - b1 = (t(3)**2*(u1%TurbineComponents%SubStructure%RotationVel - u2%TurbineComponents%SubStructure%RotationVel) + t(2)**2*(-u1%TurbineComponents%SubStructure%RotationVel + u3%TurbineComponents%SubStructure%RotationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%SubStructure%RotationVel + t(3)*u2%TurbineComponents%SubStructure%RotationVel - t(2)*u3%TurbineComponents%SubStructure%RotationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%SubStructure%RotationVel = u1%TurbineComponents%SubStructure%RotationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Foundation%Position,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Foundation%Position,1))) - b1 = (t(3)**2*(u1%TurbineComponents%Foundation%Position - u2%TurbineComponents%Foundation%Position) + t(2)**2*(-u1%TurbineComponents%Foundation%Position + u3%TurbineComponents%Foundation%Position))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%Foundation%Position + t(3)*u2%TurbineComponents%Foundation%Position - t(2)*u3%TurbineComponents%Foundation%Position ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%Foundation%Position = u1%TurbineComponents%Foundation%Position + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b2(SIZE(u_out%TurbineComponents%Foundation%Orientation,1),SIZE(u_out%TurbineComponents%Foundation%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%TurbineComponents%Foundation%Orientation,1),SIZE(u_out%TurbineComponents%Foundation%Orientation,2) )) - b2 = (t(3)**2*(u1%TurbineComponents%Foundation%Orientation - u2%TurbineComponents%Foundation%Orientation) + t(2)**2*(-u1%TurbineComponents%Foundation%Orientation + u3%TurbineComponents%Foundation%Orientation))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%TurbineComponents%Foundation%Orientation + t(3)*u2%TurbineComponents%Foundation%Orientation - t(2)*u3%TurbineComponents%Foundation%Orientation ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%Foundation%Orientation = u1%TurbineComponents%Foundation%Orientation + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Foundation%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Foundation%TranslationVel,1))) - b1 = (t(3)**2*(u1%TurbineComponents%Foundation%TranslationVel - u2%TurbineComponents%Foundation%TranslationVel) + t(2)**2*(-u1%TurbineComponents%Foundation%TranslationVel + u3%TurbineComponents%Foundation%TranslationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%Foundation%TranslationVel + t(3)*u2%TurbineComponents%Foundation%TranslationVel - t(2)*u3%TurbineComponents%Foundation%TranslationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%Foundation%TranslationVel = u1%TurbineComponents%Foundation%TranslationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Foundation%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Foundation%RotationVel,1))) - b1 = (t(3)**2*(u1%TurbineComponents%Foundation%RotationVel - u2%TurbineComponents%Foundation%RotationVel) + t(2)**2*(-u1%TurbineComponents%Foundation%RotationVel + u3%TurbineComponents%Foundation%RotationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%Foundation%RotationVel + t(3)*u2%TurbineComponents%Foundation%RotationVel - t(2)*u3%TurbineComponents%Foundation%RotationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%Foundation%RotationVel = u1%TurbineComponents%Foundation%RotationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - b0 = (t(3)**2*(u1%TurbineComponents%BladeLength - u2%TurbineComponents%BladeLength) + t(2)**2*(-u1%TurbineComponents%BladeLength + u3%TurbineComponents%BladeLength))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%TurbineComponents%BladeLength + t(3)*u2%TurbineComponents%BladeLength - t(2)*u3%TurbineComponents%BladeLength ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%BladeLength = u1%TurbineComponents%BladeLength + b0 * t_out + c0 * t_out**2 + DO i1 = LBOUND(u_out%TurbineComponents%Hub%Position,1),UBOUND(u_out%TurbineComponents%Hub%Position,1) + b = (t(3)**2*(u1%TurbineComponents%Hub%Position(i1) - u2%TurbineComponents%Hub%Position(i1)) + t(2)**2*(-u1%TurbineComponents%Hub%Position(i1) + u3%TurbineComponents%Hub%Position(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%Hub%Position(i1) + t(3)*u2%TurbineComponents%Hub%Position(i1) - t(2)*u3%TurbineComponents%Hub%Position(i1) ) * scaleFactor + u_out%TurbineComponents%Hub%Position(i1) = u1%TurbineComponents%Hub%Position(i1) + b + c * t_out + END DO + DO i2 = LBOUND(u_out%TurbineComponents%Hub%Orientation,2),UBOUND(u_out%TurbineComponents%Hub%Orientation,2) + DO i1 = LBOUND(u_out%TurbineComponents%Hub%Orientation,1),UBOUND(u_out%TurbineComponents%Hub%Orientation,1) + b = (t(3)**2*(u1%TurbineComponents%Hub%Orientation(i1,i2) - u2%TurbineComponents%Hub%Orientation(i1,i2)) + t(2)**2*(-u1%TurbineComponents%Hub%Orientation(i1,i2) + u3%TurbineComponents%Hub%Orientation(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%Hub%Orientation(i1,i2) + t(3)*u2%TurbineComponents%Hub%Orientation(i1,i2) - t(2)*u3%TurbineComponents%Hub%Orientation(i1,i2) ) * scaleFactor + u_out%TurbineComponents%Hub%Orientation(i1,i2) = u1%TurbineComponents%Hub%Orientation(i1,i2) + b + c * t_out + END DO + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Hub%TranslationVel,1),UBOUND(u_out%TurbineComponents%Hub%TranslationVel,1) + b = (t(3)**2*(u1%TurbineComponents%Hub%TranslationVel(i1) - u2%TurbineComponents%Hub%TranslationVel(i1)) + t(2)**2*(-u1%TurbineComponents%Hub%TranslationVel(i1) + u3%TurbineComponents%Hub%TranslationVel(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%Hub%TranslationVel(i1) + t(3)*u2%TurbineComponents%Hub%TranslationVel(i1) - t(2)*u3%TurbineComponents%Hub%TranslationVel(i1) ) * scaleFactor + u_out%TurbineComponents%Hub%TranslationVel(i1) = u1%TurbineComponents%Hub%TranslationVel(i1) + b + c * t_out + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Hub%RotationVel,1),UBOUND(u_out%TurbineComponents%Hub%RotationVel,1) + b = (t(3)**2*(u1%TurbineComponents%Hub%RotationVel(i1) - u2%TurbineComponents%Hub%RotationVel(i1)) + t(2)**2*(-u1%TurbineComponents%Hub%RotationVel(i1) + u3%TurbineComponents%Hub%RotationVel(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%Hub%RotationVel(i1) + t(3)*u2%TurbineComponents%Hub%RotationVel(i1) - t(2)*u3%TurbineComponents%Hub%RotationVel(i1) ) * scaleFactor + u_out%TurbineComponents%Hub%RotationVel(i1) = u1%TurbineComponents%Hub%RotationVel(i1) + b + c * t_out + END DO + DO i1 = LBOUND(u_out%TurbineComponents%RotorFurl%Position,1),UBOUND(u_out%TurbineComponents%RotorFurl%Position,1) + b = (t(3)**2*(u1%TurbineComponents%RotorFurl%Position(i1) - u2%TurbineComponents%RotorFurl%Position(i1)) + t(2)**2*(-u1%TurbineComponents%RotorFurl%Position(i1) + u3%TurbineComponents%RotorFurl%Position(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%RotorFurl%Position(i1) + t(3)*u2%TurbineComponents%RotorFurl%Position(i1) - t(2)*u3%TurbineComponents%RotorFurl%Position(i1) ) * scaleFactor + u_out%TurbineComponents%RotorFurl%Position(i1) = u1%TurbineComponents%RotorFurl%Position(i1) + b + c * t_out + END DO + DO i2 = LBOUND(u_out%TurbineComponents%RotorFurl%Orientation,2),UBOUND(u_out%TurbineComponents%RotorFurl%Orientation,2) + DO i1 = LBOUND(u_out%TurbineComponents%RotorFurl%Orientation,1),UBOUND(u_out%TurbineComponents%RotorFurl%Orientation,1) + b = (t(3)**2*(u1%TurbineComponents%RotorFurl%Orientation(i1,i2) - u2%TurbineComponents%RotorFurl%Orientation(i1,i2)) + t(2)**2*(-u1%TurbineComponents%RotorFurl%Orientation(i1,i2) + u3%TurbineComponents%RotorFurl%Orientation(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%RotorFurl%Orientation(i1,i2) + t(3)*u2%TurbineComponents%RotorFurl%Orientation(i1,i2) - t(2)*u3%TurbineComponents%RotorFurl%Orientation(i1,i2) ) * scaleFactor + u_out%TurbineComponents%RotorFurl%Orientation(i1,i2) = u1%TurbineComponents%RotorFurl%Orientation(i1,i2) + b + c * t_out + END DO + END DO + DO i1 = LBOUND(u_out%TurbineComponents%RotorFurl%TranslationVel,1),UBOUND(u_out%TurbineComponents%RotorFurl%TranslationVel,1) + b = (t(3)**2*(u1%TurbineComponents%RotorFurl%TranslationVel(i1) - u2%TurbineComponents%RotorFurl%TranslationVel(i1)) + t(2)**2*(-u1%TurbineComponents%RotorFurl%TranslationVel(i1) + u3%TurbineComponents%RotorFurl%TranslationVel(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%RotorFurl%TranslationVel(i1) + t(3)*u2%TurbineComponents%RotorFurl%TranslationVel(i1) - t(2)*u3%TurbineComponents%RotorFurl%TranslationVel(i1) ) * scaleFactor + u_out%TurbineComponents%RotorFurl%TranslationVel(i1) = u1%TurbineComponents%RotorFurl%TranslationVel(i1) + b + c * t_out + END DO + DO i1 = LBOUND(u_out%TurbineComponents%RotorFurl%RotationVel,1),UBOUND(u_out%TurbineComponents%RotorFurl%RotationVel,1) + b = (t(3)**2*(u1%TurbineComponents%RotorFurl%RotationVel(i1) - u2%TurbineComponents%RotorFurl%RotationVel(i1)) + t(2)**2*(-u1%TurbineComponents%RotorFurl%RotationVel(i1) + u3%TurbineComponents%RotorFurl%RotationVel(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%RotorFurl%RotationVel(i1) + t(3)*u2%TurbineComponents%RotorFurl%RotationVel(i1) - t(2)*u3%TurbineComponents%RotorFurl%RotationVel(i1) ) * scaleFactor + u_out%TurbineComponents%RotorFurl%RotationVel(i1) = u1%TurbineComponents%RotorFurl%RotationVel(i1) + b + c * t_out + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Nacelle%Position,1),UBOUND(u_out%TurbineComponents%Nacelle%Position,1) + b = (t(3)**2*(u1%TurbineComponents%Nacelle%Position(i1) - u2%TurbineComponents%Nacelle%Position(i1)) + t(2)**2*(-u1%TurbineComponents%Nacelle%Position(i1) + u3%TurbineComponents%Nacelle%Position(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%Nacelle%Position(i1) + t(3)*u2%TurbineComponents%Nacelle%Position(i1) - t(2)*u3%TurbineComponents%Nacelle%Position(i1) ) * scaleFactor + u_out%TurbineComponents%Nacelle%Position(i1) = u1%TurbineComponents%Nacelle%Position(i1) + b + c * t_out + END DO + DO i2 = LBOUND(u_out%TurbineComponents%Nacelle%Orientation,2),UBOUND(u_out%TurbineComponents%Nacelle%Orientation,2) + DO i1 = LBOUND(u_out%TurbineComponents%Nacelle%Orientation,1),UBOUND(u_out%TurbineComponents%Nacelle%Orientation,1) + b = (t(3)**2*(u1%TurbineComponents%Nacelle%Orientation(i1,i2) - u2%TurbineComponents%Nacelle%Orientation(i1,i2)) + t(2)**2*(-u1%TurbineComponents%Nacelle%Orientation(i1,i2) + u3%TurbineComponents%Nacelle%Orientation(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%Nacelle%Orientation(i1,i2) + t(3)*u2%TurbineComponents%Nacelle%Orientation(i1,i2) - t(2)*u3%TurbineComponents%Nacelle%Orientation(i1,i2) ) * scaleFactor + u_out%TurbineComponents%Nacelle%Orientation(i1,i2) = u1%TurbineComponents%Nacelle%Orientation(i1,i2) + b + c * t_out + END DO + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Nacelle%TranslationVel,1),UBOUND(u_out%TurbineComponents%Nacelle%TranslationVel,1) + b = (t(3)**2*(u1%TurbineComponents%Nacelle%TranslationVel(i1) - u2%TurbineComponents%Nacelle%TranslationVel(i1)) + t(2)**2*(-u1%TurbineComponents%Nacelle%TranslationVel(i1) + u3%TurbineComponents%Nacelle%TranslationVel(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%Nacelle%TranslationVel(i1) + t(3)*u2%TurbineComponents%Nacelle%TranslationVel(i1) - t(2)*u3%TurbineComponents%Nacelle%TranslationVel(i1) ) * scaleFactor + u_out%TurbineComponents%Nacelle%TranslationVel(i1) = u1%TurbineComponents%Nacelle%TranslationVel(i1) + b + c * t_out + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Nacelle%RotationVel,1),UBOUND(u_out%TurbineComponents%Nacelle%RotationVel,1) + b = (t(3)**2*(u1%TurbineComponents%Nacelle%RotationVel(i1) - u2%TurbineComponents%Nacelle%RotationVel(i1)) + t(2)**2*(-u1%TurbineComponents%Nacelle%RotationVel(i1) + u3%TurbineComponents%Nacelle%RotationVel(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%Nacelle%RotationVel(i1) + t(3)*u2%TurbineComponents%Nacelle%RotationVel(i1) - t(2)*u3%TurbineComponents%Nacelle%RotationVel(i1) ) * scaleFactor + u_out%TurbineComponents%Nacelle%RotationVel(i1) = u1%TurbineComponents%Nacelle%RotationVel(i1) + b + c * t_out + END DO + DO i1 = LBOUND(u_out%TurbineComponents%TailFin%Position,1),UBOUND(u_out%TurbineComponents%TailFin%Position,1) + b = (t(3)**2*(u1%TurbineComponents%TailFin%Position(i1) - u2%TurbineComponents%TailFin%Position(i1)) + t(2)**2*(-u1%TurbineComponents%TailFin%Position(i1) + u3%TurbineComponents%TailFin%Position(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%TailFin%Position(i1) + t(3)*u2%TurbineComponents%TailFin%Position(i1) - t(2)*u3%TurbineComponents%TailFin%Position(i1) ) * scaleFactor + u_out%TurbineComponents%TailFin%Position(i1) = u1%TurbineComponents%TailFin%Position(i1) + b + c * t_out + END DO + DO i2 = LBOUND(u_out%TurbineComponents%TailFin%Orientation,2),UBOUND(u_out%TurbineComponents%TailFin%Orientation,2) + DO i1 = LBOUND(u_out%TurbineComponents%TailFin%Orientation,1),UBOUND(u_out%TurbineComponents%TailFin%Orientation,1) + b = (t(3)**2*(u1%TurbineComponents%TailFin%Orientation(i1,i2) - u2%TurbineComponents%TailFin%Orientation(i1,i2)) + t(2)**2*(-u1%TurbineComponents%TailFin%Orientation(i1,i2) + u3%TurbineComponents%TailFin%Orientation(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%TailFin%Orientation(i1,i2) + t(3)*u2%TurbineComponents%TailFin%Orientation(i1,i2) - t(2)*u3%TurbineComponents%TailFin%Orientation(i1,i2) ) * scaleFactor + u_out%TurbineComponents%TailFin%Orientation(i1,i2) = u1%TurbineComponents%TailFin%Orientation(i1,i2) + b + c * t_out + END DO + END DO + DO i1 = LBOUND(u_out%TurbineComponents%TailFin%TranslationVel,1),UBOUND(u_out%TurbineComponents%TailFin%TranslationVel,1) + b = (t(3)**2*(u1%TurbineComponents%TailFin%TranslationVel(i1) - u2%TurbineComponents%TailFin%TranslationVel(i1)) + t(2)**2*(-u1%TurbineComponents%TailFin%TranslationVel(i1) + u3%TurbineComponents%TailFin%TranslationVel(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%TailFin%TranslationVel(i1) + t(3)*u2%TurbineComponents%TailFin%TranslationVel(i1) - t(2)*u3%TurbineComponents%TailFin%TranslationVel(i1) ) * scaleFactor + u_out%TurbineComponents%TailFin%TranslationVel(i1) = u1%TurbineComponents%TailFin%TranslationVel(i1) + b + c * t_out + END DO + DO i1 = LBOUND(u_out%TurbineComponents%TailFin%RotationVel,1),UBOUND(u_out%TurbineComponents%TailFin%RotationVel,1) + b = (t(3)**2*(u1%TurbineComponents%TailFin%RotationVel(i1) - u2%TurbineComponents%TailFin%RotationVel(i1)) + t(2)**2*(-u1%TurbineComponents%TailFin%RotationVel(i1) + u3%TurbineComponents%TailFin%RotationVel(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%TailFin%RotationVel(i1) + t(3)*u2%TurbineComponents%TailFin%RotationVel(i1) - t(2)*u3%TurbineComponents%TailFin%RotationVel(i1) ) * scaleFactor + u_out%TurbineComponents%TailFin%RotationVel(i1) = u1%TurbineComponents%TailFin%RotationVel(i1) + b + c * t_out + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Tower%Position,1),UBOUND(u_out%TurbineComponents%Tower%Position,1) + b = (t(3)**2*(u1%TurbineComponents%Tower%Position(i1) - u2%TurbineComponents%Tower%Position(i1)) + t(2)**2*(-u1%TurbineComponents%Tower%Position(i1) + u3%TurbineComponents%Tower%Position(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%Tower%Position(i1) + t(3)*u2%TurbineComponents%Tower%Position(i1) - t(2)*u3%TurbineComponents%Tower%Position(i1) ) * scaleFactor + u_out%TurbineComponents%Tower%Position(i1) = u1%TurbineComponents%Tower%Position(i1) + b + c * t_out + END DO + DO i2 = LBOUND(u_out%TurbineComponents%Tower%Orientation,2),UBOUND(u_out%TurbineComponents%Tower%Orientation,2) + DO i1 = LBOUND(u_out%TurbineComponents%Tower%Orientation,1),UBOUND(u_out%TurbineComponents%Tower%Orientation,1) + b = (t(3)**2*(u1%TurbineComponents%Tower%Orientation(i1,i2) - u2%TurbineComponents%Tower%Orientation(i1,i2)) + t(2)**2*(-u1%TurbineComponents%Tower%Orientation(i1,i2) + u3%TurbineComponents%Tower%Orientation(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%Tower%Orientation(i1,i2) + t(3)*u2%TurbineComponents%Tower%Orientation(i1,i2) - t(2)*u3%TurbineComponents%Tower%Orientation(i1,i2) ) * scaleFactor + u_out%TurbineComponents%Tower%Orientation(i1,i2) = u1%TurbineComponents%Tower%Orientation(i1,i2) + b + c * t_out + END DO + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Tower%TranslationVel,1),UBOUND(u_out%TurbineComponents%Tower%TranslationVel,1) + b = (t(3)**2*(u1%TurbineComponents%Tower%TranslationVel(i1) - u2%TurbineComponents%Tower%TranslationVel(i1)) + t(2)**2*(-u1%TurbineComponents%Tower%TranslationVel(i1) + u3%TurbineComponents%Tower%TranslationVel(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%Tower%TranslationVel(i1) + t(3)*u2%TurbineComponents%Tower%TranslationVel(i1) - t(2)*u3%TurbineComponents%Tower%TranslationVel(i1) ) * scaleFactor + u_out%TurbineComponents%Tower%TranslationVel(i1) = u1%TurbineComponents%Tower%TranslationVel(i1) + b + c * t_out + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Tower%RotationVel,1),UBOUND(u_out%TurbineComponents%Tower%RotationVel,1) + b = (t(3)**2*(u1%TurbineComponents%Tower%RotationVel(i1) - u2%TurbineComponents%Tower%RotationVel(i1)) + t(2)**2*(-u1%TurbineComponents%Tower%RotationVel(i1) + u3%TurbineComponents%Tower%RotationVel(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%Tower%RotationVel(i1) + t(3)*u2%TurbineComponents%Tower%RotationVel(i1) - t(2)*u3%TurbineComponents%Tower%RotationVel(i1) ) * scaleFactor + u_out%TurbineComponents%Tower%RotationVel(i1) = u1%TurbineComponents%Tower%RotationVel(i1) + b + c * t_out + END DO + DO i1 = LBOUND(u_out%TurbineComponents%SubStructure%Position,1),UBOUND(u_out%TurbineComponents%SubStructure%Position,1) + b = (t(3)**2*(u1%TurbineComponents%SubStructure%Position(i1) - u2%TurbineComponents%SubStructure%Position(i1)) + t(2)**2*(-u1%TurbineComponents%SubStructure%Position(i1) + u3%TurbineComponents%SubStructure%Position(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%SubStructure%Position(i1) + t(3)*u2%TurbineComponents%SubStructure%Position(i1) - t(2)*u3%TurbineComponents%SubStructure%Position(i1) ) * scaleFactor + u_out%TurbineComponents%SubStructure%Position(i1) = u1%TurbineComponents%SubStructure%Position(i1) + b + c * t_out + END DO + DO i2 = LBOUND(u_out%TurbineComponents%SubStructure%Orientation,2),UBOUND(u_out%TurbineComponents%SubStructure%Orientation,2) + DO i1 = LBOUND(u_out%TurbineComponents%SubStructure%Orientation,1),UBOUND(u_out%TurbineComponents%SubStructure%Orientation,1) + b = (t(3)**2*(u1%TurbineComponents%SubStructure%Orientation(i1,i2) - u2%TurbineComponents%SubStructure%Orientation(i1,i2)) + t(2)**2*(-u1%TurbineComponents%SubStructure%Orientation(i1,i2) + u3%TurbineComponents%SubStructure%Orientation(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%SubStructure%Orientation(i1,i2) + t(3)*u2%TurbineComponents%SubStructure%Orientation(i1,i2) - t(2)*u3%TurbineComponents%SubStructure%Orientation(i1,i2) ) * scaleFactor + u_out%TurbineComponents%SubStructure%Orientation(i1,i2) = u1%TurbineComponents%SubStructure%Orientation(i1,i2) + b + c * t_out + END DO + END DO + DO i1 = LBOUND(u_out%TurbineComponents%SubStructure%TranslationVel,1),UBOUND(u_out%TurbineComponents%SubStructure%TranslationVel,1) + b = (t(3)**2*(u1%TurbineComponents%SubStructure%TranslationVel(i1) - u2%TurbineComponents%SubStructure%TranslationVel(i1)) + t(2)**2*(-u1%TurbineComponents%SubStructure%TranslationVel(i1) + u3%TurbineComponents%SubStructure%TranslationVel(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%SubStructure%TranslationVel(i1) + t(3)*u2%TurbineComponents%SubStructure%TranslationVel(i1) - t(2)*u3%TurbineComponents%SubStructure%TranslationVel(i1) ) * scaleFactor + u_out%TurbineComponents%SubStructure%TranslationVel(i1) = u1%TurbineComponents%SubStructure%TranslationVel(i1) + b + c * t_out + END DO + DO i1 = LBOUND(u_out%TurbineComponents%SubStructure%RotationVel,1),UBOUND(u_out%TurbineComponents%SubStructure%RotationVel,1) + b = (t(3)**2*(u1%TurbineComponents%SubStructure%RotationVel(i1) - u2%TurbineComponents%SubStructure%RotationVel(i1)) + t(2)**2*(-u1%TurbineComponents%SubStructure%RotationVel(i1) + u3%TurbineComponents%SubStructure%RotationVel(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%SubStructure%RotationVel(i1) + t(3)*u2%TurbineComponents%SubStructure%RotationVel(i1) - t(2)*u3%TurbineComponents%SubStructure%RotationVel(i1) ) * scaleFactor + u_out%TurbineComponents%SubStructure%RotationVel(i1) = u1%TurbineComponents%SubStructure%RotationVel(i1) + b + c * t_out + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Foundation%Position,1),UBOUND(u_out%TurbineComponents%Foundation%Position,1) + b = (t(3)**2*(u1%TurbineComponents%Foundation%Position(i1) - u2%TurbineComponents%Foundation%Position(i1)) + t(2)**2*(-u1%TurbineComponents%Foundation%Position(i1) + u3%TurbineComponents%Foundation%Position(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%Foundation%Position(i1) + t(3)*u2%TurbineComponents%Foundation%Position(i1) - t(2)*u3%TurbineComponents%Foundation%Position(i1) ) * scaleFactor + u_out%TurbineComponents%Foundation%Position(i1) = u1%TurbineComponents%Foundation%Position(i1) + b + c * t_out + END DO + DO i2 = LBOUND(u_out%TurbineComponents%Foundation%Orientation,2),UBOUND(u_out%TurbineComponents%Foundation%Orientation,2) + DO i1 = LBOUND(u_out%TurbineComponents%Foundation%Orientation,1),UBOUND(u_out%TurbineComponents%Foundation%Orientation,1) + b = (t(3)**2*(u1%TurbineComponents%Foundation%Orientation(i1,i2) - u2%TurbineComponents%Foundation%Orientation(i1,i2)) + t(2)**2*(-u1%TurbineComponents%Foundation%Orientation(i1,i2) + u3%TurbineComponents%Foundation%Orientation(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%Foundation%Orientation(i1,i2) + t(3)*u2%TurbineComponents%Foundation%Orientation(i1,i2) - t(2)*u3%TurbineComponents%Foundation%Orientation(i1,i2) ) * scaleFactor + u_out%TurbineComponents%Foundation%Orientation(i1,i2) = u1%TurbineComponents%Foundation%Orientation(i1,i2) + b + c * t_out + END DO + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Foundation%TranslationVel,1),UBOUND(u_out%TurbineComponents%Foundation%TranslationVel,1) + b = (t(3)**2*(u1%TurbineComponents%Foundation%TranslationVel(i1) - u2%TurbineComponents%Foundation%TranslationVel(i1)) + t(2)**2*(-u1%TurbineComponents%Foundation%TranslationVel(i1) + u3%TurbineComponents%Foundation%TranslationVel(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%Foundation%TranslationVel(i1) + t(3)*u2%TurbineComponents%Foundation%TranslationVel(i1) - t(2)*u3%TurbineComponents%Foundation%TranslationVel(i1) ) * scaleFactor + u_out%TurbineComponents%Foundation%TranslationVel(i1) = u1%TurbineComponents%Foundation%TranslationVel(i1) + b + c * t_out + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Foundation%RotationVel,1),UBOUND(u_out%TurbineComponents%Foundation%RotationVel,1) + b = (t(3)**2*(u1%TurbineComponents%Foundation%RotationVel(i1) - u2%TurbineComponents%Foundation%RotationVel(i1)) + t(2)**2*(-u1%TurbineComponents%Foundation%RotationVel(i1) + u3%TurbineComponents%Foundation%RotationVel(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%Foundation%RotationVel(i1) + t(3)*u2%TurbineComponents%Foundation%RotationVel(i1) - t(2)*u3%TurbineComponents%Foundation%RotationVel(i1) ) * scaleFactor + u_out%TurbineComponents%Foundation%RotationVel(i1) = u1%TurbineComponents%Foundation%RotationVel(i1) + b + c * t_out + END DO + b = (t(3)**2*(u1%TurbineComponents%BladeLength - u2%TurbineComponents%BladeLength) + t(2)**2*(-u1%TurbineComponents%BladeLength + u3%TurbineComponents%BladeLength))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%BladeLength + t(3)*u2%TurbineComponents%BladeLength - t(2)*u3%TurbineComponents%BladeLength ) * scaleFactor + u_out%TurbineComponents%BladeLength = u1%TurbineComponents%BladeLength + b + c * t_out IF (ALLOCATED(u_out%MulTabLoc) .AND. ALLOCATED(u1%MulTabLoc)) THEN - ALLOCATE(b2(SIZE(u_out%MulTabLoc,1),SIZE(u_out%MulTabLoc,2) )) - ALLOCATE(c2(SIZE(u_out%MulTabLoc,1),SIZE(u_out%MulTabLoc,2) )) - b2 = (t(3)**2*(u1%MulTabLoc - u2%MulTabLoc) + t(2)**2*(-u1%MulTabLoc + u3%MulTabLoc))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%MulTabLoc + t(3)*u2%MulTabLoc - t(2)*u3%MulTabLoc ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%MulTabLoc = u1%MulTabLoc + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%MulTabLoc,2),UBOUND(u_out%MulTabLoc,2) + DO i1 = LBOUND(u_out%MulTabLoc,1),UBOUND(u_out%MulTabLoc,1) + b = (t(3)**2*(u1%MulTabLoc(i1,i2) - u2%MulTabLoc(i1,i2)) + t(2)**2*(-u1%MulTabLoc(i1,i2) + u3%MulTabLoc(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%MulTabLoc(i1,i2) + t(3)*u2%MulTabLoc(i1,i2) - t(2)*u3%MulTabLoc(i1,i2) ) * scaleFactor + u_out%MulTabLoc(i1,i2) = u1%MulTabLoc(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated IF (ALLOCATED(u_out%InflowVelocity) .AND. ALLOCATED(u1%InflowVelocity)) THEN - ALLOCATE(b2(SIZE(u_out%InflowVelocity,1),SIZE(u_out%InflowVelocity,2) )) - ALLOCATE(c2(SIZE(u_out%InflowVelocity,1),SIZE(u_out%InflowVelocity,2) )) - b2 = (t(3)**2*(u1%InflowVelocity - u2%InflowVelocity) + t(2)**2*(-u1%InflowVelocity + u3%InflowVelocity))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%InflowVelocity + t(3)*u2%InflowVelocity - t(2)*u3%InflowVelocity ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%InflowVelocity = u1%InflowVelocity + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%InflowVelocity,2),UBOUND(u_out%InflowVelocity,2) + DO i1 = LBOUND(u_out%InflowVelocity,1),UBOUND(u_out%InflowVelocity,1) + b = (t(3)**2*(u1%InflowVelocity(i1,i2) - u2%InflowVelocity(i1,i2)) + t(2)**2*(-u1%InflowVelocity(i1,i2) + u3%InflowVelocity(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%InflowVelocity(i1,i2) + t(3)*u2%InflowVelocity(i1,i2) - t(2)*u3%InflowVelocity(i1,i2) ) * scaleFactor + u_out%InflowVelocity(i1,i2) = u1%InflowVelocity(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated - ALLOCATE(b1(SIZE(u_out%AvgInfVel,1))) - ALLOCATE(c1(SIZE(u_out%AvgInfVel,1))) - b1 = (t(3)**2*(u1%AvgInfVel - u2%AvgInfVel) + t(2)**2*(-u1%AvgInfVel + u3%AvgInfVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%AvgInfVel + t(3)*u2%AvgInfVel - t(2)*u3%AvgInfVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%AvgInfVel = u1%AvgInfVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%AvgInfVel,1),UBOUND(u_out%AvgInfVel,1) + b = (t(3)**2*(u1%AvgInfVel(i1) - u2%AvgInfVel(i1)) + t(2)**2*(-u1%AvgInfVel(i1) + u3%AvgInfVel(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%AvgInfVel(i1) + t(3)*u2%AvgInfVel(i1) - t(2)*u3%AvgInfVel(i1) ) * scaleFactor + u_out%AvgInfVel(i1) = u1%AvgInfVel(i1) + b + c * t_out + END DO END SUBROUTINE AD14_Input_ExtrapInterp2 @@ -16993,11 +16687,12 @@ SUBROUTINE AD14_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'AD14_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! 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 :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -17010,9 +16705,11 @@ SUBROUTINE AD14_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ALLOCATED(y_out%OutputLoads) .AND. ALLOCATED(y1%OutputLoads)) THEN - DO i01 = LBOUND(y_out%OutputLoads,1),UBOUND(y_out%OutputLoads,1) - CALL MeshExtrapInterp1(y1%OutputLoads(i01), y2%OutputLoads(i01), tin, y_out%OutputLoads(i01), tin_out, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(y_out%OutputLoads,1),UBOUND(y_out%OutputLoads,1) + CALL MeshExtrapInterp1(y1%OutputLoads(i1), y2%OutputLoads(i1), tin, y_out%OutputLoads(i1), tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) ENDDO END IF ! check if allocated @@ -17047,12 +16744,14 @@ SUBROUTINE AD14_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'AD14_Output_ExtrapInterp2' INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -17071,9 +16770,11 @@ SUBROUTINE AD14_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ALLOCATED(y_out%OutputLoads) .AND. ALLOCATED(y1%OutputLoads)) THEN - DO i01 = LBOUND(y_out%OutputLoads,1),UBOUND(y_out%OutputLoads,1) - CALL MeshExtrapInterp2(y1%OutputLoads(i01), y2%OutputLoads(i01), y3%OutputLoads(i01), tin, y_out%OutputLoads(i01), tin_out, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(y_out%OutputLoads,1),UBOUND(y_out%OutputLoads,1) + CALL MeshExtrapInterp2(y1%OutputLoads(i1), y2%OutputLoads(i1), y3%OutputLoads(i1), tin, y_out%OutputLoads(i1), tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) ENDDO END IF ! check if allocated diff --git a/modules/aerodyn14/src/DWM_Types.f90 b/modules/aerodyn14/src/DWM_Types.f90 index f18608cc83..0678240e6c 100644 --- a/modules/aerodyn14/src/DWM_Types.f90 +++ b/modules/aerodyn14/src/DWM_Types.f90 @@ -432,12 +432,12 @@ SUBROUTINE DWM_PackCVSD( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%counter - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Denominator - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Numerator - Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%counter + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Denominator + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Numerator + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DWM_PackCVSD SUBROUTINE DWM_UnPackCVSD( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -453,12 +453,6 @@ SUBROUTINE DWM_UnPackCVSD( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -476,12 +470,12 @@ SUBROUTINE DWM_UnPackCVSD( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%counter = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%Denominator = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Numerator = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%counter = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Denominator = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Numerator = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DWM_UnPackCVSD SUBROUTINE DWM_Copyturbine_average_velocity_data( Srcturbine_average_velocity_dataData, Dstturbine_average_velocity_dataData, CtrlCode, ErrStat, ErrMsg ) @@ -670,8 +664,10 @@ SUBROUTINE DWM_Packturbine_average_velocity_data( ReKiBuf, DbKiBuf, IntKiBuf, In IntKiBuf( Int_Xferred + 1) = UBOUND(InData%average_velocity_array_temp,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%average_velocity_array_temp)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%average_velocity_array_temp))-1 ) = PACK(InData%average_velocity_array_temp,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%average_velocity_array_temp) + DO i1 = LBOUND(InData%average_velocity_array_temp,1), UBOUND(InData%average_velocity_array_temp,1) + ReKiBuf(Re_Xferred) = InData%average_velocity_array_temp(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%average_velocity_array) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -683,8 +679,10 @@ SUBROUTINE DWM_Packturbine_average_velocity_data( ReKiBuf, DbKiBuf, IntKiBuf, In IntKiBuf( Int_Xferred + 1) = UBOUND(InData%average_velocity_array,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%average_velocity_array)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%average_velocity_array))-1 ) = PACK(InData%average_velocity_array,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%average_velocity_array) + DO i1 = LBOUND(InData%average_velocity_array,1), UBOUND(InData%average_velocity_array,1) + ReKiBuf(Re_Xferred) = InData%average_velocity_array(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%swept_area) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -696,11 +694,13 @@ SUBROUTINE DWM_Packturbine_average_velocity_data( ReKiBuf, DbKiBuf, IntKiBuf, In IntKiBuf( Int_Xferred + 1) = UBOUND(InData%swept_area,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%swept_area)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%swept_area))-1 ) = PACK(InData%swept_area,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%swept_area) + DO i1 = LBOUND(InData%swept_area,1), UBOUND(InData%swept_area,1) + ReKiBuf(Re_Xferred) = InData%swept_area(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%time_step_velocity - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%time_step_velocity + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%time_step_velocity_array) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -711,13 +711,15 @@ SUBROUTINE DWM_Packturbine_average_velocity_data( ReKiBuf, DbKiBuf, IntKiBuf, In IntKiBuf( Int_Xferred + 1) = UBOUND(InData%time_step_velocity_array,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%time_step_velocity_array)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%time_step_velocity_array))-1 ) = PACK(InData%time_step_velocity_array,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%time_step_velocity_array) + DO i1 = LBOUND(InData%time_step_velocity_array,1), UBOUND(InData%time_step_velocity_array,1) + IntKiBuf(Int_Xferred) = InData%time_step_velocity_array(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%time_step_pass_velocity - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%time_step_force - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%time_step_pass_velocity + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%time_step_force + Int_Xferred = Int_Xferred + 1 END SUBROUTINE DWM_Packturbine_average_velocity_data SUBROUTINE DWM_UnPackturbine_average_velocity_data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -733,12 +735,6 @@ SUBROUTINE DWM_UnPackturbine_average_velocity_data( ReKiBuf, DbKiBuf, IntKiBuf, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -766,15 +762,10 @@ SUBROUTINE DWM_UnPackturbine_average_velocity_data( ReKiBuf, DbKiBuf, IntKiBuf, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%average_velocity_array_temp.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%average_velocity_array_temp)>0) OutData%average_velocity_array_temp = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%average_velocity_array_temp))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%average_velocity_array_temp) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%average_velocity_array_temp,1), UBOUND(OutData%average_velocity_array_temp,1) + OutData%average_velocity_array_temp(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! average_velocity_array not allocated Int_Xferred = Int_Xferred + 1 @@ -789,15 +780,10 @@ SUBROUTINE DWM_UnPackturbine_average_velocity_data( ReKiBuf, DbKiBuf, IntKiBuf, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%average_velocity_array.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%average_velocity_array)>0) OutData%average_velocity_array = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%average_velocity_array))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%average_velocity_array) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%average_velocity_array,1), UBOUND(OutData%average_velocity_array,1) + OutData%average_velocity_array(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! swept_area not allocated Int_Xferred = Int_Xferred + 1 @@ -812,18 +798,13 @@ SUBROUTINE DWM_UnPackturbine_average_velocity_data( ReKiBuf, DbKiBuf, IntKiBuf, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%swept_area.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%swept_area)>0) OutData%swept_area = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%swept_area))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%swept_area) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%swept_area,1), UBOUND(OutData%swept_area,1) + OutData%swept_area(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%time_step_velocity = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%time_step_velocity = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! time_step_velocity_array not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -837,20 +818,15 @@ SUBROUTINE DWM_UnPackturbine_average_velocity_data( ReKiBuf, DbKiBuf, IntKiBuf, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%time_step_velocity_array.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%time_step_velocity_array)>0) OutData%time_step_velocity_array = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%time_step_velocity_array))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%time_step_velocity_array) - DEALLOCATE(mask1) - END IF - OutData%time_step_pass_velocity = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%time_step_force = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%time_step_velocity_array,1), UBOUND(OutData%time_step_velocity_array,1) + OutData%time_step_velocity_array(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + OutData%time_step_pass_velocity = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%time_step_force = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE DWM_UnPackturbine_average_velocity_data SUBROUTINE DWM_CopyWake_Deficit_Data( SrcWake_Deficit_DataData, DstWake_Deficit_DataData, CtrlCode, ErrStat, ErrMsg ) @@ -976,10 +952,10 @@ SUBROUTINE DWM_PackWake_Deficit_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%np_x - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%X_length - Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%np_x + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%X_length + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%Turb_Stress_DWM) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -993,15 +969,19 @@ SUBROUTINE DWM_PackWake_Deficit_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Turb_Stress_DWM,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Turb_Stress_DWM)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Turb_Stress_DWM))-1 ) = PACK(InData%Turb_Stress_DWM,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Turb_Stress_DWM) + DO i2 = LBOUND(InData%Turb_Stress_DWM,2), UBOUND(InData%Turb_Stress_DWM,2) + DO i1 = LBOUND(InData%Turb_Stress_DWM,1), UBOUND(InData%Turb_Stress_DWM,1) + ReKiBuf(Re_Xferred) = InData%Turb_Stress_DWM(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%n_x_vector - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%n_r_vector - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ppR - Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%n_x_vector + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%n_r_vector + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ppR + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DWM_PackWake_Deficit_Data SUBROUTINE DWM_UnPackWake_Deficit_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1017,12 +997,6 @@ SUBROUTINE DWM_UnPackWake_Deficit_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -1038,10 +1012,10 @@ SUBROUTINE DWM_UnPackWake_Deficit_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%np_x = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%X_length = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%np_x = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%X_length = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Turb_Stress_DWM not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1058,22 +1032,19 @@ SUBROUTINE DWM_UnPackWake_Deficit_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Turb_Stress_DWM.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Turb_Stress_DWM)>0) OutData%Turb_Stress_DWM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Turb_Stress_DWM))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Turb_Stress_DWM) - DEALLOCATE(mask2) - END IF - OutData%n_x_vector = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%n_r_vector = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ppR = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(OutData%Turb_Stress_DWM,2), UBOUND(OutData%Turb_Stress_DWM,2) + DO i1 = LBOUND(OutData%Turb_Stress_DWM,1), UBOUND(OutData%Turb_Stress_DWM,1) + OutData%Turb_Stress_DWM(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%n_x_vector = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%n_r_vector = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ppR = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DWM_UnPackWake_Deficit_Data SUBROUTINE DWM_CopyMeanderData( SrcMeanderDataData, DstMeanderDataData, CtrlCode, ErrStat, ErrMsg ) @@ -1169,10 +1140,10 @@ SUBROUTINE DWM_PackMeanderData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%scale_factor - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%moving_time - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%scale_factor + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%moving_time + Int_Xferred = Int_Xferred + 1 END SUBROUTINE DWM_PackMeanderData SUBROUTINE DWM_UnPackMeanderData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1188,12 +1159,6 @@ SUBROUTINE DWM_UnPackMeanderData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DWM_UnPackMeanderData' @@ -1207,10 +1172,10 @@ SUBROUTINE DWM_UnPackMeanderData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%scale_factor = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%moving_time = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%scale_factor = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%moving_time = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE DWM_UnPackMeanderData SUBROUTINE DWM_Copyread_turbine_position_data( Srcread_turbine_position_dataData, Dstread_turbine_position_dataData, CtrlCode, ErrStat, ErrMsg ) @@ -1636,8 +1601,8 @@ SUBROUTINE DWM_Packread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Indat Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%SimulationOrder_index - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%SimulationOrder_index + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%Turbine_sort_order) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1648,11 +1613,13 @@ SUBROUTINE DWM_Packread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Indat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Turbine_sort_order,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Turbine_sort_order)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%Turbine_sort_order))-1 ) = PACK(InData%Turbine_sort_order,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%Turbine_sort_order) + DO i1 = LBOUND(InData%Turbine_sort_order,1), UBOUND(InData%Turbine_sort_order,1) + IntKiBuf(Int_Xferred) = InData%Turbine_sort_order(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WT_index - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WT_index + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%TurbineInfluenceData) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1666,8 +1633,12 @@ SUBROUTINE DWM_Packread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Indat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TurbineInfluenceData,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TurbineInfluenceData)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%TurbineInfluenceData))-1 ) = PACK(InData%TurbineInfluenceData,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%TurbineInfluenceData) + DO i2 = LBOUND(InData%TurbineInfluenceData,2), UBOUND(InData%TurbineInfluenceData,2) + DO i1 = LBOUND(InData%TurbineInfluenceData,1), UBOUND(InData%TurbineInfluenceData,1) + IntKiBuf(Int_Xferred) = InData%TurbineInfluenceData(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%upwind_turbine_index) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1679,8 +1650,10 @@ SUBROUTINE DWM_Packread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Indat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_turbine_index,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%upwind_turbine_index)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%upwind_turbine_index))-1 ) = PACK(InData%upwind_turbine_index,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%upwind_turbine_index) + DO i1 = LBOUND(InData%upwind_turbine_index,1), UBOUND(InData%upwind_turbine_index,1) + IntKiBuf(Int_Xferred) = InData%upwind_turbine_index(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%downwind_turbine_index) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1692,13 +1665,15 @@ SUBROUTINE DWM_Packread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Indat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%downwind_turbine_index,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%downwind_turbine_index)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%downwind_turbine_index))-1 ) = PACK(InData%downwind_turbine_index,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%downwind_turbine_index) + DO i1 = LBOUND(InData%downwind_turbine_index,1), UBOUND(InData%downwind_turbine_index,1) + IntKiBuf(Int_Xferred) = InData%downwind_turbine_index(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%upwindturbine_number - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%downwindturbine_number - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%upwindturbine_number + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%downwindturbine_number + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%turbine_windorigin_length) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1709,8 +1684,10 @@ SUBROUTINE DWM_Packread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Indat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%turbine_windorigin_length,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%turbine_windorigin_length)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%turbine_windorigin_length))-1 ) = PACK(InData%turbine_windorigin_length,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%turbine_windorigin_length) + DO i1 = LBOUND(InData%turbine_windorigin_length,1), UBOUND(InData%turbine_windorigin_length,1) + ReKiBuf(Re_Xferred) = InData%turbine_windorigin_length(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%upwind_turbine_projected_distance) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1722,8 +1699,10 @@ SUBROUTINE DWM_Packread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Indat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_turbine_projected_distance,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%upwind_turbine_projected_distance)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%upwind_turbine_projected_distance))-1 ) = PACK(InData%upwind_turbine_projected_distance,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%upwind_turbine_projected_distance) + DO i1 = LBOUND(InData%upwind_turbine_projected_distance,1), UBOUND(InData%upwind_turbine_projected_distance,1) + ReKiBuf(Re_Xferred) = InData%upwind_turbine_projected_distance(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%downwind_turbine_projected_distance) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1735,8 +1714,10 @@ SUBROUTINE DWM_Packread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Indat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%downwind_turbine_projected_distance,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%downwind_turbine_projected_distance)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%downwind_turbine_projected_distance))-1 ) = PACK(InData%downwind_turbine_projected_distance,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%downwind_turbine_projected_distance) + DO i1 = LBOUND(InData%downwind_turbine_projected_distance,1), UBOUND(InData%downwind_turbine_projected_distance,1) + ReKiBuf(Re_Xferred) = InData%downwind_turbine_projected_distance(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%turbine_angle) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1751,8 +1732,12 @@ SUBROUTINE DWM_Packread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Indat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%turbine_angle,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%turbine_angle)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%turbine_angle))-1 ) = PACK(InData%turbine_angle,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%turbine_angle) + DO i2 = LBOUND(InData%turbine_angle,2), UBOUND(InData%turbine_angle,2) + DO i1 = LBOUND(InData%turbine_angle,1), UBOUND(InData%turbine_angle,1) + ReKiBuf(Re_Xferred) = InData%turbine_angle(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%upwind_align_angle) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1764,8 +1749,10 @@ SUBROUTINE DWM_Packread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Indat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_align_angle,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%upwind_align_angle)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%upwind_align_angle))-1 ) = PACK(InData%upwind_align_angle,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%upwind_align_angle) + DO i1 = LBOUND(InData%upwind_align_angle,1), UBOUND(InData%upwind_align_angle,1) + ReKiBuf(Re_Xferred) = InData%upwind_align_angle(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%downwind_align_angle) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1777,8 +1764,10 @@ SUBROUTINE DWM_Packread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Indat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%downwind_align_angle,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%downwind_align_angle)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%downwind_align_angle))-1 ) = PACK(InData%downwind_align_angle,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%downwind_align_angle) + DO i1 = LBOUND(InData%downwind_align_angle,1), UBOUND(InData%downwind_align_angle,1) + ReKiBuf(Re_Xferred) = InData%downwind_align_angle(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%upwind_turbine_Xcoor) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1790,8 +1779,10 @@ SUBROUTINE DWM_Packread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Indat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_turbine_Xcoor,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%upwind_turbine_Xcoor)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%upwind_turbine_Xcoor))-1 ) = PACK(InData%upwind_turbine_Xcoor,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%upwind_turbine_Xcoor) + DO i1 = LBOUND(InData%upwind_turbine_Xcoor,1), UBOUND(InData%upwind_turbine_Xcoor,1) + ReKiBuf(Re_Xferred) = InData%upwind_turbine_Xcoor(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%upwind_turbine_Ycoor) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1803,8 +1794,10 @@ SUBROUTINE DWM_Packread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Indat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_turbine_Ycoor,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%upwind_turbine_Ycoor)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%upwind_turbine_Ycoor))-1 ) = PACK(InData%upwind_turbine_Ycoor,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%upwind_turbine_Ycoor) + DO i1 = LBOUND(InData%upwind_turbine_Ycoor,1), UBOUND(InData%upwind_turbine_Ycoor,1) + ReKiBuf(Re_Xferred) = InData%upwind_turbine_Ycoor(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%wind_farm_Xcoor) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1816,8 +1809,10 @@ SUBROUTINE DWM_Packread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Indat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%wind_farm_Xcoor,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%wind_farm_Xcoor)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%wind_farm_Xcoor))-1 ) = PACK(InData%wind_farm_Xcoor,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%wind_farm_Xcoor) + DO i1 = LBOUND(InData%wind_farm_Xcoor,1), UBOUND(InData%wind_farm_Xcoor,1) + ReKiBuf(Re_Xferred) = InData%wind_farm_Xcoor(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%wind_farm_Ycoor) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1829,8 +1824,10 @@ SUBROUTINE DWM_Packread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Indat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%wind_farm_Ycoor,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%wind_farm_Ycoor)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%wind_farm_Ycoor))-1 ) = PACK(InData%wind_farm_Ycoor,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%wind_farm_Ycoor) + DO i1 = LBOUND(InData%wind_farm_Ycoor,1), UBOUND(InData%wind_farm_Ycoor,1) + ReKiBuf(Re_Xferred) = InData%wind_farm_Ycoor(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%downwind_turbine_Xcoor) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1842,8 +1839,10 @@ SUBROUTINE DWM_Packread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Indat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%downwind_turbine_Xcoor,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%downwind_turbine_Xcoor)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%downwind_turbine_Xcoor))-1 ) = PACK(InData%downwind_turbine_Xcoor,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%downwind_turbine_Xcoor) + DO i1 = LBOUND(InData%downwind_turbine_Xcoor,1), UBOUND(InData%downwind_turbine_Xcoor,1) + ReKiBuf(Re_Xferred) = InData%downwind_turbine_Xcoor(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%downwind_turbine_Ycoor) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1855,8 +1854,10 @@ SUBROUTINE DWM_Packread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Indat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%downwind_turbine_Ycoor,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%downwind_turbine_Ycoor)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%downwind_turbine_Ycoor))-1 ) = PACK(InData%downwind_turbine_Ycoor,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%downwind_turbine_Ycoor) + DO i1 = LBOUND(InData%downwind_turbine_Ycoor,1), UBOUND(InData%downwind_turbine_Ycoor,1) + ReKiBuf(Re_Xferred) = InData%downwind_turbine_Ycoor(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE DWM_Packread_turbine_position_data @@ -1873,12 +1874,6 @@ SUBROUTINE DWM_UnPackread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Out INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -1894,8 +1889,8 @@ SUBROUTINE DWM_UnPackread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Out Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%SimulationOrder_index = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%SimulationOrder_index = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Turbine_sort_order not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1909,18 +1904,13 @@ SUBROUTINE DWM_UnPackread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Out CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Turbine_sort_order.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Turbine_sort_order)>0) OutData%Turbine_sort_order = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%Turbine_sort_order))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%Turbine_sort_order) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Turbine_sort_order,1), UBOUND(OutData%Turbine_sort_order,1) + OutData%Turbine_sort_order(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF - OutData%WT_index = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%WT_index = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TurbineInfluenceData not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1937,15 +1927,12 @@ SUBROUTINE DWM_UnPackread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Out CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TurbineInfluenceData.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%TurbineInfluenceData)>0) OutData%TurbineInfluenceData = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%TurbineInfluenceData))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%TurbineInfluenceData) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%TurbineInfluenceData,2), UBOUND(OutData%TurbineInfluenceData,2) + DO i1 = LBOUND(OutData%TurbineInfluenceData,1), UBOUND(OutData%TurbineInfluenceData,1) + OutData%TurbineInfluenceData(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! upwind_turbine_index not allocated Int_Xferred = Int_Xferred + 1 @@ -1960,15 +1947,10 @@ SUBROUTINE DWM_UnPackread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Out CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_turbine_index.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%upwind_turbine_index)>0) OutData%upwind_turbine_index = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%upwind_turbine_index))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%upwind_turbine_index) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%upwind_turbine_index,1), UBOUND(OutData%upwind_turbine_index,1) + OutData%upwind_turbine_index(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! downwind_turbine_index not allocated Int_Xferred = Int_Xferred + 1 @@ -1983,20 +1965,15 @@ SUBROUTINE DWM_UnPackread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Out CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%downwind_turbine_index.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%downwind_turbine_index)>0) OutData%downwind_turbine_index = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%downwind_turbine_index))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%downwind_turbine_index) - DEALLOCATE(mask1) - END IF - OutData%upwindturbine_number = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%downwindturbine_number = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%downwind_turbine_index,1), UBOUND(OutData%downwind_turbine_index,1) + OutData%downwind_turbine_index(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + OutData%upwindturbine_number = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%downwindturbine_number = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! turbine_windorigin_length not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2010,15 +1987,10 @@ SUBROUTINE DWM_UnPackread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Out CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%turbine_windorigin_length.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%turbine_windorigin_length)>0) OutData%turbine_windorigin_length = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%turbine_windorigin_length))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%turbine_windorigin_length) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%turbine_windorigin_length,1), UBOUND(OutData%turbine_windorigin_length,1) + OutData%turbine_windorigin_length(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! upwind_turbine_projected_distance not allocated Int_Xferred = Int_Xferred + 1 @@ -2033,15 +2005,10 @@ SUBROUTINE DWM_UnPackread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Out CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_turbine_projected_distance.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%upwind_turbine_projected_distance)>0) OutData%upwind_turbine_projected_distance = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%upwind_turbine_projected_distance))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%upwind_turbine_projected_distance) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%upwind_turbine_projected_distance,1), UBOUND(OutData%upwind_turbine_projected_distance,1) + OutData%upwind_turbine_projected_distance(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! downwind_turbine_projected_distance not allocated Int_Xferred = Int_Xferred + 1 @@ -2056,15 +2023,10 @@ SUBROUTINE DWM_UnPackread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Out CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%downwind_turbine_projected_distance.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%downwind_turbine_projected_distance)>0) OutData%downwind_turbine_projected_distance = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%downwind_turbine_projected_distance))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%downwind_turbine_projected_distance) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%downwind_turbine_projected_distance,1), UBOUND(OutData%downwind_turbine_projected_distance,1) + OutData%downwind_turbine_projected_distance(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! turbine_angle not allocated Int_Xferred = Int_Xferred + 1 @@ -2082,15 +2044,12 @@ SUBROUTINE DWM_UnPackread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Out CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%turbine_angle.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%turbine_angle)>0) OutData%turbine_angle = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%turbine_angle))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%turbine_angle) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%turbine_angle,2), UBOUND(OutData%turbine_angle,2) + DO i1 = LBOUND(OutData%turbine_angle,1), UBOUND(OutData%turbine_angle,1) + OutData%turbine_angle(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! upwind_align_angle not allocated Int_Xferred = Int_Xferred + 1 @@ -2105,15 +2064,10 @@ SUBROUTINE DWM_UnPackread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Out CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_align_angle.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%upwind_align_angle)>0) OutData%upwind_align_angle = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%upwind_align_angle))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%upwind_align_angle) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%upwind_align_angle,1), UBOUND(OutData%upwind_align_angle,1) + OutData%upwind_align_angle(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! downwind_align_angle not allocated Int_Xferred = Int_Xferred + 1 @@ -2128,15 +2082,10 @@ SUBROUTINE DWM_UnPackread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Out CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%downwind_align_angle.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%downwind_align_angle)>0) OutData%downwind_align_angle = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%downwind_align_angle))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%downwind_align_angle) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%downwind_align_angle,1), UBOUND(OutData%downwind_align_angle,1) + OutData%downwind_align_angle(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! upwind_turbine_Xcoor not allocated Int_Xferred = Int_Xferred + 1 @@ -2151,15 +2100,10 @@ SUBROUTINE DWM_UnPackread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Out CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_turbine_Xcoor.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%upwind_turbine_Xcoor)>0) OutData%upwind_turbine_Xcoor = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%upwind_turbine_Xcoor))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%upwind_turbine_Xcoor) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%upwind_turbine_Xcoor,1), UBOUND(OutData%upwind_turbine_Xcoor,1) + OutData%upwind_turbine_Xcoor(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! upwind_turbine_Ycoor not allocated Int_Xferred = Int_Xferred + 1 @@ -2174,15 +2118,10 @@ SUBROUTINE DWM_UnPackread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Out CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_turbine_Ycoor.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%upwind_turbine_Ycoor)>0) OutData%upwind_turbine_Ycoor = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%upwind_turbine_Ycoor))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%upwind_turbine_Ycoor) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%upwind_turbine_Ycoor,1), UBOUND(OutData%upwind_turbine_Ycoor,1) + OutData%upwind_turbine_Ycoor(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! wind_farm_Xcoor not allocated Int_Xferred = Int_Xferred + 1 @@ -2197,15 +2136,10 @@ SUBROUTINE DWM_UnPackread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Out CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%wind_farm_Xcoor.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%wind_farm_Xcoor)>0) OutData%wind_farm_Xcoor = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%wind_farm_Xcoor))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%wind_farm_Xcoor) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%wind_farm_Xcoor,1), UBOUND(OutData%wind_farm_Xcoor,1) + OutData%wind_farm_Xcoor(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! wind_farm_Ycoor not allocated Int_Xferred = Int_Xferred + 1 @@ -2220,15 +2154,10 @@ SUBROUTINE DWM_UnPackread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Out CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%wind_farm_Ycoor.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%wind_farm_Ycoor)>0) OutData%wind_farm_Ycoor = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%wind_farm_Ycoor))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%wind_farm_Ycoor) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%wind_farm_Ycoor,1), UBOUND(OutData%wind_farm_Ycoor,1) + OutData%wind_farm_Ycoor(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! downwind_turbine_Xcoor not allocated Int_Xferred = Int_Xferred + 1 @@ -2243,15 +2172,10 @@ SUBROUTINE DWM_UnPackread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Out CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%downwind_turbine_Xcoor.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%downwind_turbine_Xcoor)>0) OutData%downwind_turbine_Xcoor = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%downwind_turbine_Xcoor))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%downwind_turbine_Xcoor) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%downwind_turbine_Xcoor,1), UBOUND(OutData%downwind_turbine_Xcoor,1) + OutData%downwind_turbine_Xcoor(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! downwind_turbine_Ycoor not allocated Int_Xferred = Int_Xferred + 1 @@ -2266,15 +2190,10 @@ SUBROUTINE DWM_UnPackread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Out CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%downwind_turbine_Ycoor.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%downwind_turbine_Ycoor)>0) OutData%downwind_turbine_Ycoor = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%downwind_turbine_Ycoor))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%downwind_turbine_Ycoor) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%downwind_turbine_Ycoor,1), UBOUND(OutData%downwind_turbine_Ycoor,1) + OutData%downwind_turbine_Ycoor(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE DWM_UnPackread_turbine_position_data @@ -2400,11 +2319,13 @@ SUBROUTINE DWM_PackWeiMethod( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%sweptarea,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%sweptarea)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%sweptarea))-1 ) = PACK(InData%sweptarea,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%sweptarea) + DO i1 = LBOUND(InData%sweptarea,1), UBOUND(InData%sweptarea,1) + ReKiBuf(Re_Xferred) = InData%sweptarea(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%weighting_denominator - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%weighting_denominator + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DWM_PackWeiMethod SUBROUTINE DWM_UnPackWeiMethod( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2420,12 +2341,6 @@ SUBROUTINE DWM_UnPackWeiMethod( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -2453,18 +2368,13 @@ SUBROUTINE DWM_UnPackWeiMethod( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%sweptarea.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%sweptarea)>0) OutData%sweptarea = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%sweptarea))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%sweptarea) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%sweptarea,1), UBOUND(OutData%sweptarea,1) + OutData%sweptarea(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%weighting_denominator = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%weighting_denominator = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DWM_UnPackWeiMethod SUBROUTINE DWM_CopyTIDownstream( SrcTIDownstreamData, DstTIDownstreamData, CtrlCode, ErrStat, ErrMsg ) @@ -2651,67 +2561,71 @@ SUBROUTINE DWM_PackTIDownstream( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TI_downstream_matrix,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TI_downstream_matrix)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TI_downstream_matrix))-1 ) = PACK(InData%TI_downstream_matrix,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TI_downstream_matrix) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%i - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%j - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%k - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%cross_plane_position_ds - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%cross_plane_position_TI - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%distance_index - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%counter1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%counter2 - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%initial_timestep - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%y_axis_turbine - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%z_axis_turbine - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%distance - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TI_downstream_node - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TI_node_temp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TI_node - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TI_accumulation - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TI_apprant_accumulation - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TI_average - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TI_apprant - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HubHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%wake_center_y - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%wake_center_z - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Rscale - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%y - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%z - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%zero_spacing - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%temp1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%temp2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%temp3 - Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(InData%TI_downstream_matrix,2), UBOUND(InData%TI_downstream_matrix,2) + DO i1 = LBOUND(InData%TI_downstream_matrix,1), UBOUND(InData%TI_downstream_matrix,1) + ReKiBuf(Re_Xferred) = InData%TI_downstream_matrix(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IntKiBuf(Int_Xferred) = InData%i + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%j + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%k + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%cross_plane_position_ds + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%cross_plane_position_TI + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%distance_index + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%counter1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%counter2 + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%initial_timestep + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%y_axis_turbine + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%z_axis_turbine + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%distance + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TI_downstream_node + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TI_node_temp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TI_node + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TI_accumulation + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TI_apprant_accumulation + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TI_average + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TI_apprant + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HubHt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%wake_center_y + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%wake_center_z + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Rscale + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%y + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%z + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%zero_spacing + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%temp1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%temp2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%temp3 + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DWM_PackTIDownstream SUBROUTINE DWM_UnPackTIDownstream( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2727,12 +2641,6 @@ SUBROUTINE DWM_UnPackTIDownstream( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -2764,74 +2672,71 @@ SUBROUTINE DWM_UnPackTIDownstream( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TI_downstream_matrix.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%TI_downstream_matrix)>0) OutData%TI_downstream_matrix = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TI_downstream_matrix))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TI_downstream_matrix) - DEALLOCATE(mask2) - END IF - OutData%i = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%j = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%k = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%cross_plane_position_ds = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%cross_plane_position_TI = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%distance_index = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%counter1 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%counter2 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%initial_timestep = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%y_axis_turbine = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%z_axis_turbine = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%distance = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TI_downstream_node = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TI_node_temp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TI_node = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TI_accumulation = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TI_apprant_accumulation = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TI_average = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TI_apprant = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HubHt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%wake_center_y = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%wake_center_z = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Rscale = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%y = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%z = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%zero_spacing = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%temp1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%temp2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%temp3 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(OutData%TI_downstream_matrix,2), UBOUND(OutData%TI_downstream_matrix,2) + DO i1 = LBOUND(OutData%TI_downstream_matrix,1), UBOUND(OutData%TI_downstream_matrix,1) + OutData%TI_downstream_matrix(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%i = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%j = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%k = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%cross_plane_position_ds = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%cross_plane_position_TI = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%distance_index = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%counter1 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%counter2 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%initial_timestep = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%y_axis_turbine = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%z_axis_turbine = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%distance = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TI_downstream_node = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TI_node_temp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TI_node = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TI_accumulation = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TI_apprant_accumulation = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TI_average = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TI_apprant = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HubHt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%wake_center_y = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%wake_center_z = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Rscale = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%y = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%z = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%zero_spacing = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%temp1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%temp2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%temp3 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DWM_UnPackTIDownstream SUBROUTINE DWM_CopyTurbKaimal( SrcTurbKaimalData, DstTurbKaimalData, CtrlCode, ErrStat, ErrMsg ) @@ -2937,20 +2842,20 @@ SUBROUTINE DWM_PackTurbKaimal( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%fs - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%temp_n - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%i - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%low_f - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%high_f - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%lk_facor - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%STD - Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%fs + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%temp_n + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%i + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%low_f + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%high_f + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%lk_facor + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%STD + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DWM_PackTurbKaimal SUBROUTINE DWM_UnPackTurbKaimal( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2966,12 +2871,6 @@ SUBROUTINE DWM_UnPackTurbKaimal( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DWM_UnPackTurbKaimal' @@ -2985,20 +2884,20 @@ SUBROUTINE DWM_UnPackTurbKaimal( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%fs = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%temp_n = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%i = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%low_f = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%high_f = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%lk_facor = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%STD = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%fs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%temp_n = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%i = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%low_f = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%high_f = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%lk_facor = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%STD = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DWM_UnPackTurbKaimal SUBROUTINE DWM_CopyShinozuka( SrcShinozukaData, DstShinozukaData, CtrlCode, ErrStat, ErrMsg ) @@ -3217,8 +3116,10 @@ SUBROUTINE DWM_PackShinozuka( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%f_syn,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%f_syn)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%f_syn))-1 ) = PACK(InData%f_syn,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%f_syn) + DO i1 = LBOUND(InData%f_syn,1), UBOUND(InData%f_syn,1) + ReKiBuf(Re_Xferred) = InData%f_syn(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%t_syn) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3230,8 +3131,10 @@ SUBROUTINE DWM_PackShinozuka( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%t_syn,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%t_syn)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%t_syn))-1 ) = PACK(InData%t_syn,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%t_syn) + DO i1 = LBOUND(InData%t_syn,1), UBOUND(InData%t_syn,1) + ReKiBuf(Re_Xferred) = InData%t_syn(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%phi) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3243,8 +3146,10 @@ SUBROUTINE DWM_PackShinozuka( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%phi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%phi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%phi))-1 ) = PACK(InData%phi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%phi) + DO i1 = LBOUND(InData%phi,1), UBOUND(InData%phi,1) + ReKiBuf(Re_Xferred) = InData%phi(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%p_k) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3256,8 +3161,10 @@ SUBROUTINE DWM_PackShinozuka( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%p_k,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%p_k)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%p_k))-1 ) = PACK(InData%p_k,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%p_k) + DO i1 = LBOUND(InData%p_k,1), UBOUND(InData%p_k,1) + ReKiBuf(Re_Xferred) = InData%p_k(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%a_k) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3269,25 +3176,27 @@ SUBROUTINE DWM_PackShinozuka( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%a_k,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%a_k)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%a_k))-1 ) = PACK(InData%a_k,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%a_k) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%num_points - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%ILo - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%i - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%j - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%t_min - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%t_max - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%df - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%a_k,1), UBOUND(InData%a_k,1) + ReKiBuf(Re_Xferred) = InData%a_k(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = InData%num_points + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%ILo + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%i + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%j + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%t_min + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%t_max + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%df + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DWM_PackShinozuka SUBROUTINE DWM_UnPackShinozuka( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -3303,12 +3212,6 @@ SUBROUTINE DWM_UnPackShinozuka( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -3336,15 +3239,10 @@ SUBROUTINE DWM_UnPackShinozuka( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%f_syn.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%f_syn)>0) OutData%f_syn = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%f_syn))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%f_syn) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%f_syn,1), UBOUND(OutData%f_syn,1) + OutData%f_syn(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! t_syn not allocated Int_Xferred = Int_Xferred + 1 @@ -3359,15 +3257,10 @@ SUBROUTINE DWM_UnPackShinozuka( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%t_syn.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%t_syn)>0) OutData%t_syn = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%t_syn))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%t_syn) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%t_syn,1), UBOUND(OutData%t_syn,1) + OutData%t_syn(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! phi not allocated Int_Xferred = Int_Xferred + 1 @@ -3382,15 +3275,10 @@ SUBROUTINE DWM_UnPackShinozuka( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%phi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%phi)>0) OutData%phi = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%phi))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%phi) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%phi,1), UBOUND(OutData%phi,1) + OutData%phi(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! p_k not allocated Int_Xferred = Int_Xferred + 1 @@ -3405,15 +3293,10 @@ SUBROUTINE DWM_UnPackShinozuka( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%p_k.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%p_k)>0) OutData%p_k = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%p_k))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%p_k) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%p_k,1), UBOUND(OutData%p_k,1) + OutData%p_k(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! a_k not allocated Int_Xferred = Int_Xferred + 1 @@ -3428,32 +3311,27 @@ SUBROUTINE DWM_UnPackShinozuka( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%a_k.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%a_k)>0) OutData%a_k = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%a_k))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%a_k) - DEALLOCATE(mask1) - END IF - OutData%num_points = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ILo = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%i = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%j = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%dt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%t_min = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%t_max = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%df = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%a_k,1), UBOUND(OutData%a_k,1) + OutData%a_k(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%num_points = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ILo = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%i = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%j = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%dt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%t_min = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%t_max = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%df = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DWM_UnPackShinozuka SUBROUTINE DWM_Copysmooth_out_wake_data( Srcsmooth_out_wake_dataData, Dstsmooth_out_wake_dataData, CtrlCode, ErrStat, ErrMsg ) @@ -3547,8 +3425,8 @@ SUBROUTINE DWM_Packsmooth_out_wake_data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Err Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%length_velocity_array - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%length_velocity_array + Int_Xferred = Int_Xferred + 1 END SUBROUTINE DWM_Packsmooth_out_wake_data SUBROUTINE DWM_UnPacksmooth_out_wake_data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -3564,12 +3442,6 @@ SUBROUTINE DWM_UnPacksmooth_out_wake_data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DWM_UnPacksmooth_out_wake_data' @@ -3583,8 +3455,8 @@ SUBROUTINE DWM_UnPacksmooth_out_wake_data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%length_velocity_array = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%length_velocity_array = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE DWM_UnPacksmooth_out_wake_data SUBROUTINE DWM_CopySWSV( SrcSWSVData, DstSWSVData, CtrlCode, ErrStat, ErrMsg ) @@ -3688,18 +3560,18 @@ SUBROUTINE DWM_PackSWSV( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%p1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%p2 - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%distance - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%y0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%z0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%unit - Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%p1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%p2 + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%distance + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%y0 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%z0 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%unit + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DWM_PackSWSV SUBROUTINE DWM_UnPackSWSV( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -3715,12 +3587,6 @@ SUBROUTINE DWM_UnPackSWSV( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DWM_UnPackSWSV' @@ -3734,18 +3600,18 @@ SUBROUTINE DWM_UnPackSWSV( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%p1 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%p2 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%distance = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%y0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%z0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%unit = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%p1 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%p2 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%distance = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%y0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%z0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%unit = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DWM_UnPackSWSV SUBROUTINE DWM_Copyread_upwind_result( Srcread_upwind_resultData, Dstread_upwind_resultData, CtrlCode, ErrStat, ErrMsg ) @@ -4090,8 +3956,12 @@ SUBROUTINE DWM_Packread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_U,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%upwind_U)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%upwind_U))-1 ) = PACK(InData%upwind_U,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%upwind_U) + DO i2 = LBOUND(InData%upwind_U,2), UBOUND(InData%upwind_U,2) + DO i1 = LBOUND(InData%upwind_U,1), UBOUND(InData%upwind_U,1) + ReKiBuf(Re_Xferred) = InData%upwind_U(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%upwind_wakecenter) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4112,8 +3982,16 @@ SUBROUTINE DWM_Packread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_wakecenter,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%upwind_wakecenter)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%upwind_wakecenter))-1 ) = PACK(InData%upwind_wakecenter,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%upwind_wakecenter) + DO i4 = LBOUND(InData%upwind_wakecenter,4), UBOUND(InData%upwind_wakecenter,4) + DO i3 = LBOUND(InData%upwind_wakecenter,3), UBOUND(InData%upwind_wakecenter,3) + DO i2 = LBOUND(InData%upwind_wakecenter,2), UBOUND(InData%upwind_wakecenter,2) + DO i1 = LBOUND(InData%upwind_wakecenter,1), UBOUND(InData%upwind_wakecenter,1) + ReKiBuf(Re_Xferred) = InData%upwind_wakecenter(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%upwind_meanU) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4125,8 +4003,10 @@ SUBROUTINE DWM_Packread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_meanU,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%upwind_meanU)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%upwind_meanU))-1 ) = PACK(InData%upwind_meanU,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%upwind_meanU) + DO i1 = LBOUND(InData%upwind_meanU,1), UBOUND(InData%upwind_meanU,1) + ReKiBuf(Re_Xferred) = InData%upwind_meanU(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%upwind_TI) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4138,8 +4018,10 @@ SUBROUTINE DWM_Packread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_TI,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%upwind_TI)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%upwind_TI))-1 ) = PACK(InData%upwind_TI,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%upwind_TI) + DO i1 = LBOUND(InData%upwind_TI,1), UBOUND(InData%upwind_TI,1) + ReKiBuf(Re_Xferred) = InData%upwind_TI(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%upwind_small_TI) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4151,8 +4033,10 @@ SUBROUTINE DWM_Packread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_small_TI,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%upwind_small_TI)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%upwind_small_TI))-1 ) = PACK(InData%upwind_small_TI,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%upwind_small_TI) + DO i1 = LBOUND(InData%upwind_small_TI,1), UBOUND(InData%upwind_small_TI,1) + ReKiBuf(Re_Xferred) = InData%upwind_small_TI(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%upwind_smoothWake) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4167,8 +4051,12 @@ SUBROUTINE DWM_Packread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_smoothWake,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%upwind_smoothWake)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%upwind_smoothWake))-1 ) = PACK(InData%upwind_smoothWake,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%upwind_smoothWake) + DO i2 = LBOUND(InData%upwind_smoothWake,2), UBOUND(InData%upwind_smoothWake,2) + DO i1 = LBOUND(InData%upwind_smoothWake,1), UBOUND(InData%upwind_smoothWake,1) + ReKiBuf(Re_Xferred) = InData%upwind_smoothWake(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%velocity_aerodyn) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4180,8 +4068,10 @@ SUBROUTINE DWM_Packread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt IntKiBuf( Int_Xferred + 1) = UBOUND(InData%velocity_aerodyn,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%velocity_aerodyn)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%velocity_aerodyn))-1 ) = PACK(InData%velocity_aerodyn,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%velocity_aerodyn) + DO i1 = LBOUND(InData%velocity_aerodyn,1), UBOUND(InData%velocity_aerodyn,1) + ReKiBuf(Re_Xferred) = InData%velocity_aerodyn(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TI_downstream) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4193,8 +4083,10 @@ SUBROUTINE DWM_Packread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TI_downstream,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TI_downstream)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TI_downstream))-1 ) = PACK(InData%TI_downstream,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TI_downstream) + DO i1 = LBOUND(InData%TI_downstream,1), UBOUND(InData%TI_downstream,1) + ReKiBuf(Re_Xferred) = InData%TI_downstream(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%small_scale_TI_downstream) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4206,8 +4098,10 @@ SUBROUTINE DWM_Packread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt IntKiBuf( Int_Xferred + 1) = UBOUND(InData%small_scale_TI_downstream,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%small_scale_TI_downstream)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%small_scale_TI_downstream))-1 ) = PACK(InData%small_scale_TI_downstream,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%small_scale_TI_downstream) + DO i1 = LBOUND(InData%small_scale_TI_downstream,1), UBOUND(InData%small_scale_TI_downstream,1) + ReKiBuf(Re_Xferred) = InData%small_scale_TI_downstream(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%smoothed_velocity_array) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4222,8 +4116,12 @@ SUBROUTINE DWM_Packread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt IntKiBuf( Int_Xferred + 1) = UBOUND(InData%smoothed_velocity_array,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%smoothed_velocity_array)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%smoothed_velocity_array))-1 ) = PACK(InData%smoothed_velocity_array,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%smoothed_velocity_array) + DO i2 = LBOUND(InData%smoothed_velocity_array,2), UBOUND(InData%smoothed_velocity_array,2) + DO i1 = LBOUND(InData%smoothed_velocity_array,1), UBOUND(InData%smoothed_velocity_array,1) + ReKiBuf(Re_Xferred) = InData%smoothed_velocity_array(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%vel_matrix) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4241,8 +4139,14 @@ SUBROUTINE DWM_Packread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vel_matrix,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%vel_matrix)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%vel_matrix))-1 ) = PACK(InData%vel_matrix,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%vel_matrix) + DO i3 = LBOUND(InData%vel_matrix,3), UBOUND(InData%vel_matrix,3) + DO i2 = LBOUND(InData%vel_matrix,2), UBOUND(InData%vel_matrix,2) + DO i1 = LBOUND(InData%vel_matrix,1), UBOUND(InData%vel_matrix,1) + ReKiBuf(Re_Xferred) = InData%vel_matrix(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF END SUBROUTINE DWM_Packread_upwind_result @@ -4259,12 +4163,6 @@ SUBROUTINE DWM_UnPackread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -4298,15 +4196,12 @@ SUBROUTINE DWM_UnPackread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_U.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%upwind_U)>0) OutData%upwind_U = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%upwind_U))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%upwind_U) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%upwind_U,2), UBOUND(OutData%upwind_U,2) + DO i1 = LBOUND(OutData%upwind_U,1), UBOUND(OutData%upwind_U,1) + OutData%upwind_U(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! upwind_wakecenter not allocated Int_Xferred = Int_Xferred + 1 @@ -4330,15 +4225,16 @@ SUBROUTINE DWM_UnPackread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_wakecenter.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%upwind_wakecenter)>0) OutData%upwind_wakecenter = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%upwind_wakecenter))-1 ), mask4, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%upwind_wakecenter) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%upwind_wakecenter,4), UBOUND(OutData%upwind_wakecenter,4) + DO i3 = LBOUND(OutData%upwind_wakecenter,3), UBOUND(OutData%upwind_wakecenter,3) + DO i2 = LBOUND(OutData%upwind_wakecenter,2), UBOUND(OutData%upwind_wakecenter,2) + DO i1 = LBOUND(OutData%upwind_wakecenter,1), UBOUND(OutData%upwind_wakecenter,1) + OutData%upwind_wakecenter(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! upwind_meanU not allocated Int_Xferred = Int_Xferred + 1 @@ -4353,15 +4249,10 @@ SUBROUTINE DWM_UnPackread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_meanU.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%upwind_meanU)>0) OutData%upwind_meanU = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%upwind_meanU))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%upwind_meanU) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%upwind_meanU,1), UBOUND(OutData%upwind_meanU,1) + OutData%upwind_meanU(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! upwind_TI not allocated Int_Xferred = Int_Xferred + 1 @@ -4376,15 +4267,10 @@ SUBROUTINE DWM_UnPackread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_TI.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%upwind_TI)>0) OutData%upwind_TI = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%upwind_TI))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%upwind_TI) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%upwind_TI,1), UBOUND(OutData%upwind_TI,1) + OutData%upwind_TI(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! upwind_small_TI not allocated Int_Xferred = Int_Xferred + 1 @@ -4399,15 +4285,10 @@ SUBROUTINE DWM_UnPackread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_small_TI.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%upwind_small_TI)>0) OutData%upwind_small_TI = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%upwind_small_TI))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%upwind_small_TI) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%upwind_small_TI,1), UBOUND(OutData%upwind_small_TI,1) + OutData%upwind_small_TI(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! upwind_smoothWake not allocated Int_Xferred = Int_Xferred + 1 @@ -4425,15 +4306,12 @@ SUBROUTINE DWM_UnPackread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_smoothWake.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%upwind_smoothWake)>0) OutData%upwind_smoothWake = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%upwind_smoothWake))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%upwind_smoothWake) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%upwind_smoothWake,2), UBOUND(OutData%upwind_smoothWake,2) + DO i1 = LBOUND(OutData%upwind_smoothWake,1), UBOUND(OutData%upwind_smoothWake,1) + OutData%upwind_smoothWake(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! velocity_aerodyn not allocated Int_Xferred = Int_Xferred + 1 @@ -4448,15 +4326,10 @@ SUBROUTINE DWM_UnPackread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%velocity_aerodyn.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%velocity_aerodyn)>0) OutData%velocity_aerodyn = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%velocity_aerodyn))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%velocity_aerodyn) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%velocity_aerodyn,1), UBOUND(OutData%velocity_aerodyn,1) + OutData%velocity_aerodyn(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TI_downstream not allocated Int_Xferred = Int_Xferred + 1 @@ -4471,15 +4344,10 @@ SUBROUTINE DWM_UnPackread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TI_downstream.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TI_downstream)>0) OutData%TI_downstream = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TI_downstream))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TI_downstream) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TI_downstream,1), UBOUND(OutData%TI_downstream,1) + OutData%TI_downstream(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! small_scale_TI_downstream not allocated Int_Xferred = Int_Xferred + 1 @@ -4494,15 +4362,10 @@ SUBROUTINE DWM_UnPackread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%small_scale_TI_downstream.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%small_scale_TI_downstream)>0) OutData%small_scale_TI_downstream = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%small_scale_TI_downstream))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%small_scale_TI_downstream) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%small_scale_TI_downstream,1), UBOUND(OutData%small_scale_TI_downstream,1) + OutData%small_scale_TI_downstream(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! smoothed_velocity_array not allocated Int_Xferred = Int_Xferred + 1 @@ -4520,15 +4383,12 @@ SUBROUTINE DWM_UnPackread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%smoothed_velocity_array.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%smoothed_velocity_array)>0) OutData%smoothed_velocity_array = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%smoothed_velocity_array))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%smoothed_velocity_array) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%smoothed_velocity_array,2), UBOUND(OutData%smoothed_velocity_array,2) + DO i1 = LBOUND(OutData%smoothed_velocity_array,1), UBOUND(OutData%smoothed_velocity_array,1) + OutData%smoothed_velocity_array(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! vel_matrix not allocated Int_Xferred = Int_Xferred + 1 @@ -4549,15 +4409,14 @@ SUBROUTINE DWM_UnPackread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%vel_matrix.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%vel_matrix)>0) OutData%vel_matrix = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%vel_matrix))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%vel_matrix) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%vel_matrix,3), UBOUND(OutData%vel_matrix,3) + DO i2 = LBOUND(OutData%vel_matrix,2), UBOUND(OutData%vel_matrix,2) + DO i1 = LBOUND(OutData%vel_matrix,1), UBOUND(OutData%vel_matrix,1) + OutData%vel_matrix(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF END SUBROUTINE DWM_UnPackread_upwind_result @@ -4681,8 +4540,10 @@ SUBROUTINE DWM_Packwake_meandered_center( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%wake_width,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%wake_width)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%wake_width))-1 ) = PACK(InData%wake_width,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%wake_width) + DO i1 = LBOUND(InData%wake_width,1), UBOUND(InData%wake_width,1) + IntKiBuf(Int_Xferred) = InData%wake_width(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF END SUBROUTINE DWM_Packwake_meandered_center @@ -4699,12 +4560,6 @@ SUBROUTINE DWM_UnPackwake_meandered_center( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -4732,15 +4587,10 @@ SUBROUTINE DWM_UnPackwake_meandered_center( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%wake_width.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%wake_width)>0) OutData%wake_width = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%wake_width))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%wake_width) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%wake_width,1), UBOUND(OutData%wake_width,1) + OutData%wake_width(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF END SUBROUTINE DWM_UnPackwake_meandered_center @@ -4839,12 +4689,12 @@ SUBROUTINE DWM_Packturbine_blade( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Aerodyn_turbine_num - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Blade_index - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Element_index - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Aerodyn_turbine_num + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Blade_index + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Element_index + Int_Xferred = Int_Xferred + 1 END SUBROUTINE DWM_Packturbine_blade SUBROUTINE DWM_UnPackturbine_blade( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -4860,12 +4710,6 @@ SUBROUTINE DWM_UnPackturbine_blade( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DWM_UnPackturbine_blade' @@ -4879,12 +4723,12 @@ SUBROUTINE DWM_UnPackturbine_blade( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%Aerodyn_turbine_num = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%Blade_index = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%Element_index = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%Aerodyn_turbine_num = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Blade_index = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Element_index = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE DWM_UnPackturbine_blade SUBROUTINE DWM_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -5158,8 +5002,10 @@ SUBROUTINE DWM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%velocityU,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%velocityU)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%velocityU))-1 ) = PACK(InData%velocityU,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%velocityU) + DO i1 = LBOUND(InData%velocityU,1), UBOUND(InData%velocityU,1) + ReKiBuf(Re_Xferred) = InData%velocityU(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%smoothed_wake) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5171,8 +5017,10 @@ SUBROUTINE DWM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%smoothed_wake,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%smoothed_wake)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%smoothed_wake))-1 ) = PACK(InData%smoothed_wake,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%smoothed_wake) + DO i1 = LBOUND(InData%smoothed_wake,1), UBOUND(InData%smoothed_wake,1) + ReKiBuf(Re_Xferred) = InData%smoothed_wake(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WakePosition) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5190,47 +5038,53 @@ SUBROUTINE DWM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WakePosition,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WakePosition)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WakePosition))-1 ) = PACK(InData%WakePosition,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WakePosition) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WakePosition_1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WakePosition_2 - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%smooth_flag - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%p_p_r - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumWT - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Tinfluencer - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RotorR - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%r_domain - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%x_domain - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Uambient - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TI_amb - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TI_wake - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%hub_height - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%length_velocityU - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WFLowerBd - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Wind_file_Mean_u - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Winddir - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%air_density - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RR - Re_Xferred = Re_Xferred + 1 + DO i3 = LBOUND(InData%WakePosition,3), UBOUND(InData%WakePosition,3) + DO i2 = LBOUND(InData%WakePosition,2), UBOUND(InData%WakePosition,2) + DO i1 = LBOUND(InData%WakePosition,1), UBOUND(InData%WakePosition,1) + ReKiBuf(Re_Xferred) = InData%WakePosition(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IntKiBuf(Int_Xferred) = InData%WakePosition_1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WakePosition_2 + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%smooth_flag + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%p_p_r + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumWT + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Tinfluencer + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RotorR + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%r_domain + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%x_domain + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Uambient + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TI_amb + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TI_wake + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%hub_height + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%length_velocityU + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WFLowerBd + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Wind_file_Mean_u + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Winddir + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%air_density + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RR + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%ElementRad) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -5241,13 +5095,15 @@ SUBROUTINE DWM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElementRad,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ElementRad)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%ElementRad))-1 ) = PACK(InData%ElementRad,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%ElementRad) + DO i1 = LBOUND(InData%ElementRad,1), UBOUND(InData%ElementRad,1) + ReKiBuf(Re_Xferred) = InData%ElementRad(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Bnum - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%ElementNum - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Bnum + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%ElementNum + Int_Xferred = Int_Xferred + 1 CALL DWM_Packread_turbine_position_data( Re_Buf, Db_Buf, Int_Buf, InData%RTPD, ErrStat2, ErrMsg2, OnlySize ) ! RTPD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -5319,12 +5175,6 @@ SUBROUTINE DWM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -5354,15 +5204,10 @@ SUBROUTINE DWM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%velocityU.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%velocityU)>0) OutData%velocityU = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%velocityU))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%velocityU) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%velocityU,1), UBOUND(OutData%velocityU,1) + OutData%velocityU(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! smoothed_wake not allocated Int_Xferred = Int_Xferred + 1 @@ -5377,15 +5222,10 @@ SUBROUTINE DWM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%smoothed_wake.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%smoothed_wake)>0) OutData%smoothed_wake = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%smoothed_wake))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%smoothed_wake) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%smoothed_wake,1), UBOUND(OutData%smoothed_wake,1) + OutData%smoothed_wake(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WakePosition not allocated Int_Xferred = Int_Xferred + 1 @@ -5406,54 +5246,53 @@ SUBROUTINE DWM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WakePosition.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%WakePosition)>0) OutData%WakePosition = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WakePosition))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WakePosition) - DEALLOCATE(mask3) - END IF - OutData%WakePosition_1 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%WakePosition_2 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%smooth_flag = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%p_p_r = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumWT = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%Tinfluencer = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%RotorR = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%r_domain = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%x_domain = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Uambient = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TI_amb = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TI_wake = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%hub_height = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%length_velocityU = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WFLowerBd = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Wind_file_Mean_u = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Winddir = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%air_density = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RR = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i3 = LBOUND(OutData%WakePosition,3), UBOUND(OutData%WakePosition,3) + DO i2 = LBOUND(OutData%WakePosition,2), UBOUND(OutData%WakePosition,2) + DO i1 = LBOUND(OutData%WakePosition,1), UBOUND(OutData%WakePosition,1) + OutData%WakePosition(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + OutData%WakePosition_1 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WakePosition_2 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%smooth_flag = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%p_p_r = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumWT = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Tinfluencer = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%RotorR = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%r_domain = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%x_domain = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Uambient = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TI_amb = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TI_wake = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%hub_height = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%length_velocityU = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WFLowerBd = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Wind_file_Mean_u = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Winddir = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%air_density = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RR = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ElementRad not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5467,20 +5306,15 @@ SUBROUTINE DWM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElementRad.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%ElementRad)>0) OutData%ElementRad = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%ElementRad))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%ElementRad) - DEALLOCATE(mask1) - END IF - OutData%Bnum = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ElementNum = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%ElementRad,1), UBOUND(OutData%ElementRad,1) + OutData%ElementRad(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%Bnum = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ElementNum = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -5717,12 +5551,6 @@ SUBROUTINE DWM_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DWM_UnPackOtherState' @@ -6235,18 +6063,18 @@ SUBROUTINE DWM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%position_y - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%position_z - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%velocity_wake_mean - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%shifted_velocity_Aerodyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%U_velocity - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%V_velocity - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%position_y + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%position_z + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%velocity_wake_mean + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%shifted_velocity_Aerodyn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%U_velocity + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%V_velocity + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%Nforce) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -6260,8 +6088,12 @@ SUBROUTINE DWM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nforce,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Nforce)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Nforce))-1 ) = PACK(InData%Nforce,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Nforce) + DO i2 = LBOUND(InData%Nforce,2), UBOUND(InData%Nforce,2) + DO i1 = LBOUND(InData%Nforce,1), UBOUND(InData%Nforce,1) + ReKiBuf(Re_Xferred) = InData%Nforce(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%blade_dr) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6273,13 +6105,15 @@ SUBROUTINE DWM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%blade_dr,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%blade_dr)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%blade_dr))-1 ) = PACK(InData%blade_dr,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%blade_dr) + DO i1 = LBOUND(InData%blade_dr,1), UBOUND(InData%blade_dr,1) + ReKiBuf(Re_Xferred) = InData%blade_dr(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NacYaw - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TI_original - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NacYaw + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TI_original + Re_Xferred = Re_Xferred + 1 CALL DWM_Packturbine_average_velocity_data( Re_Buf, Db_Buf, Int_Buf, InData%TAVD, ErrStat2, ErrMsg2, OnlySize ) ! TAVD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6560,12 +6394,12 @@ SUBROUTINE DWM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ct_tilde - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FAST_Time - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%SDtimestep - Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ct_tilde + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FAST_Time + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%SDtimestep + Int_Xferred = Int_Xferred + 1 CALL DWM_Packturbine_blade( Re_Buf, Db_Buf, Int_Buf, InData%DWM_tb, ErrStat2, ErrMsg2, OnlySize ) ! DWM_tb CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6637,12 +6471,6 @@ SUBROUTINE DWM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -6698,18 +6526,18 @@ SUBROUTINE DWM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%position_y = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%position_z = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%velocity_wake_mean = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%shifted_velocity_Aerodyn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%U_velocity = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%V_velocity = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%position_y = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%position_z = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%velocity_wake_mean = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%shifted_velocity_Aerodyn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%U_velocity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%V_velocity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Nforce not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -6726,15 +6554,12 @@ SUBROUTINE DWM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nforce.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Nforce)>0) OutData%Nforce = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Nforce))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Nforce) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Nforce,2), UBOUND(OutData%Nforce,2) + DO i1 = LBOUND(OutData%Nforce,1), UBOUND(OutData%Nforce,1) + OutData%Nforce(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! blade_dr not allocated Int_Xferred = Int_Xferred + 1 @@ -6749,20 +6574,15 @@ SUBROUTINE DWM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%blade_dr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%blade_dr)>0) OutData%blade_dr = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%blade_dr))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%blade_dr) - DEALLOCATE(mask1) - END IF - OutData%NacYaw = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TI_original = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%blade_dr,1), UBOUND(OutData%blade_dr,1) + OutData%blade_dr(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%NacYaw = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TI_original = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -7163,12 +6983,12 @@ SUBROUTINE DWM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%ct_tilde = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%FAST_Time = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SDtimestep = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%ct_tilde = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%FAST_Time = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SDtimestep = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -7454,12 +7274,6 @@ SUBROUTINE DWM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DWM_UnPackInput' @@ -7863,8 +7677,10 @@ SUBROUTINE DWM_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%turbine_thrust_force,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%turbine_thrust_force)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%turbine_thrust_force))-1 ) = PACK(InData%turbine_thrust_force,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%turbine_thrust_force) + DO i1 = LBOUND(InData%turbine_thrust_force,1), UBOUND(InData%turbine_thrust_force,1) + ReKiBuf(Re_Xferred) = InData%turbine_thrust_force(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%induction_factor) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7876,8 +7692,10 @@ SUBROUTINE DWM_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%induction_factor,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%induction_factor)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%induction_factor))-1 ) = PACK(InData%induction_factor,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%induction_factor) + DO i1 = LBOUND(InData%induction_factor,1), UBOUND(InData%induction_factor,1) + ReKiBuf(Re_Xferred) = InData%induction_factor(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%r_initial) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7889,8 +7707,10 @@ SUBROUTINE DWM_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_initial,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%r_initial)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%r_initial))-1 ) = PACK(InData%r_initial,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%r_initial) + DO i1 = LBOUND(InData%r_initial,1), UBOUND(InData%r_initial,1) + ReKiBuf(Re_Xferred) = InData%r_initial(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%U_initial) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7902,8 +7722,10 @@ SUBROUTINE DWM_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%U_initial,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%U_initial)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%U_initial))-1 ) = PACK(InData%U_initial,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%U_initial) + DO i1 = LBOUND(InData%U_initial,1), UBOUND(InData%U_initial,1) + ReKiBuf(Re_Xferred) = InData%U_initial(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%Mean_FFWS_array) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7915,15 +7737,17 @@ SUBROUTINE DWM_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mean_FFWS_array,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Mean_FFWS_array)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Mean_FFWS_array))-1 ) = PACK(InData%Mean_FFWS_array,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Mean_FFWS_array) + DO i1 = LBOUND(InData%Mean_FFWS_array,1), UBOUND(InData%Mean_FFWS_array,1) + ReKiBuf(Re_Xferred) = InData%Mean_FFWS_array(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Mean_FFWS - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TI - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TI_downstream - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Mean_FFWS + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TI + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TI_downstream + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%wake_u) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -7937,8 +7761,12 @@ SUBROUTINE DWM_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%wake_u,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%wake_u)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%wake_u))-1 ) = PACK(InData%wake_u,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%wake_u) + DO i2 = LBOUND(InData%wake_u,2), UBOUND(InData%wake_u,2) + DO i1 = LBOUND(InData%wake_u,1), UBOUND(InData%wake_u,1) + ReKiBuf(Re_Xferred) = InData%wake_u(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%wake_position) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7956,8 +7784,14 @@ SUBROUTINE DWM_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%wake_position,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%wake_position)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%wake_position))-1 ) = PACK(InData%wake_position,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%wake_position) + DO i3 = LBOUND(InData%wake_position,3), UBOUND(InData%wake_position,3) + DO i2 = LBOUND(InData%wake_position,2), UBOUND(InData%wake_position,2) + DO i1 = LBOUND(InData%wake_position,1), UBOUND(InData%wake_position,1) + ReKiBuf(Re_Xferred) = InData%wake_position(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%smoothed_velocity_array) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7972,19 +7806,23 @@ SUBROUTINE DWM_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%smoothed_velocity_array,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%smoothed_velocity_array)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%smoothed_velocity_array))-1 ) = PACK(InData%smoothed_velocity_array,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%smoothed_velocity_array) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AtmUscale - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%du_dz_ABL - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%total_SDgenpwr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%mean_SDgenpwr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%avg_ct - Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(InData%smoothed_velocity_array,2), UBOUND(InData%smoothed_velocity_array,2) + DO i1 = LBOUND(InData%smoothed_velocity_array,1), UBOUND(InData%smoothed_velocity_array,1) + ReKiBuf(Re_Xferred) = InData%smoothed_velocity_array(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + ReKiBuf(Re_Xferred) = InData%AtmUscale + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%du_dz_ABL + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%total_SDgenpwr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%mean_SDgenpwr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%avg_ct + Re_Xferred = Re_Xferred + 1 CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, OnlySize ) ! IfW CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -8028,12 +7866,6 @@ SUBROUTINE DWM_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -8063,15 +7895,10 @@ SUBROUTINE DWM_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%turbine_thrust_force.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%turbine_thrust_force)>0) OutData%turbine_thrust_force = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%turbine_thrust_force))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%turbine_thrust_force) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%turbine_thrust_force,1), UBOUND(OutData%turbine_thrust_force,1) + OutData%turbine_thrust_force(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! induction_factor not allocated Int_Xferred = Int_Xferred + 1 @@ -8086,15 +7913,10 @@ SUBROUTINE DWM_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%induction_factor.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%induction_factor)>0) OutData%induction_factor = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%induction_factor))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%induction_factor) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%induction_factor,1), UBOUND(OutData%induction_factor,1) + OutData%induction_factor(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! r_initial not allocated Int_Xferred = Int_Xferred + 1 @@ -8109,15 +7931,10 @@ SUBROUTINE DWM_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%r_initial.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%r_initial)>0) OutData%r_initial = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%r_initial))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%r_initial) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%r_initial,1), UBOUND(OutData%r_initial,1) + OutData%r_initial(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! U_initial not allocated Int_Xferred = Int_Xferred + 1 @@ -8132,15 +7949,10 @@ SUBROUTINE DWM_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%U_initial.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%U_initial)>0) OutData%U_initial = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%U_initial))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%U_initial) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%U_initial,1), UBOUND(OutData%U_initial,1) + OutData%U_initial(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Mean_FFWS_array not allocated Int_Xferred = Int_Xferred + 1 @@ -8155,22 +7967,17 @@ SUBROUTINE DWM_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mean_FFWS_array.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Mean_FFWS_array)>0) OutData%Mean_FFWS_array = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Mean_FFWS_array))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Mean_FFWS_array) - DEALLOCATE(mask1) - END IF - OutData%Mean_FFWS = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TI = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TI_downstream = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%Mean_FFWS_array,1), UBOUND(OutData%Mean_FFWS_array,1) + OutData%Mean_FFWS_array(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%Mean_FFWS = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TI = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TI_downstream = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! wake_u not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -8187,15 +7994,12 @@ SUBROUTINE DWM_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%wake_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%wake_u)>0) OutData%wake_u = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%wake_u))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%wake_u) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%wake_u,2), UBOUND(OutData%wake_u,2) + DO i1 = LBOUND(OutData%wake_u,1), UBOUND(OutData%wake_u,1) + OutData%wake_u(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! wake_position not allocated Int_Xferred = Int_Xferred + 1 @@ -8216,15 +8020,14 @@ SUBROUTINE DWM_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%wake_position.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%wake_position)>0) OutData%wake_position = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%wake_position))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%wake_position) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%wake_position,3), UBOUND(OutData%wake_position,3) + DO i2 = LBOUND(OutData%wake_position,2), UBOUND(OutData%wake_position,2) + DO i1 = LBOUND(OutData%wake_position,1), UBOUND(OutData%wake_position,1) + OutData%wake_position(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 ! smoothed_velocity_array not allocated Int_Xferred = Int_Xferred + 1 @@ -8242,26 +8045,23 @@ SUBROUTINE DWM_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%smoothed_velocity_array.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%smoothed_velocity_array)>0) OutData%smoothed_velocity_array = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%smoothed_velocity_array))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%smoothed_velocity_array) - DEALLOCATE(mask2) - END IF - OutData%AtmUscale = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%du_dz_ABL = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%total_SDgenpwr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%mean_SDgenpwr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%avg_ct = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(OutData%smoothed_velocity_array,2), UBOUND(OutData%smoothed_velocity_array,2) + DO i1 = LBOUND(OutData%smoothed_velocity_array,1), UBOUND(OutData%smoothed_velocity_array,1) + OutData%smoothed_velocity_array(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%AtmUscale = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%du_dz_ABL = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%total_SDgenpwr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%mean_SDgenpwr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%avg_ct = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -8417,8 +8217,8 @@ SUBROUTINE DWM_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dummy - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dummy + Re_Xferred = Re_Xferred + 1 CALL InflowWind_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, OnlySize ) ! IfW CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -8462,12 +8262,6 @@ SUBROUTINE DWM_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DWM_UnPackContState' @@ -8481,8 +8275,8 @@ SUBROUTINE DWM_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%dummy = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%dummy = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -8638,8 +8432,8 @@ SUBROUTINE DWM_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dummy - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dummy + Re_Xferred = Re_Xferred + 1 CALL InflowWind_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, OnlySize ) ! IfW CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -8683,12 +8477,6 @@ SUBROUTINE DWM_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DWM_UnPackDiscState' @@ -8702,8 +8490,8 @@ SUBROUTINE DWM_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%dummy = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%dummy = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -8859,8 +8647,8 @@ SUBROUTINE DWM_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dummy - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dummy + Re_Xferred = Re_Xferred + 1 CALL InflowWind_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, OnlySize ) ! IfW CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -8904,12 +8692,6 @@ SUBROUTINE DWM_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DWM_UnPackConstrState' @@ -8923,8 +8705,8 @@ SUBROUTINE DWM_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%dummy = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%dummy = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -9080,8 +8862,8 @@ SUBROUTINE DWM_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dummy - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dummy + Re_Xferred = Re_Xferred + 1 CALL InflowWind_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, OnlySize ) ! IfW CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -9125,12 +8907,6 @@ SUBROUTINE DWM_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DWM_UnPackInitInput' @@ -9144,8 +8920,8 @@ SUBROUTINE DWM_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%dummy = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%dummy = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -9301,8 +9077,8 @@ SUBROUTINE DWM_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dummy - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dummy + Re_Xferred = Re_Xferred + 1 CALL InflowWind_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, OnlySize ) ! IfW CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -9346,12 +9122,6 @@ SUBROUTINE DWM_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DWM_UnPackInitOutput' @@ -9365,8 +9135,8 @@ SUBROUTINE DWM_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%dummy = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%dummy = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -9484,18 +9254,18 @@ SUBROUTINE DWM_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: b3 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: c3 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:,:) :: b4 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:,:) :: c4 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! 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 :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts + INTEGER :: i04 ! dim4 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + INTEGER :: i3 ! dim3 counter variable for arrays + INTEGER :: i4 ! dim4 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -9508,97 +9278,89 @@ SUBROUTINE DWM_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ALLOCATED(u_out%Upwind_result%upwind_U) .AND. ALLOCATED(u1%Upwind_result%upwind_U)) THEN - ALLOCATE(b2(SIZE(u_out%Upwind_result%upwind_U,1),SIZE(u_out%Upwind_result%upwind_U,2) )) - ALLOCATE(c2(SIZE(u_out%Upwind_result%upwind_U,1),SIZE(u_out%Upwind_result%upwind_U,2) )) - b2 = -(u1%Upwind_result%upwind_U - u2%Upwind_result%upwind_U)/t(2) - u_out%Upwind_result%upwind_U = u1%Upwind_result%upwind_U + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%Upwind_result%upwind_U,2),UBOUND(u_out%Upwind_result%upwind_U,2) + DO i1 = LBOUND(u_out%Upwind_result%upwind_U,1),UBOUND(u_out%Upwind_result%upwind_U,1) + b = -(u1%Upwind_result%upwind_U(i1,i2) - u2%Upwind_result%upwind_U(i1,i2)) + u_out%Upwind_result%upwind_U(i1,i2) = u1%Upwind_result%upwind_U(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Upwind_result%upwind_wakecenter) .AND. ALLOCATED(u1%Upwind_result%upwind_wakecenter)) THEN - ALLOCATE(b4(SIZE(u_out%Upwind_result%upwind_wakecenter,1),SIZE(u_out%Upwind_result%upwind_wakecenter,2), & - SIZE(u_out%Upwind_result%upwind_wakecenter,3),SIZE(u_out%Upwind_result%upwind_wakecenter,4) )) - ALLOCATE(c4(SIZE(u_out%Upwind_result%upwind_wakecenter,1),SIZE(u_out%Upwind_result%upwind_wakecenter,2), & - SIZE(u_out%Upwind_result%upwind_wakecenter,3),SIZE(u_out%Upwind_result%upwind_wakecenter,4) )) - b4 = -(u1%Upwind_result%upwind_wakecenter - u2%Upwind_result%upwind_wakecenter)/t(2) - u_out%Upwind_result%upwind_wakecenter = u1%Upwind_result%upwind_wakecenter + b4 * t_out - DEALLOCATE(b4) - DEALLOCATE(c4) + DO i4 = LBOUND(u_out%Upwind_result%upwind_wakecenter,4),UBOUND(u_out%Upwind_result%upwind_wakecenter,4) + DO i3 = LBOUND(u_out%Upwind_result%upwind_wakecenter,3),UBOUND(u_out%Upwind_result%upwind_wakecenter,3) + DO i2 = LBOUND(u_out%Upwind_result%upwind_wakecenter,2),UBOUND(u_out%Upwind_result%upwind_wakecenter,2) + DO i1 = LBOUND(u_out%Upwind_result%upwind_wakecenter,1),UBOUND(u_out%Upwind_result%upwind_wakecenter,1) + b = -(u1%Upwind_result%upwind_wakecenter(i1,i2,i3,i4) - u2%Upwind_result%upwind_wakecenter(i1,i2,i3,i4)) + u_out%Upwind_result%upwind_wakecenter(i1,i2,i3,i4) = u1%Upwind_result%upwind_wakecenter(i1,i2,i3,i4) + b * ScaleFactor + END DO + END DO + END DO + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Upwind_result%upwind_meanU) .AND. ALLOCATED(u1%Upwind_result%upwind_meanU)) THEN - ALLOCATE(b1(SIZE(u_out%Upwind_result%upwind_meanU,1))) - ALLOCATE(c1(SIZE(u_out%Upwind_result%upwind_meanU,1))) - b1 = -(u1%Upwind_result%upwind_meanU - u2%Upwind_result%upwind_meanU)/t(2) - u_out%Upwind_result%upwind_meanU = u1%Upwind_result%upwind_meanU + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%Upwind_result%upwind_meanU,1),UBOUND(u_out%Upwind_result%upwind_meanU,1) + b = -(u1%Upwind_result%upwind_meanU(i1) - u2%Upwind_result%upwind_meanU(i1)) + u_out%Upwind_result%upwind_meanU(i1) = u1%Upwind_result%upwind_meanU(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Upwind_result%upwind_TI) .AND. ALLOCATED(u1%Upwind_result%upwind_TI)) THEN - ALLOCATE(b1(SIZE(u_out%Upwind_result%upwind_TI,1))) - ALLOCATE(c1(SIZE(u_out%Upwind_result%upwind_TI,1))) - b1 = -(u1%Upwind_result%upwind_TI - u2%Upwind_result%upwind_TI)/t(2) - u_out%Upwind_result%upwind_TI = u1%Upwind_result%upwind_TI + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%Upwind_result%upwind_TI,1),UBOUND(u_out%Upwind_result%upwind_TI,1) + b = -(u1%Upwind_result%upwind_TI(i1) - u2%Upwind_result%upwind_TI(i1)) + u_out%Upwind_result%upwind_TI(i1) = u1%Upwind_result%upwind_TI(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Upwind_result%upwind_small_TI) .AND. ALLOCATED(u1%Upwind_result%upwind_small_TI)) THEN - ALLOCATE(b1(SIZE(u_out%Upwind_result%upwind_small_TI,1))) - ALLOCATE(c1(SIZE(u_out%Upwind_result%upwind_small_TI,1))) - b1 = -(u1%Upwind_result%upwind_small_TI - u2%Upwind_result%upwind_small_TI)/t(2) - u_out%Upwind_result%upwind_small_TI = u1%Upwind_result%upwind_small_TI + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%Upwind_result%upwind_small_TI,1),UBOUND(u_out%Upwind_result%upwind_small_TI,1) + b = -(u1%Upwind_result%upwind_small_TI(i1) - u2%Upwind_result%upwind_small_TI(i1)) + u_out%Upwind_result%upwind_small_TI(i1) = u1%Upwind_result%upwind_small_TI(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Upwind_result%upwind_smoothWake) .AND. ALLOCATED(u1%Upwind_result%upwind_smoothWake)) THEN - ALLOCATE(b2(SIZE(u_out%Upwind_result%upwind_smoothWake,1),SIZE(u_out%Upwind_result%upwind_smoothWake,2) )) - ALLOCATE(c2(SIZE(u_out%Upwind_result%upwind_smoothWake,1),SIZE(u_out%Upwind_result%upwind_smoothWake,2) )) - b2 = -(u1%Upwind_result%upwind_smoothWake - u2%Upwind_result%upwind_smoothWake)/t(2) - u_out%Upwind_result%upwind_smoothWake = u1%Upwind_result%upwind_smoothWake + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%Upwind_result%upwind_smoothWake,2),UBOUND(u_out%Upwind_result%upwind_smoothWake,2) + DO i1 = LBOUND(u_out%Upwind_result%upwind_smoothWake,1),UBOUND(u_out%Upwind_result%upwind_smoothWake,1) + b = -(u1%Upwind_result%upwind_smoothWake(i1,i2) - u2%Upwind_result%upwind_smoothWake(i1,i2)) + u_out%Upwind_result%upwind_smoothWake(i1,i2) = u1%Upwind_result%upwind_smoothWake(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Upwind_result%velocity_aerodyn) .AND. ALLOCATED(u1%Upwind_result%velocity_aerodyn)) THEN - ALLOCATE(b1(SIZE(u_out%Upwind_result%velocity_aerodyn,1))) - ALLOCATE(c1(SIZE(u_out%Upwind_result%velocity_aerodyn,1))) - b1 = -(u1%Upwind_result%velocity_aerodyn - u2%Upwind_result%velocity_aerodyn)/t(2) - u_out%Upwind_result%velocity_aerodyn = u1%Upwind_result%velocity_aerodyn + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%Upwind_result%velocity_aerodyn,1),UBOUND(u_out%Upwind_result%velocity_aerodyn,1) + b = -(u1%Upwind_result%velocity_aerodyn(i1) - u2%Upwind_result%velocity_aerodyn(i1)) + u_out%Upwind_result%velocity_aerodyn(i1) = u1%Upwind_result%velocity_aerodyn(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Upwind_result%TI_downstream) .AND. ALLOCATED(u1%Upwind_result%TI_downstream)) THEN - ALLOCATE(b1(SIZE(u_out%Upwind_result%TI_downstream,1))) - ALLOCATE(c1(SIZE(u_out%Upwind_result%TI_downstream,1))) - b1 = -(u1%Upwind_result%TI_downstream - u2%Upwind_result%TI_downstream)/t(2) - u_out%Upwind_result%TI_downstream = u1%Upwind_result%TI_downstream + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%Upwind_result%TI_downstream,1),UBOUND(u_out%Upwind_result%TI_downstream,1) + b = -(u1%Upwind_result%TI_downstream(i1) - u2%Upwind_result%TI_downstream(i1)) + u_out%Upwind_result%TI_downstream(i1) = u1%Upwind_result%TI_downstream(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Upwind_result%small_scale_TI_downstream) .AND. ALLOCATED(u1%Upwind_result%small_scale_TI_downstream)) THEN - ALLOCATE(b1(SIZE(u_out%Upwind_result%small_scale_TI_downstream,1))) - ALLOCATE(c1(SIZE(u_out%Upwind_result%small_scale_TI_downstream,1))) - b1 = -(u1%Upwind_result%small_scale_TI_downstream - u2%Upwind_result%small_scale_TI_downstream)/t(2) - u_out%Upwind_result%small_scale_TI_downstream = u1%Upwind_result%small_scale_TI_downstream + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%Upwind_result%small_scale_TI_downstream,1),UBOUND(u_out%Upwind_result%small_scale_TI_downstream,1) + b = -(u1%Upwind_result%small_scale_TI_downstream(i1) - u2%Upwind_result%small_scale_TI_downstream(i1)) + u_out%Upwind_result%small_scale_TI_downstream(i1) = u1%Upwind_result%small_scale_TI_downstream(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Upwind_result%smoothed_velocity_array) .AND. ALLOCATED(u1%Upwind_result%smoothed_velocity_array)) THEN - ALLOCATE(b2(SIZE(u_out%Upwind_result%smoothed_velocity_array,1),SIZE(u_out%Upwind_result%smoothed_velocity_array,2) )) - ALLOCATE(c2(SIZE(u_out%Upwind_result%smoothed_velocity_array,1),SIZE(u_out%Upwind_result%smoothed_velocity_array,2) )) - b2 = -(u1%Upwind_result%smoothed_velocity_array - u2%Upwind_result%smoothed_velocity_array)/t(2) - u_out%Upwind_result%smoothed_velocity_array = u1%Upwind_result%smoothed_velocity_array + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%Upwind_result%smoothed_velocity_array,2),UBOUND(u_out%Upwind_result%smoothed_velocity_array,2) + DO i1 = LBOUND(u_out%Upwind_result%smoothed_velocity_array,1),UBOUND(u_out%Upwind_result%smoothed_velocity_array,1) + b = -(u1%Upwind_result%smoothed_velocity_array(i1,i2) - u2%Upwind_result%smoothed_velocity_array(i1,i2)) + u_out%Upwind_result%smoothed_velocity_array(i1,i2) = u1%Upwind_result%smoothed_velocity_array(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Upwind_result%vel_matrix) .AND. ALLOCATED(u1%Upwind_result%vel_matrix)) THEN - ALLOCATE(b3(SIZE(u_out%Upwind_result%vel_matrix,1),SIZE(u_out%Upwind_result%vel_matrix,2), & - SIZE(u_out%Upwind_result%vel_matrix,3) )) - ALLOCATE(c3(SIZE(u_out%Upwind_result%vel_matrix,1),SIZE(u_out%Upwind_result%vel_matrix,2), & - SIZE(u_out%Upwind_result%vel_matrix,3) )) - b3 = -(u1%Upwind_result%vel_matrix - u2%Upwind_result%vel_matrix)/t(2) - u_out%Upwind_result%vel_matrix = u1%Upwind_result%vel_matrix + b3 * t_out - DEALLOCATE(b3) - DEALLOCATE(c3) + DO i3 = LBOUND(u_out%Upwind_result%vel_matrix,3),UBOUND(u_out%Upwind_result%vel_matrix,3) + DO i2 = LBOUND(u_out%Upwind_result%vel_matrix,2),UBOUND(u_out%Upwind_result%vel_matrix,2) + DO i1 = LBOUND(u_out%Upwind_result%vel_matrix,1),UBOUND(u_out%Upwind_result%vel_matrix,1) + b = -(u1%Upwind_result%vel_matrix(i1,i2,i3) - u2%Upwind_result%vel_matrix(i1,i2,i3)) + u_out%Upwind_result%vel_matrix(i1,i2,i3) = u1%Upwind_result%vel_matrix(i1,i2,i3) + b * ScaleFactor + END DO + END DO + END DO END IF ! check if allocated CALL InflowWind_Input_ExtrapInterp1( u1%IfW, u2%IfW, tin, u_out%IfW, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) @@ -9631,19 +9393,20 @@ SUBROUTINE DWM_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Err REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: b3 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: c3 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:,:) :: b4 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:,:) :: c4 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts + INTEGER :: i04 ! dim4 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + INTEGER :: i3 ! dim3 counter variable for arrays + INTEGER :: i4 ! dim4 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -9662,108 +9425,100 @@ SUBROUTINE DWM_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ALLOCATED(u_out%Upwind_result%upwind_U) .AND. ALLOCATED(u1%Upwind_result%upwind_U)) THEN - ALLOCATE(b2(SIZE(u_out%Upwind_result%upwind_U,1),SIZE(u_out%Upwind_result%upwind_U,2) )) - ALLOCATE(c2(SIZE(u_out%Upwind_result%upwind_U,1),SIZE(u_out%Upwind_result%upwind_U,2) )) - b2 = (t(3)**2*(u1%Upwind_result%upwind_U - u2%Upwind_result%upwind_U) + t(2)**2*(-u1%Upwind_result%upwind_U + u3%Upwind_result%upwind_U))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%Upwind_result%upwind_U + t(3)*u2%Upwind_result%upwind_U - t(2)*u3%Upwind_result%upwind_U ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Upwind_result%upwind_U = u1%Upwind_result%upwind_U + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%Upwind_result%upwind_U,2),UBOUND(u_out%Upwind_result%upwind_U,2) + DO i1 = LBOUND(u_out%Upwind_result%upwind_U,1),UBOUND(u_out%Upwind_result%upwind_U,1) + b = (t(3)**2*(u1%Upwind_result%upwind_U(i1,i2) - u2%Upwind_result%upwind_U(i1,i2)) + t(2)**2*(-u1%Upwind_result%upwind_U(i1,i2) + u3%Upwind_result%upwind_U(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%Upwind_result%upwind_U(i1,i2) + t(3)*u2%Upwind_result%upwind_U(i1,i2) - t(2)*u3%Upwind_result%upwind_U(i1,i2) ) * scaleFactor + u_out%Upwind_result%upwind_U(i1,i2) = u1%Upwind_result%upwind_U(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Upwind_result%upwind_wakecenter) .AND. ALLOCATED(u1%Upwind_result%upwind_wakecenter)) THEN - ALLOCATE(b4(SIZE(u_out%Upwind_result%upwind_wakecenter,1),SIZE(u_out%Upwind_result%upwind_wakecenter,2), & - SIZE(u_out%Upwind_result%upwind_wakecenter,3),SIZE(u_out%Upwind_result%upwind_wakecenter,4) )) - ALLOCATE(c4(SIZE(u_out%Upwind_result%upwind_wakecenter,1),SIZE(u_out%Upwind_result%upwind_wakecenter,2), & - SIZE(u_out%Upwind_result%upwind_wakecenter,3),SIZE(u_out%Upwind_result%upwind_wakecenter,4) )) - b4 = (t(3)**2*(u1%Upwind_result%upwind_wakecenter - u2%Upwind_result%upwind_wakecenter) + t(2)**2*(-u1%Upwind_result%upwind_wakecenter + u3%Upwind_result%upwind_wakecenter))/(t(2)*t(3)*(t(2) - t(3))) - c4 = ( (t(2)-t(3))*u1%Upwind_result%upwind_wakecenter + t(3)*u2%Upwind_result%upwind_wakecenter - t(2)*u3%Upwind_result%upwind_wakecenter ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Upwind_result%upwind_wakecenter = u1%Upwind_result%upwind_wakecenter + b4 * t_out + c4 * t_out**2 - DEALLOCATE(b4) - DEALLOCATE(c4) + DO i4 = LBOUND(u_out%Upwind_result%upwind_wakecenter,4),UBOUND(u_out%Upwind_result%upwind_wakecenter,4) + DO i3 = LBOUND(u_out%Upwind_result%upwind_wakecenter,3),UBOUND(u_out%Upwind_result%upwind_wakecenter,3) + DO i2 = LBOUND(u_out%Upwind_result%upwind_wakecenter,2),UBOUND(u_out%Upwind_result%upwind_wakecenter,2) + DO i1 = LBOUND(u_out%Upwind_result%upwind_wakecenter,1),UBOUND(u_out%Upwind_result%upwind_wakecenter,1) + b = (t(3)**2*(u1%Upwind_result%upwind_wakecenter(i1,i2,i3,i4) - u2%Upwind_result%upwind_wakecenter(i1,i2,i3,i4)) + t(2)**2*(-u1%Upwind_result%upwind_wakecenter(i1,i2,i3,i4) + u3%Upwind_result%upwind_wakecenter(i1,i2,i3,i4)))* scaleFactor + c = ( (t(2)-t(3))*u1%Upwind_result%upwind_wakecenter(i1,i2,i3,i4) + t(3)*u2%Upwind_result%upwind_wakecenter(i1,i2,i3,i4) - t(2)*u3%Upwind_result%upwind_wakecenter(i1,i2,i3,i4) ) * scaleFactor + u_out%Upwind_result%upwind_wakecenter(i1,i2,i3,i4) = u1%Upwind_result%upwind_wakecenter(i1,i2,i3,i4) + b + c * t_out + END DO + END DO + END DO + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Upwind_result%upwind_meanU) .AND. ALLOCATED(u1%Upwind_result%upwind_meanU)) THEN - ALLOCATE(b1(SIZE(u_out%Upwind_result%upwind_meanU,1))) - ALLOCATE(c1(SIZE(u_out%Upwind_result%upwind_meanU,1))) - b1 = (t(3)**2*(u1%Upwind_result%upwind_meanU - u2%Upwind_result%upwind_meanU) + t(2)**2*(-u1%Upwind_result%upwind_meanU + u3%Upwind_result%upwind_meanU))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%Upwind_result%upwind_meanU + t(3)*u2%Upwind_result%upwind_meanU - t(2)*u3%Upwind_result%upwind_meanU ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Upwind_result%upwind_meanU = u1%Upwind_result%upwind_meanU + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%Upwind_result%upwind_meanU,1),UBOUND(u_out%Upwind_result%upwind_meanU,1) + b = (t(3)**2*(u1%Upwind_result%upwind_meanU(i1) - u2%Upwind_result%upwind_meanU(i1)) + t(2)**2*(-u1%Upwind_result%upwind_meanU(i1) + u3%Upwind_result%upwind_meanU(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%Upwind_result%upwind_meanU(i1) + t(3)*u2%Upwind_result%upwind_meanU(i1) - t(2)*u3%Upwind_result%upwind_meanU(i1) ) * scaleFactor + u_out%Upwind_result%upwind_meanU(i1) = u1%Upwind_result%upwind_meanU(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Upwind_result%upwind_TI) .AND. ALLOCATED(u1%Upwind_result%upwind_TI)) THEN - ALLOCATE(b1(SIZE(u_out%Upwind_result%upwind_TI,1))) - ALLOCATE(c1(SIZE(u_out%Upwind_result%upwind_TI,1))) - b1 = (t(3)**2*(u1%Upwind_result%upwind_TI - u2%Upwind_result%upwind_TI) + t(2)**2*(-u1%Upwind_result%upwind_TI + u3%Upwind_result%upwind_TI))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%Upwind_result%upwind_TI + t(3)*u2%Upwind_result%upwind_TI - t(2)*u3%Upwind_result%upwind_TI ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Upwind_result%upwind_TI = u1%Upwind_result%upwind_TI + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%Upwind_result%upwind_TI,1),UBOUND(u_out%Upwind_result%upwind_TI,1) + b = (t(3)**2*(u1%Upwind_result%upwind_TI(i1) - u2%Upwind_result%upwind_TI(i1)) + t(2)**2*(-u1%Upwind_result%upwind_TI(i1) + u3%Upwind_result%upwind_TI(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%Upwind_result%upwind_TI(i1) + t(3)*u2%Upwind_result%upwind_TI(i1) - t(2)*u3%Upwind_result%upwind_TI(i1) ) * scaleFactor + u_out%Upwind_result%upwind_TI(i1) = u1%Upwind_result%upwind_TI(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Upwind_result%upwind_small_TI) .AND. ALLOCATED(u1%Upwind_result%upwind_small_TI)) THEN - ALLOCATE(b1(SIZE(u_out%Upwind_result%upwind_small_TI,1))) - ALLOCATE(c1(SIZE(u_out%Upwind_result%upwind_small_TI,1))) - b1 = (t(3)**2*(u1%Upwind_result%upwind_small_TI - u2%Upwind_result%upwind_small_TI) + t(2)**2*(-u1%Upwind_result%upwind_small_TI + u3%Upwind_result%upwind_small_TI))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%Upwind_result%upwind_small_TI + t(3)*u2%Upwind_result%upwind_small_TI - t(2)*u3%Upwind_result%upwind_small_TI ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Upwind_result%upwind_small_TI = u1%Upwind_result%upwind_small_TI + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%Upwind_result%upwind_small_TI,1),UBOUND(u_out%Upwind_result%upwind_small_TI,1) + b = (t(3)**2*(u1%Upwind_result%upwind_small_TI(i1) - u2%Upwind_result%upwind_small_TI(i1)) + t(2)**2*(-u1%Upwind_result%upwind_small_TI(i1) + u3%Upwind_result%upwind_small_TI(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%Upwind_result%upwind_small_TI(i1) + t(3)*u2%Upwind_result%upwind_small_TI(i1) - t(2)*u3%Upwind_result%upwind_small_TI(i1) ) * scaleFactor + u_out%Upwind_result%upwind_small_TI(i1) = u1%Upwind_result%upwind_small_TI(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Upwind_result%upwind_smoothWake) .AND. ALLOCATED(u1%Upwind_result%upwind_smoothWake)) THEN - ALLOCATE(b2(SIZE(u_out%Upwind_result%upwind_smoothWake,1),SIZE(u_out%Upwind_result%upwind_smoothWake,2) )) - ALLOCATE(c2(SIZE(u_out%Upwind_result%upwind_smoothWake,1),SIZE(u_out%Upwind_result%upwind_smoothWake,2) )) - b2 = (t(3)**2*(u1%Upwind_result%upwind_smoothWake - u2%Upwind_result%upwind_smoothWake) + t(2)**2*(-u1%Upwind_result%upwind_smoothWake + u3%Upwind_result%upwind_smoothWake))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%Upwind_result%upwind_smoothWake + t(3)*u2%Upwind_result%upwind_smoothWake - t(2)*u3%Upwind_result%upwind_smoothWake ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Upwind_result%upwind_smoothWake = u1%Upwind_result%upwind_smoothWake + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%Upwind_result%upwind_smoothWake,2),UBOUND(u_out%Upwind_result%upwind_smoothWake,2) + DO i1 = LBOUND(u_out%Upwind_result%upwind_smoothWake,1),UBOUND(u_out%Upwind_result%upwind_smoothWake,1) + b = (t(3)**2*(u1%Upwind_result%upwind_smoothWake(i1,i2) - u2%Upwind_result%upwind_smoothWake(i1,i2)) + t(2)**2*(-u1%Upwind_result%upwind_smoothWake(i1,i2) + u3%Upwind_result%upwind_smoothWake(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%Upwind_result%upwind_smoothWake(i1,i2) + t(3)*u2%Upwind_result%upwind_smoothWake(i1,i2) - t(2)*u3%Upwind_result%upwind_smoothWake(i1,i2) ) * scaleFactor + u_out%Upwind_result%upwind_smoothWake(i1,i2) = u1%Upwind_result%upwind_smoothWake(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Upwind_result%velocity_aerodyn) .AND. ALLOCATED(u1%Upwind_result%velocity_aerodyn)) THEN - ALLOCATE(b1(SIZE(u_out%Upwind_result%velocity_aerodyn,1))) - ALLOCATE(c1(SIZE(u_out%Upwind_result%velocity_aerodyn,1))) - b1 = (t(3)**2*(u1%Upwind_result%velocity_aerodyn - u2%Upwind_result%velocity_aerodyn) + t(2)**2*(-u1%Upwind_result%velocity_aerodyn + u3%Upwind_result%velocity_aerodyn))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%Upwind_result%velocity_aerodyn + t(3)*u2%Upwind_result%velocity_aerodyn - t(2)*u3%Upwind_result%velocity_aerodyn ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Upwind_result%velocity_aerodyn = u1%Upwind_result%velocity_aerodyn + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%Upwind_result%velocity_aerodyn,1),UBOUND(u_out%Upwind_result%velocity_aerodyn,1) + b = (t(3)**2*(u1%Upwind_result%velocity_aerodyn(i1) - u2%Upwind_result%velocity_aerodyn(i1)) + t(2)**2*(-u1%Upwind_result%velocity_aerodyn(i1) + u3%Upwind_result%velocity_aerodyn(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%Upwind_result%velocity_aerodyn(i1) + t(3)*u2%Upwind_result%velocity_aerodyn(i1) - t(2)*u3%Upwind_result%velocity_aerodyn(i1) ) * scaleFactor + u_out%Upwind_result%velocity_aerodyn(i1) = u1%Upwind_result%velocity_aerodyn(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Upwind_result%TI_downstream) .AND. ALLOCATED(u1%Upwind_result%TI_downstream)) THEN - ALLOCATE(b1(SIZE(u_out%Upwind_result%TI_downstream,1))) - ALLOCATE(c1(SIZE(u_out%Upwind_result%TI_downstream,1))) - b1 = (t(3)**2*(u1%Upwind_result%TI_downstream - u2%Upwind_result%TI_downstream) + t(2)**2*(-u1%Upwind_result%TI_downstream + u3%Upwind_result%TI_downstream))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%Upwind_result%TI_downstream + t(3)*u2%Upwind_result%TI_downstream - t(2)*u3%Upwind_result%TI_downstream ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Upwind_result%TI_downstream = u1%Upwind_result%TI_downstream + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%Upwind_result%TI_downstream,1),UBOUND(u_out%Upwind_result%TI_downstream,1) + b = (t(3)**2*(u1%Upwind_result%TI_downstream(i1) - u2%Upwind_result%TI_downstream(i1)) + t(2)**2*(-u1%Upwind_result%TI_downstream(i1) + u3%Upwind_result%TI_downstream(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%Upwind_result%TI_downstream(i1) + t(3)*u2%Upwind_result%TI_downstream(i1) - t(2)*u3%Upwind_result%TI_downstream(i1) ) * scaleFactor + u_out%Upwind_result%TI_downstream(i1) = u1%Upwind_result%TI_downstream(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Upwind_result%small_scale_TI_downstream) .AND. ALLOCATED(u1%Upwind_result%small_scale_TI_downstream)) THEN - ALLOCATE(b1(SIZE(u_out%Upwind_result%small_scale_TI_downstream,1))) - ALLOCATE(c1(SIZE(u_out%Upwind_result%small_scale_TI_downstream,1))) - b1 = (t(3)**2*(u1%Upwind_result%small_scale_TI_downstream - u2%Upwind_result%small_scale_TI_downstream) + t(2)**2*(-u1%Upwind_result%small_scale_TI_downstream + u3%Upwind_result%small_scale_TI_downstream))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%Upwind_result%small_scale_TI_downstream + t(3)*u2%Upwind_result%small_scale_TI_downstream - t(2)*u3%Upwind_result%small_scale_TI_downstream ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Upwind_result%small_scale_TI_downstream = u1%Upwind_result%small_scale_TI_downstream + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%Upwind_result%small_scale_TI_downstream,1),UBOUND(u_out%Upwind_result%small_scale_TI_downstream,1) + b = (t(3)**2*(u1%Upwind_result%small_scale_TI_downstream(i1) - u2%Upwind_result%small_scale_TI_downstream(i1)) + t(2)**2*(-u1%Upwind_result%small_scale_TI_downstream(i1) + u3%Upwind_result%small_scale_TI_downstream(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%Upwind_result%small_scale_TI_downstream(i1) + t(3)*u2%Upwind_result%small_scale_TI_downstream(i1) - t(2)*u3%Upwind_result%small_scale_TI_downstream(i1) ) * scaleFactor + u_out%Upwind_result%small_scale_TI_downstream(i1) = u1%Upwind_result%small_scale_TI_downstream(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Upwind_result%smoothed_velocity_array) .AND. ALLOCATED(u1%Upwind_result%smoothed_velocity_array)) THEN - ALLOCATE(b2(SIZE(u_out%Upwind_result%smoothed_velocity_array,1),SIZE(u_out%Upwind_result%smoothed_velocity_array,2) )) - ALLOCATE(c2(SIZE(u_out%Upwind_result%smoothed_velocity_array,1),SIZE(u_out%Upwind_result%smoothed_velocity_array,2) )) - b2 = (t(3)**2*(u1%Upwind_result%smoothed_velocity_array - u2%Upwind_result%smoothed_velocity_array) + t(2)**2*(-u1%Upwind_result%smoothed_velocity_array + u3%Upwind_result%smoothed_velocity_array))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%Upwind_result%smoothed_velocity_array + t(3)*u2%Upwind_result%smoothed_velocity_array - t(2)*u3%Upwind_result%smoothed_velocity_array ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Upwind_result%smoothed_velocity_array = u1%Upwind_result%smoothed_velocity_array + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%Upwind_result%smoothed_velocity_array,2),UBOUND(u_out%Upwind_result%smoothed_velocity_array,2) + DO i1 = LBOUND(u_out%Upwind_result%smoothed_velocity_array,1),UBOUND(u_out%Upwind_result%smoothed_velocity_array,1) + b = (t(3)**2*(u1%Upwind_result%smoothed_velocity_array(i1,i2) - u2%Upwind_result%smoothed_velocity_array(i1,i2)) + t(2)**2*(-u1%Upwind_result%smoothed_velocity_array(i1,i2) + u3%Upwind_result%smoothed_velocity_array(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%Upwind_result%smoothed_velocity_array(i1,i2) + t(3)*u2%Upwind_result%smoothed_velocity_array(i1,i2) - t(2)*u3%Upwind_result%smoothed_velocity_array(i1,i2) ) * scaleFactor + u_out%Upwind_result%smoothed_velocity_array(i1,i2) = u1%Upwind_result%smoothed_velocity_array(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Upwind_result%vel_matrix) .AND. ALLOCATED(u1%Upwind_result%vel_matrix)) THEN - ALLOCATE(b3(SIZE(u_out%Upwind_result%vel_matrix,1),SIZE(u_out%Upwind_result%vel_matrix,2), & - SIZE(u_out%Upwind_result%vel_matrix,3) )) - ALLOCATE(c3(SIZE(u_out%Upwind_result%vel_matrix,1),SIZE(u_out%Upwind_result%vel_matrix,2), & - SIZE(u_out%Upwind_result%vel_matrix,3) )) - b3 = (t(3)**2*(u1%Upwind_result%vel_matrix - u2%Upwind_result%vel_matrix) + t(2)**2*(-u1%Upwind_result%vel_matrix + u3%Upwind_result%vel_matrix))/(t(2)*t(3)*(t(2) - t(3))) - c3 = ( (t(2)-t(3))*u1%Upwind_result%vel_matrix + t(3)*u2%Upwind_result%vel_matrix - t(2)*u3%Upwind_result%vel_matrix ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Upwind_result%vel_matrix = u1%Upwind_result%vel_matrix + b3 * t_out + c3 * t_out**2 - DEALLOCATE(b3) - DEALLOCATE(c3) + DO i3 = LBOUND(u_out%Upwind_result%vel_matrix,3),UBOUND(u_out%Upwind_result%vel_matrix,3) + DO i2 = LBOUND(u_out%Upwind_result%vel_matrix,2),UBOUND(u_out%Upwind_result%vel_matrix,2) + DO i1 = LBOUND(u_out%Upwind_result%vel_matrix,1),UBOUND(u_out%Upwind_result%vel_matrix,1) + b = (t(3)**2*(u1%Upwind_result%vel_matrix(i1,i2,i3) - u2%Upwind_result%vel_matrix(i1,i2,i3)) + t(2)**2*(-u1%Upwind_result%vel_matrix(i1,i2,i3) + u3%Upwind_result%vel_matrix(i1,i2,i3)))* scaleFactor + c = ( (t(2)-t(3))*u1%Upwind_result%vel_matrix(i1,i2,i3) + t(3)*u2%Upwind_result%vel_matrix(i1,i2,i3) - t(2)*u3%Upwind_result%vel_matrix(i1,i2,i3) ) * scaleFactor + u_out%Upwind_result%vel_matrix(i1,i2,i3) = u1%Upwind_result%vel_matrix(i1,i2,i3) + b + c * t_out + END DO + END DO + END DO END IF ! check if allocated CALL InflowWind_Input_ExtrapInterp2( u1%IfW, u2%IfW, u3%IfW, tin, u_out%IfW, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) @@ -9844,16 +9599,16 @@ SUBROUTINE DWM_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: b3 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: c3 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! 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 :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + INTEGER :: i3 ! dim3 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -9866,88 +9621,80 @@ SUBROUTINE DWM_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ALLOCATED(y_out%turbine_thrust_force) .AND. ALLOCATED(y1%turbine_thrust_force)) THEN - ALLOCATE(b1(SIZE(y_out%turbine_thrust_force,1))) - ALLOCATE(c1(SIZE(y_out%turbine_thrust_force,1))) - b1 = -(y1%turbine_thrust_force - y2%turbine_thrust_force)/t(2) - y_out%turbine_thrust_force = y1%turbine_thrust_force + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%turbine_thrust_force,1),UBOUND(y_out%turbine_thrust_force,1) + b = -(y1%turbine_thrust_force(i1) - y2%turbine_thrust_force(i1)) + y_out%turbine_thrust_force(i1) = y1%turbine_thrust_force(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ALLOCATED(y_out%induction_factor) .AND. ALLOCATED(y1%induction_factor)) THEN - ALLOCATE(b1(SIZE(y_out%induction_factor,1))) - ALLOCATE(c1(SIZE(y_out%induction_factor,1))) - b1 = -(y1%induction_factor - y2%induction_factor)/t(2) - y_out%induction_factor = y1%induction_factor + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%induction_factor,1),UBOUND(y_out%induction_factor,1) + b = -(y1%induction_factor(i1) - y2%induction_factor(i1)) + y_out%induction_factor(i1) = y1%induction_factor(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ALLOCATED(y_out%r_initial) .AND. ALLOCATED(y1%r_initial)) THEN - ALLOCATE(b1(SIZE(y_out%r_initial,1))) - ALLOCATE(c1(SIZE(y_out%r_initial,1))) - b1 = -(y1%r_initial - y2%r_initial)/t(2) - y_out%r_initial = y1%r_initial + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%r_initial,1),UBOUND(y_out%r_initial,1) + b = -(y1%r_initial(i1) - y2%r_initial(i1)) + y_out%r_initial(i1) = y1%r_initial(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ALLOCATED(y_out%U_initial) .AND. ALLOCATED(y1%U_initial)) THEN - ALLOCATE(b1(SIZE(y_out%U_initial,1))) - ALLOCATE(c1(SIZE(y_out%U_initial,1))) - b1 = -(y1%U_initial - y2%U_initial)/t(2) - y_out%U_initial = y1%U_initial + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%U_initial,1),UBOUND(y_out%U_initial,1) + b = -(y1%U_initial(i1) - y2%U_initial(i1)) + y_out%U_initial(i1) = y1%U_initial(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ALLOCATED(y_out%Mean_FFWS_array) .AND. ALLOCATED(y1%Mean_FFWS_array)) THEN - ALLOCATE(b1(SIZE(y_out%Mean_FFWS_array,1))) - ALLOCATE(c1(SIZE(y_out%Mean_FFWS_array,1))) - b1 = -(y1%Mean_FFWS_array - y2%Mean_FFWS_array)/t(2) - y_out%Mean_FFWS_array = y1%Mean_FFWS_array + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%Mean_FFWS_array,1),UBOUND(y_out%Mean_FFWS_array,1) + b = -(y1%Mean_FFWS_array(i1) - y2%Mean_FFWS_array(i1)) + y_out%Mean_FFWS_array(i1) = y1%Mean_FFWS_array(i1) + b * ScaleFactor + END DO END IF ! check if allocated - b0 = -(y1%Mean_FFWS - y2%Mean_FFWS)/t(2) - y_out%Mean_FFWS = y1%Mean_FFWS + b0 * t_out - b0 = -(y1%TI - y2%TI)/t(2) - y_out%TI = y1%TI + b0 * t_out - b0 = -(y1%TI_downstream - y2%TI_downstream)/t(2) - y_out%TI_downstream = y1%TI_downstream + b0 * t_out + b = -(y1%Mean_FFWS - y2%Mean_FFWS) + y_out%Mean_FFWS = y1%Mean_FFWS + b * ScaleFactor + b = -(y1%TI - y2%TI) + y_out%TI = y1%TI + b * ScaleFactor + b = -(y1%TI_downstream - y2%TI_downstream) + y_out%TI_downstream = y1%TI_downstream + b * ScaleFactor IF (ALLOCATED(y_out%wake_u) .AND. ALLOCATED(y1%wake_u)) THEN - ALLOCATE(b2(SIZE(y_out%wake_u,1),SIZE(y_out%wake_u,2) )) - ALLOCATE(c2(SIZE(y_out%wake_u,1),SIZE(y_out%wake_u,2) )) - b2 = -(y1%wake_u - y2%wake_u)/t(2) - y_out%wake_u = y1%wake_u + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%wake_u,2),UBOUND(y_out%wake_u,2) + DO i1 = LBOUND(y_out%wake_u,1),UBOUND(y_out%wake_u,1) + b = -(y1%wake_u(i1,i2) - y2%wake_u(i1,i2)) + y_out%wake_u(i1,i2) = y1%wake_u(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%wake_position) .AND. ALLOCATED(y1%wake_position)) THEN - ALLOCATE(b3(SIZE(y_out%wake_position,1),SIZE(y_out%wake_position,2), & - SIZE(y_out%wake_position,3) )) - ALLOCATE(c3(SIZE(y_out%wake_position,1),SIZE(y_out%wake_position,2), & - SIZE(y_out%wake_position,3) )) - b3 = -(y1%wake_position - y2%wake_position)/t(2) - y_out%wake_position = y1%wake_position + b3 * t_out - DEALLOCATE(b3) - DEALLOCATE(c3) + DO i3 = LBOUND(y_out%wake_position,3),UBOUND(y_out%wake_position,3) + DO i2 = LBOUND(y_out%wake_position,2),UBOUND(y_out%wake_position,2) + DO i1 = LBOUND(y_out%wake_position,1),UBOUND(y_out%wake_position,1) + b = -(y1%wake_position(i1,i2,i3) - y2%wake_position(i1,i2,i3)) + y_out%wake_position(i1,i2,i3) = y1%wake_position(i1,i2,i3) + b * ScaleFactor + END DO + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%smoothed_velocity_array) .AND. ALLOCATED(y1%smoothed_velocity_array)) THEN - ALLOCATE(b2(SIZE(y_out%smoothed_velocity_array,1),SIZE(y_out%smoothed_velocity_array,2) )) - ALLOCATE(c2(SIZE(y_out%smoothed_velocity_array,1),SIZE(y_out%smoothed_velocity_array,2) )) - b2 = -(y1%smoothed_velocity_array - y2%smoothed_velocity_array)/t(2) - y_out%smoothed_velocity_array = y1%smoothed_velocity_array + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%smoothed_velocity_array,2),UBOUND(y_out%smoothed_velocity_array,2) + DO i1 = LBOUND(y_out%smoothed_velocity_array,1),UBOUND(y_out%smoothed_velocity_array,1) + b = -(y1%smoothed_velocity_array(i1,i2) - y2%smoothed_velocity_array(i1,i2)) + y_out%smoothed_velocity_array(i1,i2) = y1%smoothed_velocity_array(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated - b0 = -(y1%AtmUscale - y2%AtmUscale)/t(2) - y_out%AtmUscale = y1%AtmUscale + b0 * t_out - b0 = -(y1%du_dz_ABL - y2%du_dz_ABL)/t(2) - y_out%du_dz_ABL = y1%du_dz_ABL + b0 * t_out - b0 = -(y1%total_SDgenpwr - y2%total_SDgenpwr)/t(2) - y_out%total_SDgenpwr = y1%total_SDgenpwr + b0 * t_out - b0 = -(y1%mean_SDgenpwr - y2%mean_SDgenpwr)/t(2) - y_out%mean_SDgenpwr = y1%mean_SDgenpwr + b0 * t_out - b0 = -(y1%avg_ct - y2%avg_ct)/t(2) - y_out%avg_ct = y1%avg_ct + b0 * t_out + b = -(y1%AtmUscale - y2%AtmUscale) + y_out%AtmUscale = y1%AtmUscale + b * ScaleFactor + b = -(y1%du_dz_ABL - y2%du_dz_ABL) + y_out%du_dz_ABL = y1%du_dz_ABL + b * ScaleFactor + b = -(y1%total_SDgenpwr - y2%total_SDgenpwr) + y_out%total_SDgenpwr = y1%total_SDgenpwr + b * ScaleFactor + b = -(y1%mean_SDgenpwr - y2%mean_SDgenpwr) + y_out%mean_SDgenpwr = y1%mean_SDgenpwr + b * ScaleFactor + b = -(y1%avg_ct - y2%avg_ct) + y_out%avg_ct = y1%avg_ct + b * ScaleFactor CALL InflowWind_Output_ExtrapInterp1( y1%IfW, y2%IfW, tin, y_out%IfW, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE DWM_Output_ExtrapInterp1 @@ -9979,17 +9726,18 @@ SUBROUTINE DWM_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: b3 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: c3 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + INTEGER :: i3 ! dim3 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -10008,104 +9756,96 @@ SUBROUTINE DWM_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ALLOCATED(y_out%turbine_thrust_force) .AND. ALLOCATED(y1%turbine_thrust_force)) THEN - ALLOCATE(b1(SIZE(y_out%turbine_thrust_force,1))) - ALLOCATE(c1(SIZE(y_out%turbine_thrust_force,1))) - b1 = (t(3)**2*(y1%turbine_thrust_force - y2%turbine_thrust_force) + t(2)**2*(-y1%turbine_thrust_force + y3%turbine_thrust_force))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%turbine_thrust_force + t(3)*y2%turbine_thrust_force - t(2)*y3%turbine_thrust_force ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%turbine_thrust_force = y1%turbine_thrust_force + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%turbine_thrust_force,1),UBOUND(y_out%turbine_thrust_force,1) + b = (t(3)**2*(y1%turbine_thrust_force(i1) - y2%turbine_thrust_force(i1)) + t(2)**2*(-y1%turbine_thrust_force(i1) + y3%turbine_thrust_force(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%turbine_thrust_force(i1) + t(3)*y2%turbine_thrust_force(i1) - t(2)*y3%turbine_thrust_force(i1) ) * scaleFactor + y_out%turbine_thrust_force(i1) = y1%turbine_thrust_force(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ALLOCATED(y_out%induction_factor) .AND. ALLOCATED(y1%induction_factor)) THEN - ALLOCATE(b1(SIZE(y_out%induction_factor,1))) - ALLOCATE(c1(SIZE(y_out%induction_factor,1))) - b1 = (t(3)**2*(y1%induction_factor - y2%induction_factor) + t(2)**2*(-y1%induction_factor + y3%induction_factor))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%induction_factor + t(3)*y2%induction_factor - t(2)*y3%induction_factor ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%induction_factor = y1%induction_factor + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%induction_factor,1),UBOUND(y_out%induction_factor,1) + b = (t(3)**2*(y1%induction_factor(i1) - y2%induction_factor(i1)) + t(2)**2*(-y1%induction_factor(i1) + y3%induction_factor(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%induction_factor(i1) + t(3)*y2%induction_factor(i1) - t(2)*y3%induction_factor(i1) ) * scaleFactor + y_out%induction_factor(i1) = y1%induction_factor(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ALLOCATED(y_out%r_initial) .AND. ALLOCATED(y1%r_initial)) THEN - ALLOCATE(b1(SIZE(y_out%r_initial,1))) - ALLOCATE(c1(SIZE(y_out%r_initial,1))) - b1 = (t(3)**2*(y1%r_initial - y2%r_initial) + t(2)**2*(-y1%r_initial + y3%r_initial))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%r_initial + t(3)*y2%r_initial - t(2)*y3%r_initial ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%r_initial = y1%r_initial + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%r_initial,1),UBOUND(y_out%r_initial,1) + b = (t(3)**2*(y1%r_initial(i1) - y2%r_initial(i1)) + t(2)**2*(-y1%r_initial(i1) + y3%r_initial(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%r_initial(i1) + t(3)*y2%r_initial(i1) - t(2)*y3%r_initial(i1) ) * scaleFactor + y_out%r_initial(i1) = y1%r_initial(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ALLOCATED(y_out%U_initial) .AND. ALLOCATED(y1%U_initial)) THEN - ALLOCATE(b1(SIZE(y_out%U_initial,1))) - ALLOCATE(c1(SIZE(y_out%U_initial,1))) - b1 = (t(3)**2*(y1%U_initial - y2%U_initial) + t(2)**2*(-y1%U_initial + y3%U_initial))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%U_initial + t(3)*y2%U_initial - t(2)*y3%U_initial ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%U_initial = y1%U_initial + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%U_initial,1),UBOUND(y_out%U_initial,1) + b = (t(3)**2*(y1%U_initial(i1) - y2%U_initial(i1)) + t(2)**2*(-y1%U_initial(i1) + y3%U_initial(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%U_initial(i1) + t(3)*y2%U_initial(i1) - t(2)*y3%U_initial(i1) ) * scaleFactor + y_out%U_initial(i1) = y1%U_initial(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ALLOCATED(y_out%Mean_FFWS_array) .AND. ALLOCATED(y1%Mean_FFWS_array)) THEN - ALLOCATE(b1(SIZE(y_out%Mean_FFWS_array,1))) - ALLOCATE(c1(SIZE(y_out%Mean_FFWS_array,1))) - b1 = (t(3)**2*(y1%Mean_FFWS_array - y2%Mean_FFWS_array) + t(2)**2*(-y1%Mean_FFWS_array + y3%Mean_FFWS_array))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%Mean_FFWS_array + t(3)*y2%Mean_FFWS_array - t(2)*y3%Mean_FFWS_array ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Mean_FFWS_array = y1%Mean_FFWS_array + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%Mean_FFWS_array,1),UBOUND(y_out%Mean_FFWS_array,1) + b = (t(3)**2*(y1%Mean_FFWS_array(i1) - y2%Mean_FFWS_array(i1)) + t(2)**2*(-y1%Mean_FFWS_array(i1) + y3%Mean_FFWS_array(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%Mean_FFWS_array(i1) + t(3)*y2%Mean_FFWS_array(i1) - t(2)*y3%Mean_FFWS_array(i1) ) * scaleFactor + y_out%Mean_FFWS_array(i1) = y1%Mean_FFWS_array(i1) + b + c * t_out + END DO END IF ! check if allocated - b0 = (t(3)**2*(y1%Mean_FFWS - y2%Mean_FFWS) + t(2)**2*(-y1%Mean_FFWS + y3%Mean_FFWS))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%Mean_FFWS + t(3)*y2%Mean_FFWS - t(2)*y3%Mean_FFWS ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Mean_FFWS = y1%Mean_FFWS + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%TI - y2%TI) + t(2)**2*(-y1%TI + y3%TI))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%TI + t(3)*y2%TI - t(2)*y3%TI ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%TI = y1%TI + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%TI_downstream - y2%TI_downstream) + t(2)**2*(-y1%TI_downstream + y3%TI_downstream))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%TI_downstream + t(3)*y2%TI_downstream - t(2)*y3%TI_downstream ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%TI_downstream = y1%TI_downstream + b0 * t_out + c0 * t_out**2 + b = (t(3)**2*(y1%Mean_FFWS - y2%Mean_FFWS) + t(2)**2*(-y1%Mean_FFWS + y3%Mean_FFWS))* scaleFactor + c = ( (t(2)-t(3))*y1%Mean_FFWS + t(3)*y2%Mean_FFWS - t(2)*y3%Mean_FFWS ) * scaleFactor + y_out%Mean_FFWS = y1%Mean_FFWS + b + c * t_out + b = (t(3)**2*(y1%TI - y2%TI) + t(2)**2*(-y1%TI + y3%TI))* scaleFactor + c = ( (t(2)-t(3))*y1%TI + t(3)*y2%TI - t(2)*y3%TI ) * scaleFactor + y_out%TI = y1%TI + b + c * t_out + b = (t(3)**2*(y1%TI_downstream - y2%TI_downstream) + t(2)**2*(-y1%TI_downstream + y3%TI_downstream))* scaleFactor + c = ( (t(2)-t(3))*y1%TI_downstream + t(3)*y2%TI_downstream - t(2)*y3%TI_downstream ) * scaleFactor + y_out%TI_downstream = y1%TI_downstream + b + c * t_out IF (ALLOCATED(y_out%wake_u) .AND. ALLOCATED(y1%wake_u)) THEN - ALLOCATE(b2(SIZE(y_out%wake_u,1),SIZE(y_out%wake_u,2) )) - ALLOCATE(c2(SIZE(y_out%wake_u,1),SIZE(y_out%wake_u,2) )) - b2 = (t(3)**2*(y1%wake_u - y2%wake_u) + t(2)**2*(-y1%wake_u + y3%wake_u))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*y1%wake_u + t(3)*y2%wake_u - t(2)*y3%wake_u ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%wake_u = y1%wake_u + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%wake_u,2),UBOUND(y_out%wake_u,2) + DO i1 = LBOUND(y_out%wake_u,1),UBOUND(y_out%wake_u,1) + b = (t(3)**2*(y1%wake_u(i1,i2) - y2%wake_u(i1,i2)) + t(2)**2*(-y1%wake_u(i1,i2) + y3%wake_u(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*y1%wake_u(i1,i2) + t(3)*y2%wake_u(i1,i2) - t(2)*y3%wake_u(i1,i2) ) * scaleFactor + y_out%wake_u(i1,i2) = y1%wake_u(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%wake_position) .AND. ALLOCATED(y1%wake_position)) THEN - ALLOCATE(b3(SIZE(y_out%wake_position,1),SIZE(y_out%wake_position,2), & - SIZE(y_out%wake_position,3) )) - ALLOCATE(c3(SIZE(y_out%wake_position,1),SIZE(y_out%wake_position,2), & - SIZE(y_out%wake_position,3) )) - b3 = (t(3)**2*(y1%wake_position - y2%wake_position) + t(2)**2*(-y1%wake_position + y3%wake_position))/(t(2)*t(3)*(t(2) - t(3))) - c3 = ( (t(2)-t(3))*y1%wake_position + t(3)*y2%wake_position - t(2)*y3%wake_position ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%wake_position = y1%wake_position + b3 * t_out + c3 * t_out**2 - DEALLOCATE(b3) - DEALLOCATE(c3) + DO i3 = LBOUND(y_out%wake_position,3),UBOUND(y_out%wake_position,3) + DO i2 = LBOUND(y_out%wake_position,2),UBOUND(y_out%wake_position,2) + DO i1 = LBOUND(y_out%wake_position,1),UBOUND(y_out%wake_position,1) + b = (t(3)**2*(y1%wake_position(i1,i2,i3) - y2%wake_position(i1,i2,i3)) + t(2)**2*(-y1%wake_position(i1,i2,i3) + y3%wake_position(i1,i2,i3)))* scaleFactor + c = ( (t(2)-t(3))*y1%wake_position(i1,i2,i3) + t(3)*y2%wake_position(i1,i2,i3) - t(2)*y3%wake_position(i1,i2,i3) ) * scaleFactor + y_out%wake_position(i1,i2,i3) = y1%wake_position(i1,i2,i3) + b + c * t_out + END DO + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%smoothed_velocity_array) .AND. ALLOCATED(y1%smoothed_velocity_array)) THEN - ALLOCATE(b2(SIZE(y_out%smoothed_velocity_array,1),SIZE(y_out%smoothed_velocity_array,2) )) - ALLOCATE(c2(SIZE(y_out%smoothed_velocity_array,1),SIZE(y_out%smoothed_velocity_array,2) )) - b2 = (t(3)**2*(y1%smoothed_velocity_array - y2%smoothed_velocity_array) + t(2)**2*(-y1%smoothed_velocity_array + y3%smoothed_velocity_array))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*y1%smoothed_velocity_array + t(3)*y2%smoothed_velocity_array - t(2)*y3%smoothed_velocity_array ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%smoothed_velocity_array = y1%smoothed_velocity_array + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%smoothed_velocity_array,2),UBOUND(y_out%smoothed_velocity_array,2) + DO i1 = LBOUND(y_out%smoothed_velocity_array,1),UBOUND(y_out%smoothed_velocity_array,1) + b = (t(3)**2*(y1%smoothed_velocity_array(i1,i2) - y2%smoothed_velocity_array(i1,i2)) + t(2)**2*(-y1%smoothed_velocity_array(i1,i2) + y3%smoothed_velocity_array(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*y1%smoothed_velocity_array(i1,i2) + t(3)*y2%smoothed_velocity_array(i1,i2) - t(2)*y3%smoothed_velocity_array(i1,i2) ) * scaleFactor + y_out%smoothed_velocity_array(i1,i2) = y1%smoothed_velocity_array(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated - b0 = (t(3)**2*(y1%AtmUscale - y2%AtmUscale) + t(2)**2*(-y1%AtmUscale + y3%AtmUscale))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%AtmUscale + t(3)*y2%AtmUscale - t(2)*y3%AtmUscale ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%AtmUscale = y1%AtmUscale + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%du_dz_ABL - y2%du_dz_ABL) + t(2)**2*(-y1%du_dz_ABL + y3%du_dz_ABL))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%du_dz_ABL + t(3)*y2%du_dz_ABL - t(2)*y3%du_dz_ABL ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%du_dz_ABL = y1%du_dz_ABL + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%total_SDgenpwr - y2%total_SDgenpwr) + t(2)**2*(-y1%total_SDgenpwr + y3%total_SDgenpwr))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%total_SDgenpwr + t(3)*y2%total_SDgenpwr - t(2)*y3%total_SDgenpwr ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%total_SDgenpwr = y1%total_SDgenpwr + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%mean_SDgenpwr - y2%mean_SDgenpwr) + t(2)**2*(-y1%mean_SDgenpwr + y3%mean_SDgenpwr))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%mean_SDgenpwr + t(3)*y2%mean_SDgenpwr - t(2)*y3%mean_SDgenpwr ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%mean_SDgenpwr = y1%mean_SDgenpwr + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%avg_ct - y2%avg_ct) + t(2)**2*(-y1%avg_ct + y3%avg_ct))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%avg_ct + t(3)*y2%avg_ct - t(2)*y3%avg_ct ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%avg_ct = y1%avg_ct + b0 * t_out + c0 * t_out**2 + b = (t(3)**2*(y1%AtmUscale - y2%AtmUscale) + t(2)**2*(-y1%AtmUscale + y3%AtmUscale))* scaleFactor + c = ( (t(2)-t(3))*y1%AtmUscale + t(3)*y2%AtmUscale - t(2)*y3%AtmUscale ) * scaleFactor + y_out%AtmUscale = y1%AtmUscale + b + c * t_out + b = (t(3)**2*(y1%du_dz_ABL - y2%du_dz_ABL) + t(2)**2*(-y1%du_dz_ABL + y3%du_dz_ABL))* scaleFactor + c = ( (t(2)-t(3))*y1%du_dz_ABL + t(3)*y2%du_dz_ABL - t(2)*y3%du_dz_ABL ) * scaleFactor + y_out%du_dz_ABL = y1%du_dz_ABL + b + c * t_out + b = (t(3)**2*(y1%total_SDgenpwr - y2%total_SDgenpwr) + t(2)**2*(-y1%total_SDgenpwr + y3%total_SDgenpwr))* scaleFactor + c = ( (t(2)-t(3))*y1%total_SDgenpwr + t(3)*y2%total_SDgenpwr - t(2)*y3%total_SDgenpwr ) * scaleFactor + y_out%total_SDgenpwr = y1%total_SDgenpwr + b + c * t_out + b = (t(3)**2*(y1%mean_SDgenpwr - y2%mean_SDgenpwr) + t(2)**2*(-y1%mean_SDgenpwr + y3%mean_SDgenpwr))* scaleFactor + c = ( (t(2)-t(3))*y1%mean_SDgenpwr + t(3)*y2%mean_SDgenpwr - t(2)*y3%mean_SDgenpwr ) * scaleFactor + y_out%mean_SDgenpwr = y1%mean_SDgenpwr + b + c * t_out + b = (t(3)**2*(y1%avg_ct - y2%avg_ct) + t(2)**2*(-y1%avg_ct + y3%avg_ct))* scaleFactor + c = ( (t(2)-t(3))*y1%avg_ct + t(3)*y2%avg_ct - t(2)*y3%avg_ct ) * scaleFactor + y_out%avg_ct = y1%avg_ct + b + c * t_out 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 DWM_Output_ExtrapInterp2 diff --git a/modules/beamdyn/src/BeamDyn_Types.f90 b/modules/beamdyn/src/BeamDyn_Types.f90 index 8d2c275185..aaf7dfd3b7 100644 --- a/modules/beamdyn/src/BeamDyn_Types.f90 +++ b/modules/beamdyn/src/BeamDyn_Types.f90 @@ -443,34 +443,56 @@ SUBROUTINE BD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%gravity))-1 ) = PACK(InData%gravity,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%gravity) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GlbPos))-1 ) = PACK(InData%GlbPos,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GlbPos) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%GlbRot))-1 ) = PACK(InData%GlbRot,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%GlbRot) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%RootDisp))-1 ) = PACK(InData%RootDisp,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%RootDisp) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%RootOri))-1 ) = PACK(InData%RootOri,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%RootOri) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RootVel))-1 ) = PACK(InData%RootVel,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RootVel) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%HubPos))-1 ) = PACK(InData%HubPos,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%HubPos) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%HubRot))-1 ) = PACK(InData%HubRot,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%HubRot) - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Linearize , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%DynamicSolve , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%InputFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO i1 = LBOUND(InData%gravity,1), UBOUND(InData%gravity,1) + ReKiBuf(Re_Xferred) = InData%gravity(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%GlbPos,1), UBOUND(InData%GlbPos,1) + ReKiBuf(Re_Xferred) = InData%GlbPos(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i2 = LBOUND(InData%GlbRot,2), UBOUND(InData%GlbRot,2) + DO i1 = LBOUND(InData%GlbRot,1), UBOUND(InData%GlbRot,1) + DbKiBuf(Db_Xferred) = InData%GlbRot(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + DO i1 = LBOUND(InData%RootDisp,1), UBOUND(InData%RootDisp,1) + DbKiBuf(Db_Xferred) = InData%RootDisp(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i2 = LBOUND(InData%RootOri,2), UBOUND(InData%RootOri,2) + DO i1 = LBOUND(InData%RootOri,1), UBOUND(InData%RootOri,1) + DbKiBuf(Db_Xferred) = InData%RootOri(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + DO i1 = LBOUND(InData%RootVel,1), UBOUND(InData%RootVel,1) + ReKiBuf(Re_Xferred) = InData%RootVel(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%HubPos,1), UBOUND(InData%HubPos,1) + ReKiBuf(Re_Xferred) = InData%HubPos(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i2 = LBOUND(InData%HubRot,2), UBOUND(InData%HubRot,2) + DO i1 = LBOUND(InData%HubRot,1), UBOUND(InData%HubRot,1) + DbKiBuf(Db_Xferred) = InData%HubRot(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + IntKiBuf(Int_Xferred) = TRANSFER(InData%Linearize, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%DynamicSolve, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE BD_PackInitInput SUBROUTINE BD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -486,12 +508,6 @@ SUBROUTINE BD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -509,112 +525,78 @@ SUBROUTINE BD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%InputFile) + OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I i1_l = LBOUND(OutData%gravity,1) i1_u = UBOUND(OutData%gravity,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%gravity = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%gravity))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%gravity) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%gravity,1), UBOUND(OutData%gravity,1) + OutData%gravity(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%GlbPos,1) i1_u = UBOUND(OutData%GlbPos,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%GlbPos = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GlbPos))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GlbPos) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%GlbPos,1), UBOUND(OutData%GlbPos,1) + OutData%GlbPos(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%GlbRot,1) i1_u = UBOUND(OutData%GlbRot,1) i2_l = LBOUND(OutData%GlbRot,2) i2_u = UBOUND(OutData%GlbRot,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%GlbRot = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%GlbRot))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%GlbRot) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%GlbRot,2), UBOUND(OutData%GlbRot,2) + DO i1 = LBOUND(OutData%GlbRot,1), UBOUND(OutData%GlbRot,1) + OutData%GlbRot(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%RootDisp,1) i1_u = UBOUND(OutData%RootDisp,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%RootDisp = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%RootDisp))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%RootDisp) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%RootDisp,1), UBOUND(OutData%RootDisp,1) + OutData%RootDisp(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%RootOri,1) i1_u = UBOUND(OutData%RootOri,1) i2_l = LBOUND(OutData%RootOri,2) i2_u = UBOUND(OutData%RootOri,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%RootOri = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%RootOri))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%RootOri) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%RootOri,2), UBOUND(OutData%RootOri,2) + DO i1 = LBOUND(OutData%RootOri,1), UBOUND(OutData%RootOri,1) + OutData%RootOri(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%RootVel,1) i1_u = UBOUND(OutData%RootVel,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%RootVel = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RootVel))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RootVel) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%RootVel,1), UBOUND(OutData%RootVel,1) + OutData%RootVel(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%HubPos,1) i1_u = UBOUND(OutData%HubPos,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%HubPos = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%HubPos))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%HubPos) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%HubPos,1), UBOUND(OutData%HubPos,1) + OutData%HubPos(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%HubRot,1) i1_u = UBOUND(OutData%HubRot,1) i2_l = LBOUND(OutData%HubRot,2) i2_u = UBOUND(OutData%HubRot,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%HubRot = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%HubRot))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%HubRot) - DEALLOCATE(mask2) - OutData%Linearize = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%DynamicSolve = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(OutData%HubRot,2), UBOUND(OutData%HubRot,2) + DO i1 = LBOUND(OutData%HubRot,1), UBOUND(OutData%HubRot,1) + OutData%HubRot(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + OutData%Linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%Linearize) + Int_Xferred = Int_Xferred + 1 + OutData%DynamicSolve = TRANSFER(IntKiBuf(Int_Xferred), OutData%DynamicSolve) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE BD_UnPackInitInput SUBROUTINE BD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -964,12 +946,12 @@ SUBROUTINE BD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) + DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) DO I = 1, LEN(InData%WriteOutputHdr) IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdr(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -981,12 +963,12 @@ SUBROUTINE BD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) + DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) DO I = 1, LEN(InData%WriteOutputUnt) IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUnt(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1029,11 +1011,15 @@ SUBROUTINE BD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%kp_coordinate,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%kp_coordinate)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%kp_coordinate))-1 ) = PACK(InData%kp_coordinate,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%kp_coordinate) + DO i2 = LBOUND(InData%kp_coordinate,2), UBOUND(InData%kp_coordinate,2) + DO i1 = LBOUND(InData%kp_coordinate,1), UBOUND(InData%kp_coordinate,1) + DbKiBuf(Db_Xferred) = InData%kp_coordinate(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%kp_total - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%kp_total + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%LinNames_y) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1044,12 +1030,12 @@ SUBROUTINE BD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_y,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%LinNames_y,1), UBOUND(InData%LinNames_y,1) + DO i1 = LBOUND(InData%LinNames_y,1), UBOUND(InData%LinNames_y,1) DO I = 1, LEN(InData%LinNames_y) IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_y(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LinNames_x) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1061,12 +1047,12 @@ SUBROUTINE BD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_x,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%LinNames_x,1), UBOUND(InData%LinNames_x,1) + DO i1 = LBOUND(InData%LinNames_x,1), UBOUND(InData%LinNames_x,1) DO I = 1, LEN(InData%LinNames_x) IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_x(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LinNames_u) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1078,12 +1064,12 @@ SUBROUTINE BD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_u,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%LinNames_u,1), UBOUND(InData%LinNames_u,1) + DO i1 = LBOUND(InData%LinNames_u,1), UBOUND(InData%LinNames_u,1) DO I = 1, LEN(InData%LinNames_u) IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_u(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%RotFrame_y) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1095,8 +1081,10 @@ SUBROUTINE BD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_y,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RotFrame_y)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%RotFrame_y)-1 ) = TRANSFER(PACK( InData%RotFrame_y ,.TRUE.), IntKiBuf(1), SIZE(InData%RotFrame_y)) - Int_Xferred = Int_Xferred + SIZE(InData%RotFrame_y) + DO i1 = LBOUND(InData%RotFrame_y,1), UBOUND(InData%RotFrame_y,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_y(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%RotFrame_x) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1108,8 +1096,10 @@ SUBROUTINE BD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_x,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RotFrame_x)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%RotFrame_x)-1 ) = TRANSFER(PACK( InData%RotFrame_x ,.TRUE.), IntKiBuf(1), SIZE(InData%RotFrame_x)) - Int_Xferred = Int_Xferred + SIZE(InData%RotFrame_x) + DO i1 = LBOUND(InData%RotFrame_x,1), UBOUND(InData%RotFrame_x,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_x(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%RotFrame_u) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1121,8 +1111,10 @@ SUBROUTINE BD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_u,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RotFrame_u)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%RotFrame_u)-1 ) = TRANSFER(PACK( InData%RotFrame_u ,.TRUE.), IntKiBuf(1), SIZE(InData%RotFrame_u)) - Int_Xferred = Int_Xferred + SIZE(InData%RotFrame_u) + DO i1 = LBOUND(InData%RotFrame_u,1), UBOUND(InData%RotFrame_u,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_u(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%IsLoad_u) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1134,8 +1126,10 @@ SUBROUTINE BD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IsLoad_u,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%IsLoad_u)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%IsLoad_u)-1 ) = TRANSFER(PACK( InData%IsLoad_u ,.TRUE.), IntKiBuf(1), SIZE(InData%IsLoad_u)) - Int_Xferred = Int_Xferred + SIZE(InData%IsLoad_u) + DO i1 = LBOUND(InData%IsLoad_u,1), UBOUND(InData%IsLoad_u,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%IsLoad_u(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%DerivOrder_x) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1147,8 +1141,10 @@ SUBROUTINE BD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DerivOrder_x,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DerivOrder_x)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%DerivOrder_x))-1 ) = PACK(InData%DerivOrder_x,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%DerivOrder_x) + DO i1 = LBOUND(InData%DerivOrder_x,1), UBOUND(InData%DerivOrder_x,1) + IntKiBuf(Int_Xferred) = InData%DerivOrder_x(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF END SUBROUTINE BD_PackInitOutput @@ -1165,12 +1161,6 @@ SUBROUTINE BD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -1199,19 +1189,12 @@ SUBROUTINE BD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) DO I = 1, LEN(OutData%WriteOutputHdr) OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated Int_Xferred = Int_Xferred + 1 @@ -1226,19 +1209,12 @@ SUBROUTINE BD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) DO I = 1, LEN(OutData%WriteOutputUnt) OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -1296,18 +1272,15 @@ SUBROUTINE BD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%kp_coordinate.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%kp_coordinate)>0) OutData%kp_coordinate = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%kp_coordinate))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%kp_coordinate) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%kp_coordinate,2), UBOUND(OutData%kp_coordinate,2) + DO i1 = LBOUND(OutData%kp_coordinate,1), UBOUND(OutData%kp_coordinate,1) + OutData%kp_coordinate(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF - OutData%kp_total = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%kp_total = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_y not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1321,19 +1294,12 @@ SUBROUTINE BD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%LinNames_y,1), UBOUND(OutData%LinNames_y,1) + DO i1 = LBOUND(OutData%LinNames_y,1), UBOUND(OutData%LinNames_y,1) DO I = 1, LEN(OutData%LinNames_y) OutData%LinNames_y(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_x not allocated Int_Xferred = Int_Xferred + 1 @@ -1348,19 +1314,12 @@ SUBROUTINE BD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_x.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%LinNames_x,1), UBOUND(OutData%LinNames_x,1) + DO i1 = LBOUND(OutData%LinNames_x,1), UBOUND(OutData%LinNames_x,1) DO I = 1, LEN(OutData%LinNames_x) OutData%LinNames_x(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_u not allocated Int_Xferred = Int_Xferred + 1 @@ -1375,19 +1334,12 @@ SUBROUTINE BD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%LinNames_u,1), UBOUND(OutData%LinNames_u,1) + DO i1 = LBOUND(OutData%LinNames_u,1), UBOUND(OutData%LinNames_u,1) DO I = 1, LEN(OutData%LinNames_u) OutData%LinNames_u(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_y not allocated Int_Xferred = Int_Xferred + 1 @@ -1402,15 +1354,10 @@ SUBROUTINE BD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RotFrame_y)>0) OutData%RotFrame_y = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%RotFrame_y))-1 ), OutData%RotFrame_y), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%RotFrame_y) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%RotFrame_y,1), UBOUND(OutData%RotFrame_y,1) + OutData%RotFrame_y(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_y(i1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_x not allocated Int_Xferred = Int_Xferred + 1 @@ -1425,15 +1372,10 @@ SUBROUTINE BD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_x.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RotFrame_x)>0) OutData%RotFrame_x = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%RotFrame_x))-1 ), OutData%RotFrame_x), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%RotFrame_x) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%RotFrame_x,1), UBOUND(OutData%RotFrame_x,1) + OutData%RotFrame_x(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_x(i1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_u not allocated Int_Xferred = Int_Xferred + 1 @@ -1448,15 +1390,10 @@ SUBROUTINE BD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RotFrame_u)>0) OutData%RotFrame_u = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%RotFrame_u))-1 ), OutData%RotFrame_u), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%RotFrame_u) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%RotFrame_u,1), UBOUND(OutData%RotFrame_u,1) + OutData%RotFrame_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_u(i1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IsLoad_u not allocated Int_Xferred = Int_Xferred + 1 @@ -1471,15 +1408,10 @@ SUBROUTINE BD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%IsLoad_u)>0) OutData%IsLoad_u = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%IsLoad_u))-1 ), OutData%IsLoad_u), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%IsLoad_u) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%IsLoad_u,1), UBOUND(OutData%IsLoad_u,1) + OutData%IsLoad_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsLoad_u(i1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DerivOrder_x not allocated Int_Xferred = Int_Xferred + 1 @@ -1494,15 +1426,10 @@ SUBROUTINE BD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%DerivOrder_x)>0) OutData%DerivOrder_x = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%DerivOrder_x))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%DerivOrder_x) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%DerivOrder_x,1), UBOUND(OutData%DerivOrder_x,1) + OutData%DerivOrder_x(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF END SUBROUTINE BD_UnPackInitOutput @@ -1674,10 +1601,10 @@ SUBROUTINE BD_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%station_total - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%format_index - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%station_total + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%format_index + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%station_eta) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1688,8 +1615,10 @@ SUBROUTINE BD_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%station_eta,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%station_eta)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%station_eta))-1 ) = PACK(InData%station_eta,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%station_eta) + DO i1 = LBOUND(InData%station_eta,1), UBOUND(InData%station_eta,1) + DbKiBuf(Db_Xferred) = InData%station_eta(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%stiff0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1707,8 +1636,14 @@ SUBROUTINE BD_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%stiff0,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%stiff0)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%stiff0))-1 ) = PACK(InData%stiff0,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%stiff0) + DO i3 = LBOUND(InData%stiff0,3), UBOUND(InData%stiff0,3) + DO i2 = LBOUND(InData%stiff0,2), UBOUND(InData%stiff0,2) + DO i1 = LBOUND(InData%stiff0,1), UBOUND(InData%stiff0,1) + DbKiBuf(Db_Xferred) = InData%stiff0(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%mass0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1726,13 +1661,21 @@ SUBROUTINE BD_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%mass0,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%mass0)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%mass0))-1 ) = PACK(InData%mass0,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%mass0) + DO i3 = LBOUND(InData%mass0,3), UBOUND(InData%mass0,3) + DO i2 = LBOUND(InData%mass0,2), UBOUND(InData%mass0,2) + DO i1 = LBOUND(InData%mass0,1), UBOUND(InData%mass0,1) + DbKiBuf(Db_Xferred) = InData%mass0(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%beta))-1 ) = PACK(InData%beta,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%beta) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%damp_flag - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%beta,1), UBOUND(InData%beta,1) + DbKiBuf(Db_Xferred) = InData%beta(i1) + Db_Xferred = Db_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%damp_flag + Int_Xferred = Int_Xferred + 1 END SUBROUTINE BD_PackBladeInputData SUBROUTINE BD_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1748,12 +1691,6 @@ SUBROUTINE BD_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -1770,10 +1707,10 @@ SUBROUTINE BD_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%station_total = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%format_index = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%station_total = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%format_index = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! station_eta not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1787,15 +1724,10 @@ SUBROUTINE BD_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%station_eta.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%station_eta)>0) OutData%station_eta = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%station_eta))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%station_eta) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%station_eta,1), UBOUND(OutData%station_eta,1) + OutData%station_eta(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! stiff0 not allocated Int_Xferred = Int_Xferred + 1 @@ -1816,15 +1748,14 @@ SUBROUTINE BD_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%stiff0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%stiff0)>0) OutData%stiff0 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%stiff0))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%stiff0) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%stiff0,3), UBOUND(OutData%stiff0,3) + DO i2 = LBOUND(OutData%stiff0,2), UBOUND(OutData%stiff0,2) + DO i1 = LBOUND(OutData%stiff0,1), UBOUND(OutData%stiff0,1) + OutData%stiff0(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! mass0 not allocated Int_Xferred = Int_Xferred + 1 @@ -1845,29 +1776,23 @@ SUBROUTINE BD_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%mass0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%mass0)>0) OutData%mass0 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%mass0))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%mass0) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%mass0,3), UBOUND(OutData%mass0,3) + DO i2 = LBOUND(OutData%mass0,2), UBOUND(OutData%mass0,2) + DO i1 = LBOUND(OutData%mass0,1), UBOUND(OutData%mass0,1) + OutData%mass0(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF i1_l = LBOUND(OutData%beta,1) i1_u = UBOUND(OutData%beta,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%beta = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%beta))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%beta) - DEALLOCATE(mask1) - OutData%damp_flag = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%beta,1), UBOUND(OutData%beta,1) + OutData%beta(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + OutData%damp_flag = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE BD_UnPackBladeInputData SUBROUTINE BD_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg ) @@ -2103,10 +2028,10 @@ SUBROUTINE BD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%member_total - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%kp_total - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%member_total + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%kp_total + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%kp_member) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2117,25 +2042,27 @@ SUBROUTINE BD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%kp_member,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%kp_member)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%kp_member))-1 ) = PACK(InData%kp_member,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%kp_member) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%order_elem - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%load_retries - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NRMax - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%quadrature - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%n_fact - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%refine - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%rhoinf - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DTBeam - Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(InData%kp_member,1), UBOUND(InData%kp_member,1) + IntKiBuf(Int_Xferred) = InData%kp_member(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = InData%order_elem + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%load_retries + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NRMax + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%quadrature + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%n_fact + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%refine + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%rhoinf + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DTBeam + Db_Xferred = Db_Xferred + 1 CALL BD_Packbladeinputdata( Re_Buf, Db_Buf, Int_Buf, InData%InpBl, ErrStat2, ErrMsg2, OnlySize ) ! InpBl CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2164,20 +2091,20 @@ SUBROUTINE BD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - DO I = 1, LEN(InData%BldFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%BldFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%UsePitchAct , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%QuasiStaticInit , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%stop_tol - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%tngt_stf_pert - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%tngt_stf_difftol - Db_Xferred = Db_Xferred + 1 + DO I = 1, LEN(InData%BldFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%BldFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%UsePitchAct, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%QuasiStaticInit, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%stop_tol + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%tngt_stf_pert + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%tngt_stf_difftol + Db_Xferred = Db_Xferred + 1 IF ( .NOT. ALLOCATED(InData%kp_coordinate) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2191,31 +2118,37 @@ SUBROUTINE BD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%kp_coordinate,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%kp_coordinate)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%kp_coordinate))-1 ) = PACK(InData%kp_coordinate,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%kp_coordinate) - END IF - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%pitchJ - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%pitchK - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%pitchC - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Echo , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%RotStates , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%RelStates , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%tngt_stf_fd , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%tngt_stf_comp , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NNodeOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%OutNd))-1 ) = PACK(InData%OutNd,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%OutNd) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(InData%kp_coordinate,2), UBOUND(InData%kp_coordinate,2) + DO i1 = LBOUND(InData%kp_coordinate,1), UBOUND(InData%kp_coordinate,1) + DbKiBuf(Db_Xferred) = InData%kp_coordinate(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + DbKiBuf(Db_Xferred) = InData%pitchJ + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%pitchK + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%pitchC + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%Echo, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%RotStates, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%RelStates, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%tngt_stf_fd, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%tngt_stf_comp, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NNodeOuts + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%OutNd,1), UBOUND(InData%OutNd,1) + IntKiBuf(Int_Xferred) = InData%OutNd(i1) + Int_Xferred = Int_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%OutList) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2226,19 +2159,19 @@ SUBROUTINE BD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutList,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) + DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) DO I = 1, LEN(InData%OutList) IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%SumPrint , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%SumPrint, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%OutFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE BD_PackInputFile SUBROUTINE BD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2254,12 +2187,6 @@ SUBROUTINE BD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -2275,10 +2202,10 @@ SUBROUTINE BD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%member_total = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%kp_total = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%member_total = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%kp_total = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! kp_member not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2292,32 +2219,27 @@ SUBROUTINE BD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%kp_member.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%kp_member)>0) OutData%kp_member = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%kp_member))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%kp_member) - DEALLOCATE(mask1) - END IF - OutData%order_elem = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%load_retries = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NRMax = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%quadrature = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%n_fact = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%refine = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%rhoinf = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%DTBeam = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(OutData%kp_member,1), UBOUND(OutData%kp_member,1) + OutData%kp_member(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + OutData%order_elem = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%load_retries = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NRMax = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%quadrature = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%n_fact = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%refine = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%rhoinf = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%DTBeam = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -2358,20 +2280,20 @@ SUBROUTINE BD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - DO I = 1, LEN(OutData%BldFile) - OutData%BldFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%UsePitchAct = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%QuasiStaticInit = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%stop_tol = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%tngt_stf_pert = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%tngt_stf_difftol = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 + DO I = 1, LEN(OutData%BldFile) + OutData%BldFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%UsePitchAct = TRANSFER(IntKiBuf(Int_Xferred), OutData%UsePitchAct) + Int_Xferred = Int_Xferred + 1 + OutData%QuasiStaticInit = TRANSFER(IntKiBuf(Int_Xferred), OutData%QuasiStaticInit) + Int_Xferred = Int_Xferred + 1 + OutData%stop_tol = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%tngt_stf_pert = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%tngt_stf_difftol = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! kp_coordinate not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2388,47 +2310,39 @@ SUBROUTINE BD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%kp_coordinate.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%kp_coordinate)>0) OutData%kp_coordinate = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%kp_coordinate))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%kp_coordinate) - DEALLOCATE(mask2) - END IF - OutData%pitchJ = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%pitchK = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%pitchC = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%Echo = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%RotStates = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%RelStates = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%tngt_stf_fd = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%tngt_stf_comp = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NNodeOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(OutData%kp_coordinate,2), UBOUND(OutData%kp_coordinate,2) + DO i1 = LBOUND(OutData%kp_coordinate,1), UBOUND(OutData%kp_coordinate,1) + OutData%kp_coordinate(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + OutData%pitchJ = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%pitchK = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%pitchC = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%Echo = TRANSFER(IntKiBuf(Int_Xferred), OutData%Echo) + Int_Xferred = Int_Xferred + 1 + OutData%RotStates = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotStates) + Int_Xferred = Int_Xferred + 1 + OutData%RelStates = TRANSFER(IntKiBuf(Int_Xferred), OutData%RelStates) + Int_Xferred = Int_Xferred + 1 + OutData%tngt_stf_fd = TRANSFER(IntKiBuf(Int_Xferred), OutData%tngt_stf_fd) + Int_Xferred = Int_Xferred + 1 + OutData%tngt_stf_comp = TRANSFER(IntKiBuf(Int_Xferred), OutData%tngt_stf_comp) + Int_Xferred = Int_Xferred + 1 + OutData%NNodeOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%OutNd,1) i1_u = UBOUND(OutData%OutNd,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%OutNd = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%OutNd))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%OutNd) - DEALLOCATE(mask1) - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%OutNd,1), UBOUND(OutData%OutNd,1) + OutData%OutNd(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutList not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2442,26 +2356,19 @@ SUBROUTINE BD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) + DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) DO I = 1, LEN(OutData%OutList) OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) - END IF - OutData%SumPrint = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + END DO + END IF + OutData%SumPrint = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumPrint) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%OutFmt) + OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE BD_UnPackInputFile SUBROUTINE BD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) @@ -2612,8 +2519,12 @@ SUBROUTINE BD_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%q,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%q)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%q))-1 ) = PACK(InData%q,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%q) + DO i2 = LBOUND(InData%q,2), UBOUND(InData%q,2) + DO i1 = LBOUND(InData%q,1), UBOUND(InData%q,1) + DbKiBuf(Db_Xferred) = InData%q(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%dqdt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2628,8 +2539,12 @@ SUBROUTINE BD_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dqdt,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%dqdt)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%dqdt))-1 ) = PACK(InData%dqdt,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%dqdt) + DO i2 = LBOUND(InData%dqdt,2), UBOUND(InData%dqdt,2) + DO i1 = LBOUND(InData%dqdt,1), UBOUND(InData%dqdt,1) + DbKiBuf(Db_Xferred) = InData%dqdt(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF END SUBROUTINE BD_PackContState @@ -2646,12 +2561,6 @@ SUBROUTINE BD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -2683,15 +2592,12 @@ SUBROUTINE BD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%q.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%q)>0) OutData%q = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%q))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%q) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%q,2), UBOUND(OutData%q,2) + DO i1 = LBOUND(OutData%q,1), UBOUND(OutData%q,1) + OutData%q(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dqdt not allocated Int_Xferred = Int_Xferred + 1 @@ -2709,15 +2615,12 @@ SUBROUTINE BD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dqdt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%dqdt)>0) OutData%dqdt = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%dqdt))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%dqdt) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%dqdt,2), UBOUND(OutData%dqdt,2) + DO i1 = LBOUND(OutData%dqdt,1), UBOUND(OutData%dqdt,1) + OutData%dqdt(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF END SUBROUTINE BD_UnPackContState @@ -2814,10 +2717,10 @@ SUBROUTINE BD_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%thetaP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%thetaPD - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%thetaP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%thetaPD + Re_Xferred = Re_Xferred + 1 END SUBROUTINE BD_PackDiscState SUBROUTINE BD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2833,12 +2736,6 @@ SUBROUTINE BD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'BD_UnPackDiscState' @@ -2852,10 +2749,10 @@ SUBROUTINE BD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%thetaP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%thetaPD = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%thetaP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%thetaPD = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE BD_UnPackDiscState SUBROUTINE BD_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -2949,8 +2846,8 @@ SUBROUTINE BD_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyConstrState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE BD_PackConstrState SUBROUTINE BD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2966,12 +2863,6 @@ SUBROUTINE BD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'BD_UnPackConstrState' @@ -2985,8 +2876,8 @@ SUBROUTINE BD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyConstrState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyConstrState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE BD_UnPackConstrState SUBROUTINE BD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -3141,8 +3032,12 @@ SUBROUTINE BD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%acc,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%acc)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%acc))-1 ) = PACK(InData%acc,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%acc) + DO i2 = LBOUND(InData%acc,2), UBOUND(InData%acc,2) + DO i1 = LBOUND(InData%acc,1), UBOUND(InData%acc,1) + DbKiBuf(Db_Xferred) = InData%acc(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%xcc) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3157,13 +3052,17 @@ SUBROUTINE BD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xcc,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%xcc)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%xcc))-1 ) = PACK(InData%xcc,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%xcc) + DO i2 = LBOUND(InData%xcc,2), UBOUND(InData%xcc,2) + DO i1 = LBOUND(InData%xcc,1), UBOUND(InData%xcc,1) + DbKiBuf(Db_Xferred) = InData%xcc(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%InitAcc , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%RunQuasiStaticInit , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%InitAcc, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%RunQuasiStaticInit, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE BD_PackOtherState SUBROUTINE BD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -3179,12 +3078,6 @@ SUBROUTINE BD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -3216,15 +3109,12 @@ SUBROUTINE BD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%acc.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%acc)>0) OutData%acc = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%acc))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%acc) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%acc,2), UBOUND(OutData%acc,2) + DO i1 = LBOUND(OutData%acc,1), UBOUND(OutData%acc,1) + OutData%acc(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xcc not allocated Int_Xferred = Int_Xferred + 1 @@ -3242,20 +3132,17 @@ SUBROUTINE BD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xcc.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%xcc)>0) OutData%xcc = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%xcc))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%xcc) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%xcc,2), UBOUND(OutData%xcc,2) + DO i1 = LBOUND(OutData%xcc,1), UBOUND(OutData%xcc,1) + OutData%xcc(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF - OutData%InitAcc = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%RunQuasiStaticInit = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%InitAcc = TRANSFER(IntKiBuf(Int_Xferred), OutData%InitAcc) + Int_Xferred = Int_Xferred + 1 + OutData%RunQuasiStaticInit = TRANSFER(IntKiBuf(Int_Xferred), OutData%RunQuasiStaticInit) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE BD_UnPackOtherState SUBROUTINE BD_CopyqpParam( SrcqpParamData, DstqpParamData, CtrlCode, ErrStat, ErrMsg ) @@ -3409,8 +3296,12 @@ SUBROUTINE BD_PackqpParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%mmm,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%mmm)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%mmm))-1 ) = PACK(InData%mmm,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%mmm) + DO i2 = LBOUND(InData%mmm,2), UBOUND(InData%mmm,2) + DO i1 = LBOUND(InData%mmm,1), UBOUND(InData%mmm,1) + DbKiBuf(Db_Xferred) = InData%mmm(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%mEta) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3428,8 +3319,14 @@ SUBROUTINE BD_PackqpParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%mEta,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%mEta)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%mEta))-1 ) = PACK(InData%mEta,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%mEta) + DO i3 = LBOUND(InData%mEta,3), UBOUND(InData%mEta,3) + DO i2 = LBOUND(InData%mEta,2), UBOUND(InData%mEta,2) + DO i1 = LBOUND(InData%mEta,1), UBOUND(InData%mEta,1) + DbKiBuf(Db_Xferred) = InData%mEta(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF END SUBROUTINE BD_PackqpParam @@ -3446,12 +3343,6 @@ SUBROUTINE BD_UnPackqpParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -3484,15 +3375,12 @@ SUBROUTINE BD_UnPackqpParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%mmm.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%mmm)>0) OutData%mmm = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%mmm))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%mmm) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%mmm,2), UBOUND(OutData%mmm,2) + DO i1 = LBOUND(OutData%mmm,1), UBOUND(OutData%mmm,1) + OutData%mmm(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! mEta not allocated Int_Xferred = Int_Xferred + 1 @@ -3513,15 +3401,14 @@ SUBROUTINE BD_UnPackqpParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%mEta.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%mEta)>0) OutData%mEta = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%mEta))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%mEta) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%mEta,3), UBOUND(OutData%mEta,3) + DO i2 = LBOUND(OutData%mEta,2), UBOUND(OutData%mEta,2) + DO i1 = LBOUND(OutData%mEta,1), UBOUND(OutData%mEta,1) + OutData%mEta(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF END SUBROUTINE BD_UnPackqpParam @@ -4347,12 +4234,14 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%dt - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%coef))-1 ) = PACK(InData%coef,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%coef) - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%rhoinf - Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%dt + Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(InData%coef,1), UBOUND(InData%coef,1) + DbKiBuf(Db_Xferred) = InData%coef(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DbKiBuf(Db_Xferred) = InData%rhoinf + Db_Xferred = Db_Xferred + 1 IF ( .NOT. ALLOCATED(InData%uuN0) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4369,8 +4258,14 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uuN0,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%uuN0)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%uuN0))-1 ) = PACK(InData%uuN0,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%uuN0) + DO i3 = LBOUND(InData%uuN0,3), UBOUND(InData%uuN0,3) + DO i2 = LBOUND(InData%uuN0,2), UBOUND(InData%uuN0,2) + DO i1 = LBOUND(InData%uuN0,1), UBOUND(InData%uuN0,1) + DbKiBuf(Db_Xferred) = InData%uuN0(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Stif0_QP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4388,8 +4283,14 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Stif0_QP,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Stif0_QP)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Stif0_QP))-1 ) = PACK(InData%Stif0_QP,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Stif0_QP) + DO i3 = LBOUND(InData%Stif0_QP,3), UBOUND(InData%Stif0_QP,3) + DO i2 = LBOUND(InData%Stif0_QP,2), UBOUND(InData%Stif0_QP,2) + DO i1 = LBOUND(InData%Stif0_QP,1), UBOUND(InData%Stif0_QP,1) + DbKiBuf(Db_Xferred) = InData%Stif0_QP(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Mass0_QP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4407,11 +4308,19 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mass0_QP,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Mass0_QP)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Mass0_QP))-1 ) = PACK(InData%Mass0_QP,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Mass0_QP) + DO i3 = LBOUND(InData%Mass0_QP,3), UBOUND(InData%Mass0_QP,3) + DO i2 = LBOUND(InData%Mass0_QP,2), UBOUND(InData%Mass0_QP,2) + DO i1 = LBOUND(InData%Mass0_QP,1), UBOUND(InData%Mass0_QP,1) + DbKiBuf(Db_Xferred) = InData%Mass0_QP(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%gravity))-1 ) = PACK(InData%gravity,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%gravity) + DO i1 = LBOUND(InData%gravity,1), UBOUND(InData%gravity,1) + DbKiBuf(Db_Xferred) = InData%gravity(i1) + Db_Xferred = Db_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%segment_eta) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4422,8 +4331,10 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%segment_eta,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%segment_eta)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%segment_eta))-1 ) = PACK(InData%segment_eta,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%segment_eta) + DO i1 = LBOUND(InData%segment_eta,1), UBOUND(InData%segment_eta,1) + DbKiBuf(Db_Xferred) = InData%segment_eta(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%member_eta) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4435,27 +4346,45 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%member_eta,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%member_eta)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%member_eta))-1 ) = PACK(InData%member_eta,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%member_eta) - END IF - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%blade_length - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%blade_mass - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%blade_CG))-1 ) = PACK(InData%blade_CG,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%blade_CG) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%blade_IN))-1 ) = PACK(InData%blade_IN,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%blade_IN) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%beta))-1 ) = PACK(InData%beta,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%beta) - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%tol - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%GlbPos))-1 ) = PACK(InData%GlbPos,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%GlbPos) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%GlbRot))-1 ) = PACK(InData%GlbRot,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%GlbRot) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Glb_crv))-1 ) = PACK(InData%Glb_crv,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Glb_crv) + DO i1 = LBOUND(InData%member_eta,1), UBOUND(InData%member_eta,1) + DbKiBuf(Db_Xferred) = InData%member_eta(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + DbKiBuf(Db_Xferred) = InData%blade_length + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%blade_mass + Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(InData%blade_CG,1), UBOUND(InData%blade_CG,1) + DbKiBuf(Db_Xferred) = InData%blade_CG(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i2 = LBOUND(InData%blade_IN,2), UBOUND(InData%blade_IN,2) + DO i1 = LBOUND(InData%blade_IN,1), UBOUND(InData%blade_IN,1) + DbKiBuf(Db_Xferred) = InData%blade_IN(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + DO i1 = LBOUND(InData%beta,1), UBOUND(InData%beta,1) + DbKiBuf(Db_Xferred) = InData%beta(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DbKiBuf(Db_Xferred) = InData%tol + Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(InData%GlbPos,1), UBOUND(InData%GlbPos,1) + DbKiBuf(Db_Xferred) = InData%GlbPos(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i2 = LBOUND(InData%GlbRot,2), UBOUND(InData%GlbRot,2) + DO i1 = LBOUND(InData%GlbRot,1), UBOUND(InData%GlbRot,1) + DbKiBuf(Db_Xferred) = InData%GlbRot(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + DO i1 = LBOUND(InData%Glb_crv,1), UBOUND(InData%Glb_crv,1) + DbKiBuf(Db_Xferred) = InData%Glb_crv(i1) + Db_Xferred = Db_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%QPtN) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4466,8 +4395,10 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtN,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%QPtN)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%QPtN))-1 ) = PACK(InData%QPtN,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%QPtN) + DO i1 = LBOUND(InData%QPtN,1), UBOUND(InData%QPtN,1) + DbKiBuf(Db_Xferred) = InData%QPtN(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%QPtWeight) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4479,8 +4410,10 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtWeight,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%QPtWeight)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%QPtWeight))-1 ) = PACK(InData%QPtWeight,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%QPtWeight) + DO i1 = LBOUND(InData%QPtWeight,1), UBOUND(InData%QPtWeight,1) + DbKiBuf(Db_Xferred) = InData%QPtWeight(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%Shp) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4495,8 +4428,12 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Shp,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Shp)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Shp))-1 ) = PACK(InData%Shp,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Shp) + DO i2 = LBOUND(InData%Shp,2), UBOUND(InData%Shp,2) + DO i1 = LBOUND(InData%Shp,1), UBOUND(InData%Shp,1) + DbKiBuf(Db_Xferred) = InData%Shp(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%ShpDer) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4511,8 +4448,12 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ShpDer,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ShpDer)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%ShpDer))-1 ) = PACK(InData%ShpDer,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%ShpDer) + DO i2 = LBOUND(InData%ShpDer,2), UBOUND(InData%ShpDer,2) + DO i1 = LBOUND(InData%ShpDer,1), UBOUND(InData%ShpDer,1) + DbKiBuf(Db_Xferred) = InData%ShpDer(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Jacobian) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4527,8 +4468,12 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jacobian,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Jacobian)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Jacobian))-1 ) = PACK(InData%Jacobian,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Jacobian) + DO i2 = LBOUND(InData%Jacobian,2), UBOUND(InData%Jacobian,2) + DO i1 = LBOUND(InData%Jacobian,1), UBOUND(InData%Jacobian,1) + DbKiBuf(Db_Xferred) = InData%Jacobian(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%uu0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4546,8 +4491,14 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uu0,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%uu0)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%uu0))-1 ) = PACK(InData%uu0,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%uu0) + DO i3 = LBOUND(InData%uu0,3), UBOUND(InData%uu0,3) + DO i2 = LBOUND(InData%uu0,2), UBOUND(InData%uu0,2) + DO i1 = LBOUND(InData%uu0,1), UBOUND(InData%uu0,1) + DbKiBuf(Db_Xferred) = InData%uu0(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%rrN0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4565,8 +4516,14 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rrN0,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rrN0)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rrN0))-1 ) = PACK(InData%rrN0,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rrN0) + DO i3 = LBOUND(InData%rrN0,3), UBOUND(InData%rrN0,3) + DO i2 = LBOUND(InData%rrN0,2), UBOUND(InData%rrN0,2) + DO i1 = LBOUND(InData%rrN0,1), UBOUND(InData%rrN0,1) + DbKiBuf(Db_Xferred) = InData%rrN0(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%E10) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4584,8 +4541,14 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%E10,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%E10)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%E10))-1 ) = PACK(InData%E10,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%E10) + DO i3 = LBOUND(InData%E10,3), UBOUND(InData%E10,3) + DO i2 = LBOUND(InData%E10,2), UBOUND(InData%E10,2) + DO i1 = LBOUND(InData%E10,1), UBOUND(InData%E10,1) + DbKiBuf(Db_Xferred) = InData%E10(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%SP_Coef) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4603,11 +4566,17 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SP_Coef,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%SP_Coef)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%SP_Coef))-1 ) = PACK(InData%SP_Coef,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%SP_Coef) + DO i3 = LBOUND(InData%SP_Coef,3), UBOUND(InData%SP_Coef,3) + DO i2 = LBOUND(InData%SP_Coef,2), UBOUND(InData%SP_Coef,2) + DO i1 = LBOUND(InData%SP_Coef,1), UBOUND(InData%SP_Coef,1) + DbKiBuf(Db_Xferred) = InData%SP_Coef(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%nodes_per_elem - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nodes_per_elem + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%node_elem_idx) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4621,41 +4590,45 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%node_elem_idx,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%node_elem_idx)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%node_elem_idx))-1 ) = PACK(InData%node_elem_idx,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%node_elem_idx) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%refine - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%dof_node - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%dof_elem - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%rot_elem - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%elem_total - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%node_total - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%dof_total - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%nqp - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%analysis_type - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%damp_flag - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%ld_retries - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%niter - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%quadrature - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%n_fact - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%OutInputs , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(InData%node_elem_idx,2), UBOUND(InData%node_elem_idx,2) + DO i1 = LBOUND(InData%node_elem_idx,1), UBOUND(InData%node_elem_idx,1) + IntKiBuf(Int_Xferred) = InData%node_elem_idx(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + IntKiBuf(Int_Xferred) = InData%refine + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%dof_node + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%dof_elem + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%rot_elem + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%elem_total + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%node_total + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%dof_total + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nqp + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%analysis_type + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%damp_flag + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%ld_retries + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%niter + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%quadrature + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%n_fact + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%OutInputs, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4697,10 +4670,12 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NNodeOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%OutNd))-1 ) = PACK(InData%OutNd,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%OutNd) + IntKiBuf(Int_Xferred) = InData%NNodeOuts + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%OutNd,1), UBOUND(InData%OutNd,1) + IntKiBuf(Int_Xferred) = InData%OutNd(i1) + Int_Xferred = Int_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%NdIndx) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4711,8 +4686,10 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NdIndx,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%NdIndx)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%NdIndx))-1 ) = PACK(InData%NdIndx,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%NdIndx) + DO i1 = LBOUND(InData%NdIndx,1), UBOUND(InData%NdIndx,1) + IntKiBuf(Int_Xferred) = InData%NdIndx(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%OutNd2NdElem) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4727,23 +4704,31 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutNd2NdElem,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%OutNd2NdElem)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%OutNd2NdElem))-1 ) = PACK(InData%OutNd2NdElem,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%OutNd2NdElem) + DO i2 = LBOUND(InData%OutNd2NdElem,2), UBOUND(InData%OutNd2NdElem,2) + DO i1 = LBOUND(InData%OutNd2NdElem,1), UBOUND(InData%OutNd2NdElem,1) + IntKiBuf(Int_Xferred) = InData%OutNd2NdElem(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%UsePitchAct , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%pitchJ - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%pitchK - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%pitchC - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%torqM))-1 ) = PACK(InData%torqM,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%torqM) + DO I = 1, LEN(InData%OutFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%UsePitchAct, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%pitchJ + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%pitchK + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%pitchC + Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(InData%torqM,2), UBOUND(InData%torqM,2) + DO i1 = LBOUND(InData%torqM,1), UBOUND(InData%torqM,1) + ReKiBuf(Re_Xferred) = InData%torqM(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO CALL BD_Packqpparam( Re_Buf, Db_Buf, Int_Buf, InData%qp, ErrStat2, ErrMsg2, OnlySize ) ! qp CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4772,18 +4757,18 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%qp_indx_offset - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%BldMotionNodeLoc - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%tngt_stf_fd , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%tngt_stf_comp , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%tngt_stf_pert - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%tngt_stf_difftol - Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%qp_indx_offset + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%BldMotionNodeLoc + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%tngt_stf_fd, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%tngt_stf_comp, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%tngt_stf_pert + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%tngt_stf_difftol + Db_Xferred = Db_Xferred + 1 IF ( .NOT. ALLOCATED(InData%QPtw_Shp_Shp_Jac) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4803,8 +4788,16 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtw_Shp_Shp_Jac,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%QPtw_Shp_Shp_Jac)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%QPtw_Shp_Shp_Jac))-1 ) = PACK(InData%QPtw_Shp_Shp_Jac,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%QPtw_Shp_Shp_Jac) + DO i4 = LBOUND(InData%QPtw_Shp_Shp_Jac,4), UBOUND(InData%QPtw_Shp_Shp_Jac,4) + DO i3 = LBOUND(InData%QPtw_Shp_Shp_Jac,3), UBOUND(InData%QPtw_Shp_Shp_Jac,3) + DO i2 = LBOUND(InData%QPtw_Shp_Shp_Jac,2), UBOUND(InData%QPtw_Shp_Shp_Jac,2) + DO i1 = LBOUND(InData%QPtw_Shp_Shp_Jac,1), UBOUND(InData%QPtw_Shp_Shp_Jac,1) + DbKiBuf(Db_Xferred) = InData%QPtw_Shp_Shp_Jac(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%QPtw_Shp_ShpDer) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4822,8 +4815,14 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtw_Shp_ShpDer,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%QPtw_Shp_ShpDer)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%QPtw_Shp_ShpDer))-1 ) = PACK(InData%QPtw_Shp_ShpDer,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%QPtw_Shp_ShpDer) + DO i3 = LBOUND(InData%QPtw_Shp_ShpDer,3), UBOUND(InData%QPtw_Shp_ShpDer,3) + DO i2 = LBOUND(InData%QPtw_Shp_ShpDer,2), UBOUND(InData%QPtw_Shp_ShpDer,2) + DO i1 = LBOUND(InData%QPtw_Shp_ShpDer,1), UBOUND(InData%QPtw_Shp_ShpDer,1) + DbKiBuf(Db_Xferred) = InData%QPtw_Shp_ShpDer(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%QPtw_ShpDer_ShpDer_Jac) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4844,8 +4843,16 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtw_ShpDer_ShpDer_Jac,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%QPtw_ShpDer_ShpDer_Jac)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%QPtw_ShpDer_ShpDer_Jac))-1 ) = PACK(InData%QPtw_ShpDer_ShpDer_Jac,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%QPtw_ShpDer_ShpDer_Jac) + DO i4 = LBOUND(InData%QPtw_ShpDer_ShpDer_Jac,4), UBOUND(InData%QPtw_ShpDer_ShpDer_Jac,4) + DO i3 = LBOUND(InData%QPtw_ShpDer_ShpDer_Jac,3), UBOUND(InData%QPtw_ShpDer_ShpDer_Jac,3) + DO i2 = LBOUND(InData%QPtw_ShpDer_ShpDer_Jac,2), UBOUND(InData%QPtw_ShpDer_ShpDer_Jac,2) + DO i1 = LBOUND(InData%QPtw_ShpDer_ShpDer_Jac,1), UBOUND(InData%QPtw_ShpDer_ShpDer_Jac,1) + DbKiBuf(Db_Xferred) = InData%QPtw_ShpDer_ShpDer_Jac(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%QPtw_Shp_Jac) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4863,8 +4870,14 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtw_Shp_Jac,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%QPtw_Shp_Jac)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%QPtw_Shp_Jac))-1 ) = PACK(InData%QPtw_Shp_Jac,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%QPtw_Shp_Jac) + DO i3 = LBOUND(InData%QPtw_Shp_Jac,3), UBOUND(InData%QPtw_Shp_Jac,3) + DO i2 = LBOUND(InData%QPtw_Shp_Jac,2), UBOUND(InData%QPtw_Shp_Jac,2) + DO i1 = LBOUND(InData%QPtw_Shp_Jac,1), UBOUND(InData%QPtw_Shp_Jac,1) + DbKiBuf(Db_Xferred) = InData%QPtw_Shp_Jac(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%QPtw_ShpDer) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4879,8 +4892,12 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtw_ShpDer,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%QPtw_ShpDer)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%QPtw_ShpDer))-1 ) = PACK(InData%QPtw_ShpDer,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%QPtw_ShpDer) + DO i2 = LBOUND(InData%QPtw_ShpDer,2), UBOUND(InData%QPtw_ShpDer,2) + DO i1 = LBOUND(InData%QPtw_ShpDer,1), UBOUND(InData%QPtw_ShpDer,1) + DbKiBuf(Db_Xferred) = InData%QPtw_ShpDer(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FEweight) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4895,8 +4912,12 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FEweight,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FEweight)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%FEweight))-1 ) = PACK(InData%FEweight,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%FEweight) + DO i2 = LBOUND(InData%FEweight,2), UBOUND(InData%FEweight,2) + DO i1 = LBOUND(InData%FEweight,1), UBOUND(InData%FEweight,1) + DbKiBuf(Db_Xferred) = InData%FEweight(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Jac_u_indx) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4911,8 +4932,12 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Jac_u_indx)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%Jac_u_indx))-1 ) = PACK(InData%Jac_u_indx,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%Jac_u_indx) + DO i2 = LBOUND(InData%Jac_u_indx,2), UBOUND(InData%Jac_u_indx,2) + DO i1 = LBOUND(InData%Jac_u_indx,1), UBOUND(InData%Jac_u_indx,1) + IntKiBuf(Int_Xferred) = InData%Jac_u_indx(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%du) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4924,19 +4949,23 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%du,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%du)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%du))-1 ) = PACK(InData%du,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%du) + DO i1 = LBOUND(InData%du,1), UBOUND(InData%du,1) + DbKiBuf(Db_Xferred) = InData%du(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%dx))-1 ) = PACK(InData%dx,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%dx) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Jac_ny - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Jac_nx - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%RotStates , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%RelStates , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%dx,1), UBOUND(InData%dx,1) + DbKiBuf(Db_Xferred) = InData%dx(i1) + Db_Xferred = Db_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%Jac_ny + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Jac_nx + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%RotStates, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%RelStates, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE BD_PackParam SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -4952,12 +4981,6 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -4975,21 +4998,16 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%dt = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%dt = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 i1_l = LBOUND(OutData%coef,1) i1_u = UBOUND(OutData%coef,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%coef = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%coef))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%coef) - DEALLOCATE(mask1) - OutData%rhoinf = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(OutData%coef,1), UBOUND(OutData%coef,1) + OutData%coef(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + OutData%rhoinf = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! uuN0 not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5009,15 +5027,14 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%uuN0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%uuN0)>0) OutData%uuN0 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%uuN0))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%uuN0) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%uuN0,3), UBOUND(OutData%uuN0,3) + DO i2 = LBOUND(OutData%uuN0,2), UBOUND(OutData%uuN0,2) + DO i1 = LBOUND(OutData%uuN0,1), UBOUND(OutData%uuN0,1) + OutData%uuN0(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Stif0_QP not allocated Int_Xferred = Int_Xferred + 1 @@ -5038,15 +5055,14 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Stif0_QP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%Stif0_QP)>0) OutData%Stif0_QP = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Stif0_QP))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Stif0_QP) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%Stif0_QP,3), UBOUND(OutData%Stif0_QP,3) + DO i2 = LBOUND(OutData%Stif0_QP,2), UBOUND(OutData%Stif0_QP,2) + DO i1 = LBOUND(OutData%Stif0_QP,1), UBOUND(OutData%Stif0_QP,1) + OutData%Stif0_QP(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Mass0_QP not allocated Int_Xferred = Int_Xferred + 1 @@ -5067,27 +5083,21 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mass0_QP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%Mass0_QP)>0) OutData%Mass0_QP = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Mass0_QP))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Mass0_QP) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%Mass0_QP,3), UBOUND(OutData%Mass0_QP,3) + DO i2 = LBOUND(OutData%Mass0_QP,2), UBOUND(OutData%Mass0_QP,2) + DO i1 = LBOUND(OutData%Mass0_QP,1), UBOUND(OutData%Mass0_QP,1) + OutData%Mass0_QP(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF i1_l = LBOUND(OutData%gravity,1) i1_u = UBOUND(OutData%gravity,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%gravity = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%gravity))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%gravity) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%gravity,1), UBOUND(OutData%gravity,1) + OutData%gravity(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! segment_eta not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5101,15 +5111,10 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%segment_eta.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%segment_eta)>0) OutData%segment_eta = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%segment_eta))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%segment_eta) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%segment_eta,1), UBOUND(OutData%segment_eta,1) + OutData%segment_eta(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! member_eta not allocated Int_Xferred = Int_Xferred + 1 @@ -5124,92 +5129,61 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%member_eta.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%member_eta)>0) OutData%member_eta = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%member_eta))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%member_eta) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%member_eta,1), UBOUND(OutData%member_eta,1) + OutData%member_eta(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO END IF - OutData%blade_length = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%blade_mass = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 + OutData%blade_length = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%blade_mass = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 i1_l = LBOUND(OutData%blade_CG,1) i1_u = UBOUND(OutData%blade_CG,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%blade_CG = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%blade_CG))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%blade_CG) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%blade_CG,1), UBOUND(OutData%blade_CG,1) + OutData%blade_CG(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%blade_IN,1) i1_u = UBOUND(OutData%blade_IN,1) i2_l = LBOUND(OutData%blade_IN,2) i2_u = UBOUND(OutData%blade_IN,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%blade_IN = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%blade_IN))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%blade_IN) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%blade_IN,2), UBOUND(OutData%blade_IN,2) + DO i1 = LBOUND(OutData%blade_IN,1), UBOUND(OutData%blade_IN,1) + OutData%blade_IN(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%beta,1) i1_u = UBOUND(OutData%beta,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%beta = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%beta))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%beta) - DEALLOCATE(mask1) - OutData%tol = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(OutData%beta,1), UBOUND(OutData%beta,1) + OutData%beta(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + OutData%tol = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 i1_l = LBOUND(OutData%GlbPos,1) i1_u = UBOUND(OutData%GlbPos,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%GlbPos = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%GlbPos))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%GlbPos) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%GlbPos,1), UBOUND(OutData%GlbPos,1) + OutData%GlbPos(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%GlbRot,1) i1_u = UBOUND(OutData%GlbRot,1) i2_l = LBOUND(OutData%GlbRot,2) i2_u = UBOUND(OutData%GlbRot,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%GlbRot = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%GlbRot))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%GlbRot) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%GlbRot,2), UBOUND(OutData%GlbRot,2) + DO i1 = LBOUND(OutData%GlbRot,1), UBOUND(OutData%GlbRot,1) + OutData%GlbRot(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%Glb_crv,1) i1_u = UBOUND(OutData%Glb_crv,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%Glb_crv = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Glb_crv))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Glb_crv) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Glb_crv,1), UBOUND(OutData%Glb_crv,1) + OutData%Glb_crv(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QPtN not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5223,15 +5197,10 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QPtN.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%QPtN)>0) OutData%QPtN = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%QPtN))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%QPtN) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%QPtN,1), UBOUND(OutData%QPtN,1) + OutData%QPtN(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QPtWeight not allocated Int_Xferred = Int_Xferred + 1 @@ -5246,15 +5215,10 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QPtWeight.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%QPtWeight)>0) OutData%QPtWeight = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%QPtWeight))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%QPtWeight) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%QPtWeight,1), UBOUND(OutData%QPtWeight,1) + OutData%QPtWeight(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Shp not allocated Int_Xferred = Int_Xferred + 1 @@ -5272,15 +5236,12 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Shp.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Shp)>0) OutData%Shp = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Shp))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Shp) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Shp,2), UBOUND(OutData%Shp,2) + DO i1 = LBOUND(OutData%Shp,1), UBOUND(OutData%Shp,1) + OutData%Shp(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ShpDer not allocated Int_Xferred = Int_Xferred + 1 @@ -5298,15 +5259,12 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ShpDer.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%ShpDer)>0) OutData%ShpDer = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%ShpDer))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%ShpDer) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%ShpDer,2), UBOUND(OutData%ShpDer,2) + DO i1 = LBOUND(OutData%ShpDer,1), UBOUND(OutData%ShpDer,1) + OutData%ShpDer(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jacobian not allocated Int_Xferred = Int_Xferred + 1 @@ -5324,15 +5282,12 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jacobian.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Jacobian)>0) OutData%Jacobian = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Jacobian))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Jacobian) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Jacobian,2), UBOUND(OutData%Jacobian,2) + DO i1 = LBOUND(OutData%Jacobian,1), UBOUND(OutData%Jacobian,1) + OutData%Jacobian(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! uu0 not allocated Int_Xferred = Int_Xferred + 1 @@ -5353,15 +5308,14 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%uu0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%uu0)>0) OutData%uu0 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%uu0))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%uu0) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%uu0,3), UBOUND(OutData%uu0,3) + DO i2 = LBOUND(OutData%uu0,2), UBOUND(OutData%uu0,2) + DO i1 = LBOUND(OutData%uu0,1), UBOUND(OutData%uu0,1) + OutData%uu0(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rrN0 not allocated Int_Xferred = Int_Xferred + 1 @@ -5382,15 +5336,14 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rrN0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%rrN0)>0) OutData%rrN0 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rrN0))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rrN0) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%rrN0,3), UBOUND(OutData%rrN0,3) + DO i2 = LBOUND(OutData%rrN0,2), UBOUND(OutData%rrN0,2) + DO i1 = LBOUND(OutData%rrN0,1), UBOUND(OutData%rrN0,1) + OutData%rrN0(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! E10 not allocated Int_Xferred = Int_Xferred + 1 @@ -5411,15 +5364,14 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%E10.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%E10)>0) OutData%E10 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%E10))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%E10) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%E10,3), UBOUND(OutData%E10,3) + DO i2 = LBOUND(OutData%E10,2), UBOUND(OutData%E10,2) + DO i1 = LBOUND(OutData%E10,1), UBOUND(OutData%E10,1) + OutData%E10(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SP_Coef not allocated Int_Xferred = Int_Xferred + 1 @@ -5440,76 +5392,72 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SP_Coef.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + DO i3 = LBOUND(OutData%SP_Coef,3), UBOUND(OutData%SP_Coef,3) + DO i2 = LBOUND(OutData%SP_Coef,2), UBOUND(OutData%SP_Coef,2) + DO i1 = LBOUND(OutData%SP_Coef,1), UBOUND(OutData%SP_Coef,1) + OutData%SP_Coef(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END IF + OutData%nodes_per_elem = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! node_elem_idx not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%node_elem_idx)) DEALLOCATE(OutData%node_elem_idx) + ALLOCATE(OutData%node_elem_idx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%node_elem_idx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask3 = .TRUE. - IF (SIZE(OutData%SP_Coef)>0) OutData%SP_Coef = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%SP_Coef))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%SP_Coef) - DEALLOCATE(mask3) + DO i2 = LBOUND(OutData%node_elem_idx,2), UBOUND(OutData%node_elem_idx,2) + DO i1 = LBOUND(OutData%node_elem_idx,1), UBOUND(OutData%node_elem_idx,1) + OutData%node_elem_idx(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF - OutData%nodes_per_elem = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! node_elem_idx not allocated + OutData%refine = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%dof_node = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%dof_elem = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%rot_elem = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%elem_total = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%node_total = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%dof_total = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nqp = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%analysis_type = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%damp_flag = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ld_retries = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%niter = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%quadrature = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%n_fact = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 - ELSE + OutData%OutInputs = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutInputs) + Int_Xferred = Int_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%node_elem_idx)) DEALLOCATE(OutData%node_elem_idx) - ALLOCATE(OutData%node_elem_idx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%node_elem_idx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%node_elem_idx)>0) OutData%node_elem_idx = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%node_elem_idx))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%node_elem_idx) - DEALLOCATE(mask2) - END IF - OutData%refine = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%dof_node = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%dof_elem = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%rot_elem = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%elem_total = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%node_total = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%dof_total = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%nqp = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%analysis_type = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%damp_flag = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ld_retries = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%niter = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%quadrature = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%n_fact = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%OutInputs = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5566,19 +5514,14 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%NNodeOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NNodeOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%OutNd,1) i1_u = UBOUND(OutData%OutNd,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%OutNd = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%OutNd))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%OutNd) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%OutNd,1), UBOUND(OutData%OutNd,1) + OutData%OutNd(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NdIndx not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5592,15 +5535,10 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NdIndx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%NdIndx)>0) OutData%NdIndx = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%NdIndx))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%NdIndx) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%NdIndx,1), UBOUND(OutData%NdIndx,1) + OutData%NdIndx(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutNd2NdElem not allocated Int_Xferred = Int_Xferred + 1 @@ -5618,41 +5556,35 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutNd2NdElem.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%OutNd2NdElem)>0) OutData%OutNd2NdElem = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%OutNd2NdElem))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%OutNd2NdElem) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%OutNd2NdElem,2), UBOUND(OutData%OutNd2NdElem,2) + DO i1 = LBOUND(OutData%OutNd2NdElem,1), UBOUND(OutData%OutNd2NdElem,1) + OutData%OutNd2NdElem(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%UsePitchAct = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%pitchJ = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%pitchK = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%pitchC = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(OutData%OutFmt) + OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%UsePitchAct = TRANSFER(IntKiBuf(Int_Xferred), OutData%UsePitchAct) + Int_Xferred = Int_Xferred + 1 + OutData%pitchJ = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%pitchK = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%pitchC = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%torqM,1) i1_u = UBOUND(OutData%torqM,1) i2_l = LBOUND(OutData%torqM,2) i2_u = UBOUND(OutData%torqM,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%torqM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%torqM))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%torqM) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%torqM,2), UBOUND(OutData%torqM,2) + DO i1 = LBOUND(OutData%torqM,1), UBOUND(OutData%torqM,1) + OutData%torqM(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -5693,18 +5625,18 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%qp_indx_offset = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%BldMotionNodeLoc = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%tngt_stf_fd = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%tngt_stf_comp = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%tngt_stf_pert = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%tngt_stf_difftol = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 + OutData%qp_indx_offset = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%BldMotionNodeLoc = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%tngt_stf_fd = TRANSFER(IntKiBuf(Int_Xferred), OutData%tngt_stf_fd) + Int_Xferred = Int_Xferred + 1 + OutData%tngt_stf_comp = TRANSFER(IntKiBuf(Int_Xferred), OutData%tngt_stf_comp) + Int_Xferred = Int_Xferred + 1 + OutData%tngt_stf_pert = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%tngt_stf_difftol = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QPtw_Shp_Shp_Jac not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5727,15 +5659,16 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QPtw_Shp_Shp_Jac.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%QPtw_Shp_Shp_Jac)>0) OutData%QPtw_Shp_Shp_Jac = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%QPtw_Shp_Shp_Jac))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%QPtw_Shp_Shp_Jac) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%QPtw_Shp_Shp_Jac,4), UBOUND(OutData%QPtw_Shp_Shp_Jac,4) + DO i3 = LBOUND(OutData%QPtw_Shp_Shp_Jac,3), UBOUND(OutData%QPtw_Shp_Shp_Jac,3) + DO i2 = LBOUND(OutData%QPtw_Shp_Shp_Jac,2), UBOUND(OutData%QPtw_Shp_Shp_Jac,2) + DO i1 = LBOUND(OutData%QPtw_Shp_Shp_Jac,1), UBOUND(OutData%QPtw_Shp_Shp_Jac,1) + OutData%QPtw_Shp_Shp_Jac(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QPtw_Shp_ShpDer not allocated Int_Xferred = Int_Xferred + 1 @@ -5756,15 +5689,14 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QPtw_Shp_ShpDer.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%QPtw_Shp_ShpDer)>0) OutData%QPtw_Shp_ShpDer = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%QPtw_Shp_ShpDer))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%QPtw_Shp_ShpDer) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%QPtw_Shp_ShpDer,3), UBOUND(OutData%QPtw_Shp_ShpDer,3) + DO i2 = LBOUND(OutData%QPtw_Shp_ShpDer,2), UBOUND(OutData%QPtw_Shp_ShpDer,2) + DO i1 = LBOUND(OutData%QPtw_Shp_ShpDer,1), UBOUND(OutData%QPtw_Shp_ShpDer,1) + OutData%QPtw_Shp_ShpDer(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QPtw_ShpDer_ShpDer_Jac not allocated Int_Xferred = Int_Xferred + 1 @@ -5788,15 +5720,16 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QPtw_ShpDer_ShpDer_Jac.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%QPtw_ShpDer_ShpDer_Jac)>0) OutData%QPtw_ShpDer_ShpDer_Jac = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%QPtw_ShpDer_ShpDer_Jac))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%QPtw_ShpDer_ShpDer_Jac) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%QPtw_ShpDer_ShpDer_Jac,4), UBOUND(OutData%QPtw_ShpDer_ShpDer_Jac,4) + DO i3 = LBOUND(OutData%QPtw_ShpDer_ShpDer_Jac,3), UBOUND(OutData%QPtw_ShpDer_ShpDer_Jac,3) + DO i2 = LBOUND(OutData%QPtw_ShpDer_ShpDer_Jac,2), UBOUND(OutData%QPtw_ShpDer_ShpDer_Jac,2) + DO i1 = LBOUND(OutData%QPtw_ShpDer_ShpDer_Jac,1), UBOUND(OutData%QPtw_ShpDer_ShpDer_Jac,1) + OutData%QPtw_ShpDer_ShpDer_Jac(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QPtw_Shp_Jac not allocated Int_Xferred = Int_Xferred + 1 @@ -5817,15 +5750,14 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QPtw_Shp_Jac.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%QPtw_Shp_Jac)>0) OutData%QPtw_Shp_Jac = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%QPtw_Shp_Jac))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%QPtw_Shp_Jac) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%QPtw_Shp_Jac,3), UBOUND(OutData%QPtw_Shp_Jac,3) + DO i2 = LBOUND(OutData%QPtw_Shp_Jac,2), UBOUND(OutData%QPtw_Shp_Jac,2) + DO i1 = LBOUND(OutData%QPtw_Shp_Jac,1), UBOUND(OutData%QPtw_Shp_Jac,1) + OutData%QPtw_Shp_Jac(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QPtw_ShpDer not allocated Int_Xferred = Int_Xferred + 1 @@ -5843,15 +5775,12 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QPtw_ShpDer.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%QPtw_ShpDer)>0) OutData%QPtw_ShpDer = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%QPtw_ShpDer))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%QPtw_ShpDer) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%QPtw_ShpDer,2), UBOUND(OutData%QPtw_ShpDer,2) + DO i1 = LBOUND(OutData%QPtw_ShpDer,1), UBOUND(OutData%QPtw_ShpDer,1) + OutData%QPtw_ShpDer(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FEweight not allocated Int_Xferred = Int_Xferred + 1 @@ -5869,15 +5798,12 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FEweight.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%FEweight)>0) OutData%FEweight = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%FEweight))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%FEweight) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%FEweight,2), UBOUND(OutData%FEweight,2) + DO i1 = LBOUND(OutData%FEweight,1), UBOUND(OutData%FEweight,1) + OutData%FEweight(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_u_indx not allocated Int_Xferred = Int_Xferred + 1 @@ -5895,15 +5821,12 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Jac_u_indx)>0) OutData%Jac_u_indx = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%Jac_u_indx))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%Jac_u_indx) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Jac_u_indx,2), UBOUND(OutData%Jac_u_indx,2) + DO i1 = LBOUND(OutData%Jac_u_indx,1), UBOUND(OutData%Jac_u_indx,1) + OutData%Jac_u_indx(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! du not allocated Int_Xferred = Int_Xferred + 1 @@ -5918,35 +5841,25 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%du.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%du)>0) OutData%du = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%du))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%du) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%du,1), UBOUND(OutData%du,1) + OutData%du(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO END IF i1_l = LBOUND(OutData%dx,1) i1_u = UBOUND(OutData%dx,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%dx = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%dx))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%dx) - DEALLOCATE(mask1) - OutData%Jac_ny = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%Jac_nx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%RotStates = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%RelStates = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%dx,1), UBOUND(OutData%dx,1) + OutData%dx(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + OutData%Jac_ny = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Jac_nx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%RotStates = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotStates) + Int_Xferred = Int_Xferred + 1 + OutData%RelStates = TRANSFER(IntKiBuf(Int_Xferred), OutData%RelStates) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE BD_UnPackParam SUBROUTINE BD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -6250,12 +6163,6 @@ SUBROUTINE BD_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'BD_UnPackInput' @@ -6644,10 +6551,10 @@ SUBROUTINE BD_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RootMxr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RootMyr - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RootMxr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RootMyr + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WriteOutput) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -6658,8 +6565,10 @@ SUBROUTINE BD_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WriteOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE BD_PackOutput @@ -6676,12 +6585,6 @@ SUBROUTINE BD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -6776,10 +6679,10 @@ SUBROUTINE BD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%RootMxr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RootMyr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%RootMxr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RootMyr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutput not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -6793,15 +6696,10 @@ SUBROUTINE BD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WriteOutput)>0) OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE BD_UnPackOutput @@ -7692,8 +7590,14 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uuu,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%uuu)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%uuu))-1 ) = PACK(InData%uuu,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%uuu) + DO i3 = LBOUND(InData%uuu,3), UBOUND(InData%uuu,3) + DO i2 = LBOUND(InData%uuu,2), UBOUND(InData%uuu,2) + DO i1 = LBOUND(InData%uuu,1), UBOUND(InData%uuu,1) + DbKiBuf(Db_Xferred) = InData%uuu(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%uup) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7711,8 +7615,14 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uup,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%uup)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%uup))-1 ) = PACK(InData%uup,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%uup) + DO i3 = LBOUND(InData%uup,3), UBOUND(InData%uup,3) + DO i2 = LBOUND(InData%uup,2), UBOUND(InData%uup,2) + DO i1 = LBOUND(InData%uup,1), UBOUND(InData%uup,1) + DbKiBuf(Db_Xferred) = InData%uup(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%vvv) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7730,8 +7640,14 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vvv,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%vvv)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%vvv))-1 ) = PACK(InData%vvv,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%vvv) + DO i3 = LBOUND(InData%vvv,3), UBOUND(InData%vvv,3) + DO i2 = LBOUND(InData%vvv,2), UBOUND(InData%vvv,2) + DO i1 = LBOUND(InData%vvv,1), UBOUND(InData%vvv,1) + DbKiBuf(Db_Xferred) = InData%vvv(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%vvp) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7749,8 +7665,14 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vvp,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%vvp)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%vvp))-1 ) = PACK(InData%vvp,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%vvp) + DO i3 = LBOUND(InData%vvp,3), UBOUND(InData%vvp,3) + DO i2 = LBOUND(InData%vvp,2), UBOUND(InData%vvp,2) + DO i1 = LBOUND(InData%vvp,1), UBOUND(InData%vvp,1) + DbKiBuf(Db_Xferred) = InData%vvp(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%aaa) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7768,8 +7690,14 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%aaa,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%aaa)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%aaa))-1 ) = PACK(InData%aaa,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%aaa) + DO i3 = LBOUND(InData%aaa,3), UBOUND(InData%aaa,3) + DO i2 = LBOUND(InData%aaa,2), UBOUND(InData%aaa,2) + DO i1 = LBOUND(InData%aaa,1), UBOUND(InData%aaa,1) + DbKiBuf(Db_Xferred) = InData%aaa(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%RR0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7790,8 +7718,16 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RR0,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RR0)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%RR0))-1 ) = PACK(InData%RR0,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%RR0) + DO i4 = LBOUND(InData%RR0,4), UBOUND(InData%RR0,4) + DO i3 = LBOUND(InData%RR0,3), UBOUND(InData%RR0,3) + DO i2 = LBOUND(InData%RR0,2), UBOUND(InData%RR0,2) + DO i1 = LBOUND(InData%RR0,1), UBOUND(InData%RR0,1) + DbKiBuf(Db_Xferred) = InData%RR0(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%kappa) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7809,8 +7745,14 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%kappa,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%kappa)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%kappa))-1 ) = PACK(InData%kappa,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%kappa) + DO i3 = LBOUND(InData%kappa,3), UBOUND(InData%kappa,3) + DO i2 = LBOUND(InData%kappa,2), UBOUND(InData%kappa,2) + DO i1 = LBOUND(InData%kappa,1), UBOUND(InData%kappa,1) + DbKiBuf(Db_Xferred) = InData%kappa(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%E1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7828,8 +7770,14 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%E1,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%E1)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%E1))-1 ) = PACK(InData%E1,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%E1) + DO i3 = LBOUND(InData%E1,3), UBOUND(InData%E1,3) + DO i2 = LBOUND(InData%E1,2), UBOUND(InData%E1,2) + DO i1 = LBOUND(InData%E1,1), UBOUND(InData%E1,1) + DbKiBuf(Db_Xferred) = InData%E1(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Stif) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7850,8 +7798,16 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Stif,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Stif)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Stif))-1 ) = PACK(InData%Stif,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Stif) + DO i4 = LBOUND(InData%Stif,4), UBOUND(InData%Stif,4) + DO i3 = LBOUND(InData%Stif,3), UBOUND(InData%Stif,3) + DO i2 = LBOUND(InData%Stif,2), UBOUND(InData%Stif,2) + DO i1 = LBOUND(InData%Stif,1), UBOUND(InData%Stif,1) + DbKiBuf(Db_Xferred) = InData%Stif(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Fb) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7869,8 +7825,14 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fb,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Fb)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Fb))-1 ) = PACK(InData%Fb,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Fb) + DO i3 = LBOUND(InData%Fb,3), UBOUND(InData%Fb,3) + DO i2 = LBOUND(InData%Fb,2), UBOUND(InData%Fb,2) + DO i1 = LBOUND(InData%Fb,1), UBOUND(InData%Fb,1) + DbKiBuf(Db_Xferred) = InData%Fb(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Fc) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7888,8 +7850,14 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fc,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Fc)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Fc))-1 ) = PACK(InData%Fc,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Fc) + DO i3 = LBOUND(InData%Fc,3), UBOUND(InData%Fc,3) + DO i2 = LBOUND(InData%Fc,2), UBOUND(InData%Fc,2) + DO i1 = LBOUND(InData%Fc,1), UBOUND(InData%Fc,1) + DbKiBuf(Db_Xferred) = InData%Fc(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Fd) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7907,8 +7875,14 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fd,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Fd)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Fd))-1 ) = PACK(InData%Fd,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Fd) + DO i3 = LBOUND(InData%Fd,3), UBOUND(InData%Fd,3) + DO i2 = LBOUND(InData%Fd,2), UBOUND(InData%Fd,2) + DO i1 = LBOUND(InData%Fd,1), UBOUND(InData%Fd,1) + DbKiBuf(Db_Xferred) = InData%Fd(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Fg) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7926,8 +7900,14 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fg,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Fg)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Fg))-1 ) = PACK(InData%Fg,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Fg) + DO i3 = LBOUND(InData%Fg,3), UBOUND(InData%Fg,3) + DO i2 = LBOUND(InData%Fg,2), UBOUND(InData%Fg,2) + DO i1 = LBOUND(InData%Fg,1), UBOUND(InData%Fg,1) + DbKiBuf(Db_Xferred) = InData%Fg(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Fi) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7945,8 +7925,14 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fi,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Fi)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Fi))-1 ) = PACK(InData%Fi,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Fi) + DO i3 = LBOUND(InData%Fi,3), UBOUND(InData%Fi,3) + DO i2 = LBOUND(InData%Fi,2), UBOUND(InData%Fi,2) + DO i1 = LBOUND(InData%Fi,1), UBOUND(InData%Fi,1) + DbKiBuf(Db_Xferred) = InData%Fi(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Ftemp) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7964,8 +7950,14 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ftemp,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Ftemp)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Ftemp))-1 ) = PACK(InData%Ftemp,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Ftemp) + DO i3 = LBOUND(InData%Ftemp,3), UBOUND(InData%Ftemp,3) + DO i2 = LBOUND(InData%Ftemp,2), UBOUND(InData%Ftemp,2) + DO i1 = LBOUND(InData%Ftemp,1), UBOUND(InData%Ftemp,1) + DbKiBuf(Db_Xferred) = InData%Ftemp(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%RR0mEta) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7983,8 +7975,14 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RR0mEta,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RR0mEta)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%RR0mEta))-1 ) = PACK(InData%RR0mEta,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%RR0mEta) + DO i3 = LBOUND(InData%RR0mEta,3), UBOUND(InData%RR0mEta,3) + DO i2 = LBOUND(InData%RR0mEta,2), UBOUND(InData%RR0mEta,2) + DO i1 = LBOUND(InData%RR0mEta,1), UBOUND(InData%RR0mEta,1) + DbKiBuf(Db_Xferred) = InData%RR0mEta(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%rho) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8005,8 +8003,16 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rho,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rho)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rho))-1 ) = PACK(InData%rho,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rho) + DO i4 = LBOUND(InData%rho,4), UBOUND(InData%rho,4) + DO i3 = LBOUND(InData%rho,3), UBOUND(InData%rho,3) + DO i2 = LBOUND(InData%rho,2), UBOUND(InData%rho,2) + DO i1 = LBOUND(InData%rho,1), UBOUND(InData%rho,1) + DbKiBuf(Db_Xferred) = InData%rho(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%betaC) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8027,8 +8033,16 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%betaC,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%betaC)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%betaC))-1 ) = PACK(InData%betaC,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%betaC) + DO i4 = LBOUND(InData%betaC,4), UBOUND(InData%betaC,4) + DO i3 = LBOUND(InData%betaC,3), UBOUND(InData%betaC,3) + DO i2 = LBOUND(InData%betaC,2), UBOUND(InData%betaC,2) + DO i1 = LBOUND(InData%betaC,1), UBOUND(InData%betaC,1) + DbKiBuf(Db_Xferred) = InData%betaC(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Gi) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8049,8 +8063,16 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gi,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Gi)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Gi))-1 ) = PACK(InData%Gi,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Gi) + DO i4 = LBOUND(InData%Gi,4), UBOUND(InData%Gi,4) + DO i3 = LBOUND(InData%Gi,3), UBOUND(InData%Gi,3) + DO i2 = LBOUND(InData%Gi,2), UBOUND(InData%Gi,2) + DO i1 = LBOUND(InData%Gi,1), UBOUND(InData%Gi,1) + DbKiBuf(Db_Xferred) = InData%Gi(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Ki) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8071,8 +8093,16 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ki,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Ki)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Ki))-1 ) = PACK(InData%Ki,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Ki) + DO i4 = LBOUND(InData%Ki,4), UBOUND(InData%Ki,4) + DO i3 = LBOUND(InData%Ki,3), UBOUND(InData%Ki,3) + DO i2 = LBOUND(InData%Ki,2), UBOUND(InData%Ki,2) + DO i1 = LBOUND(InData%Ki,1), UBOUND(InData%Ki,1) + DbKiBuf(Db_Xferred) = InData%Ki(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Mi) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8093,8 +8123,16 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mi,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Mi)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Mi))-1 ) = PACK(InData%Mi,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Mi) + DO i4 = LBOUND(InData%Mi,4), UBOUND(InData%Mi,4) + DO i3 = LBOUND(InData%Mi,3), UBOUND(InData%Mi,3) + DO i2 = LBOUND(InData%Mi,2), UBOUND(InData%Mi,2) + DO i1 = LBOUND(InData%Mi,1), UBOUND(InData%Mi,1) + DbKiBuf(Db_Xferred) = InData%Mi(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Oe) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8115,8 +8153,16 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Oe,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Oe)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Oe))-1 ) = PACK(InData%Oe,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Oe) + DO i4 = LBOUND(InData%Oe,4), UBOUND(InData%Oe,4) + DO i3 = LBOUND(InData%Oe,3), UBOUND(InData%Oe,3) + DO i2 = LBOUND(InData%Oe,2), UBOUND(InData%Oe,2) + DO i1 = LBOUND(InData%Oe,1), UBOUND(InData%Oe,1) + DbKiBuf(Db_Xferred) = InData%Oe(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Pe) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8137,8 +8183,16 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pe,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Pe)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Pe))-1 ) = PACK(InData%Pe,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Pe) + DO i4 = LBOUND(InData%Pe,4), UBOUND(InData%Pe,4) + DO i3 = LBOUND(InData%Pe,3), UBOUND(InData%Pe,3) + DO i2 = LBOUND(InData%Pe,2), UBOUND(InData%Pe,2) + DO i1 = LBOUND(InData%Pe,1), UBOUND(InData%Pe,1) + DbKiBuf(Db_Xferred) = InData%Pe(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Qe) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8159,8 +8213,16 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Qe,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Qe)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Qe))-1 ) = PACK(InData%Qe,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Qe) + DO i4 = LBOUND(InData%Qe,4), UBOUND(InData%Qe,4) + DO i3 = LBOUND(InData%Qe,3), UBOUND(InData%Qe,3) + DO i2 = LBOUND(InData%Qe,2), UBOUND(InData%Qe,2) + DO i1 = LBOUND(InData%Qe,1), UBOUND(InData%Qe,1) + DbKiBuf(Db_Xferred) = InData%Qe(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Gd) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8181,8 +8243,16 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gd,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Gd)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Gd))-1 ) = PACK(InData%Gd,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Gd) + DO i4 = LBOUND(InData%Gd,4), UBOUND(InData%Gd,4) + DO i3 = LBOUND(InData%Gd,3), UBOUND(InData%Gd,3) + DO i2 = LBOUND(InData%Gd,2), UBOUND(InData%Gd,2) + DO i1 = LBOUND(InData%Gd,1), UBOUND(InData%Gd,1) + DbKiBuf(Db_Xferred) = InData%Gd(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Od) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8203,8 +8273,16 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Od,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Od)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Od))-1 ) = PACK(InData%Od,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Od) + DO i4 = LBOUND(InData%Od,4), UBOUND(InData%Od,4) + DO i3 = LBOUND(InData%Od,3), UBOUND(InData%Od,3) + DO i2 = LBOUND(InData%Od,2), UBOUND(InData%Od,2) + DO i1 = LBOUND(InData%Od,1), UBOUND(InData%Od,1) + DbKiBuf(Db_Xferred) = InData%Od(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Pd) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8225,8 +8303,16 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pd,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Pd)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Pd))-1 ) = PACK(InData%Pd,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Pd) + DO i4 = LBOUND(InData%Pd,4), UBOUND(InData%Pd,4) + DO i3 = LBOUND(InData%Pd,3), UBOUND(InData%Pd,3) + DO i2 = LBOUND(InData%Pd,2), UBOUND(InData%Pd,2) + DO i1 = LBOUND(InData%Pd,1), UBOUND(InData%Pd,1) + DbKiBuf(Db_Xferred) = InData%Pd(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Qd) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8247,8 +8333,16 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Qd,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Qd)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Qd))-1 ) = PACK(InData%Qd,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Qd) + DO i4 = LBOUND(InData%Qd,4), UBOUND(InData%Qd,4) + DO i3 = LBOUND(InData%Qd,3), UBOUND(InData%Qd,3) + DO i2 = LBOUND(InData%Qd,2), UBOUND(InData%Qd,2) + DO i1 = LBOUND(InData%Qd,1), UBOUND(InData%Qd,1) + DbKiBuf(Db_Xferred) = InData%Qd(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Sd) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8269,8 +8363,16 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Sd,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Sd)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Sd))-1 ) = PACK(InData%Sd,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Sd) + DO i4 = LBOUND(InData%Sd,4), UBOUND(InData%Sd,4) + DO i3 = LBOUND(InData%Sd,3), UBOUND(InData%Sd,3) + DO i2 = LBOUND(InData%Sd,2), UBOUND(InData%Sd,2) + DO i1 = LBOUND(InData%Sd,1), UBOUND(InData%Sd,1) + DbKiBuf(Db_Xferred) = InData%Sd(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Xd) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8291,8 +8393,16 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Xd,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Xd)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Xd))-1 ) = PACK(InData%Xd,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Xd) + DO i4 = LBOUND(InData%Xd,4), UBOUND(InData%Xd,4) + DO i3 = LBOUND(InData%Xd,3), UBOUND(InData%Xd,3) + DO i2 = LBOUND(InData%Xd,2), UBOUND(InData%Xd,2) + DO i1 = LBOUND(InData%Xd,1), UBOUND(InData%Xd,1) + DbKiBuf(Db_Xferred) = InData%Xd(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Yd) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8313,8 +8423,16 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Yd,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Yd)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Yd))-1 ) = PACK(InData%Yd,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Yd) + DO i4 = LBOUND(InData%Yd,4), UBOUND(InData%Yd,4) + DO i3 = LBOUND(InData%Yd,3), UBOUND(InData%Yd,3) + DO i2 = LBOUND(InData%Yd,2), UBOUND(InData%Yd,2) + DO i1 = LBOUND(InData%Yd,1), UBOUND(InData%Yd,1) + DbKiBuf(Db_Xferred) = InData%Yd(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF END SUBROUTINE BD_PackEqMotionQP @@ -8331,12 +8449,6 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -8373,15 +8485,14 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%uuu.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%uuu)>0) OutData%uuu = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%uuu))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%uuu) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%uuu,3), UBOUND(OutData%uuu,3) + DO i2 = LBOUND(OutData%uuu,2), UBOUND(OutData%uuu,2) + DO i1 = LBOUND(OutData%uuu,1), UBOUND(OutData%uuu,1) + OutData%uuu(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! uup not allocated Int_Xferred = Int_Xferred + 1 @@ -8402,15 +8513,14 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%uup.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%uup)>0) OutData%uup = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%uup))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%uup) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%uup,3), UBOUND(OutData%uup,3) + DO i2 = LBOUND(OutData%uup,2), UBOUND(OutData%uup,2) + DO i1 = LBOUND(OutData%uup,1), UBOUND(OutData%uup,1) + OutData%uup(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! vvv not allocated Int_Xferred = Int_Xferred + 1 @@ -8431,15 +8541,14 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%vvv.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%vvv)>0) OutData%vvv = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%vvv))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%vvv) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%vvv,3), UBOUND(OutData%vvv,3) + DO i2 = LBOUND(OutData%vvv,2), UBOUND(OutData%vvv,2) + DO i1 = LBOUND(OutData%vvv,1), UBOUND(OutData%vvv,1) + OutData%vvv(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! vvp not allocated Int_Xferred = Int_Xferred + 1 @@ -8460,15 +8569,14 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%vvp.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%vvp)>0) OutData%vvp = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%vvp))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%vvp) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%vvp,3), UBOUND(OutData%vvp,3) + DO i2 = LBOUND(OutData%vvp,2), UBOUND(OutData%vvp,2) + DO i1 = LBOUND(OutData%vvp,1), UBOUND(OutData%vvp,1) + OutData%vvp(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! aaa not allocated Int_Xferred = Int_Xferred + 1 @@ -8489,15 +8597,14 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%aaa.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%aaa)>0) OutData%aaa = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%aaa))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%aaa) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%aaa,3), UBOUND(OutData%aaa,3) + DO i2 = LBOUND(OutData%aaa,2), UBOUND(OutData%aaa,2) + DO i1 = LBOUND(OutData%aaa,1), UBOUND(OutData%aaa,1) + OutData%aaa(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RR0 not allocated Int_Xferred = Int_Xferred + 1 @@ -8521,15 +8628,16 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RR0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%RR0)>0) OutData%RR0 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%RR0))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%RR0) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%RR0,4), UBOUND(OutData%RR0,4) + DO i3 = LBOUND(OutData%RR0,3), UBOUND(OutData%RR0,3) + DO i2 = LBOUND(OutData%RR0,2), UBOUND(OutData%RR0,2) + DO i1 = LBOUND(OutData%RR0,1), UBOUND(OutData%RR0,1) + OutData%RR0(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! kappa not allocated Int_Xferred = Int_Xferred + 1 @@ -8550,15 +8658,14 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%kappa.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%kappa)>0) OutData%kappa = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%kappa))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%kappa) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%kappa,3), UBOUND(OutData%kappa,3) + DO i2 = LBOUND(OutData%kappa,2), UBOUND(OutData%kappa,2) + DO i1 = LBOUND(OutData%kappa,1), UBOUND(OutData%kappa,1) + OutData%kappa(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! E1 not allocated Int_Xferred = Int_Xferred + 1 @@ -8579,15 +8686,14 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%E1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%E1)>0) OutData%E1 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%E1))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%E1) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%E1,3), UBOUND(OutData%E1,3) + DO i2 = LBOUND(OutData%E1,2), UBOUND(OutData%E1,2) + DO i1 = LBOUND(OutData%E1,1), UBOUND(OutData%E1,1) + OutData%E1(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Stif not allocated Int_Xferred = Int_Xferred + 1 @@ -8611,15 +8717,16 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Stif.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%Stif)>0) OutData%Stif = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Stif))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Stif) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%Stif,4), UBOUND(OutData%Stif,4) + DO i3 = LBOUND(OutData%Stif,3), UBOUND(OutData%Stif,3) + DO i2 = LBOUND(OutData%Stif,2), UBOUND(OutData%Stif,2) + DO i1 = LBOUND(OutData%Stif,1), UBOUND(OutData%Stif,1) + OutData%Stif(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fb not allocated Int_Xferred = Int_Xferred + 1 @@ -8640,15 +8747,14 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fb.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%Fb)>0) OutData%Fb = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Fb))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Fb) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%Fb,3), UBOUND(OutData%Fb,3) + DO i2 = LBOUND(OutData%Fb,2), UBOUND(OutData%Fb,2) + DO i1 = LBOUND(OutData%Fb,1), UBOUND(OutData%Fb,1) + OutData%Fb(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fc not allocated Int_Xferred = Int_Xferred + 1 @@ -8669,15 +8775,14 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fc.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%Fc)>0) OutData%Fc = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Fc))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Fc) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%Fc,3), UBOUND(OutData%Fc,3) + DO i2 = LBOUND(OutData%Fc,2), UBOUND(OutData%Fc,2) + DO i1 = LBOUND(OutData%Fc,1), UBOUND(OutData%Fc,1) + OutData%Fc(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fd not allocated Int_Xferred = Int_Xferred + 1 @@ -8698,15 +8803,14 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fd.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%Fd)>0) OutData%Fd = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Fd))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Fd) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%Fd,3), UBOUND(OutData%Fd,3) + DO i2 = LBOUND(OutData%Fd,2), UBOUND(OutData%Fd,2) + DO i1 = LBOUND(OutData%Fd,1), UBOUND(OutData%Fd,1) + OutData%Fd(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fg not allocated Int_Xferred = Int_Xferred + 1 @@ -8727,15 +8831,14 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fg.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%Fg)>0) OutData%Fg = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Fg))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Fg) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%Fg,3), UBOUND(OutData%Fg,3) + DO i2 = LBOUND(OutData%Fg,2), UBOUND(OutData%Fg,2) + DO i1 = LBOUND(OutData%Fg,1), UBOUND(OutData%Fg,1) + OutData%Fg(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fi not allocated Int_Xferred = Int_Xferred + 1 @@ -8756,15 +8859,14 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%Fi)>0) OutData%Fi = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Fi))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Fi) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%Fi,3), UBOUND(OutData%Fi,3) + DO i2 = LBOUND(OutData%Fi,2), UBOUND(OutData%Fi,2) + DO i1 = LBOUND(OutData%Fi,1), UBOUND(OutData%Fi,1) + OutData%Fi(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Ftemp not allocated Int_Xferred = Int_Xferred + 1 @@ -8785,15 +8887,14 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ftemp.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%Ftemp)>0) OutData%Ftemp = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Ftemp))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Ftemp) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%Ftemp,3), UBOUND(OutData%Ftemp,3) + DO i2 = LBOUND(OutData%Ftemp,2), UBOUND(OutData%Ftemp,2) + DO i1 = LBOUND(OutData%Ftemp,1), UBOUND(OutData%Ftemp,1) + OutData%Ftemp(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RR0mEta not allocated Int_Xferred = Int_Xferred + 1 @@ -8814,15 +8915,14 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RR0mEta.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%RR0mEta)>0) OutData%RR0mEta = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%RR0mEta))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%RR0mEta) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%RR0mEta,3), UBOUND(OutData%RR0mEta,3) + DO i2 = LBOUND(OutData%RR0mEta,2), UBOUND(OutData%RR0mEta,2) + DO i1 = LBOUND(OutData%RR0mEta,1), UBOUND(OutData%RR0mEta,1) + OutData%RR0mEta(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rho not allocated Int_Xferred = Int_Xferred + 1 @@ -8846,15 +8946,16 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rho.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%rho)>0) OutData%rho = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rho))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rho) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%rho,4), UBOUND(OutData%rho,4) + DO i3 = LBOUND(OutData%rho,3), UBOUND(OutData%rho,3) + DO i2 = LBOUND(OutData%rho,2), UBOUND(OutData%rho,2) + DO i1 = LBOUND(OutData%rho,1), UBOUND(OutData%rho,1) + OutData%rho(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! betaC not allocated Int_Xferred = Int_Xferred + 1 @@ -8878,15 +8979,16 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%betaC.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%betaC)>0) OutData%betaC = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%betaC))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%betaC) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%betaC,4), UBOUND(OutData%betaC,4) + DO i3 = LBOUND(OutData%betaC,3), UBOUND(OutData%betaC,3) + DO i2 = LBOUND(OutData%betaC,2), UBOUND(OutData%betaC,2) + DO i1 = LBOUND(OutData%betaC,1), UBOUND(OutData%betaC,1) + OutData%betaC(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Gi not allocated Int_Xferred = Int_Xferred + 1 @@ -8910,15 +9012,16 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Gi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%Gi)>0) OutData%Gi = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Gi))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Gi) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%Gi,4), UBOUND(OutData%Gi,4) + DO i3 = LBOUND(OutData%Gi,3), UBOUND(OutData%Gi,3) + DO i2 = LBOUND(OutData%Gi,2), UBOUND(OutData%Gi,2) + DO i1 = LBOUND(OutData%Gi,1), UBOUND(OutData%Gi,1) + OutData%Gi(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Ki not allocated Int_Xferred = Int_Xferred + 1 @@ -8942,15 +9045,16 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ki.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%Ki)>0) OutData%Ki = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Ki))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Ki) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%Ki,4), UBOUND(OutData%Ki,4) + DO i3 = LBOUND(OutData%Ki,3), UBOUND(OutData%Ki,3) + DO i2 = LBOUND(OutData%Ki,2), UBOUND(OutData%Ki,2) + DO i1 = LBOUND(OutData%Ki,1), UBOUND(OutData%Ki,1) + OutData%Ki(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Mi not allocated Int_Xferred = Int_Xferred + 1 @@ -8974,15 +9078,16 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%Mi)>0) OutData%Mi = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Mi))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Mi) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%Mi,4), UBOUND(OutData%Mi,4) + DO i3 = LBOUND(OutData%Mi,3), UBOUND(OutData%Mi,3) + DO i2 = LBOUND(OutData%Mi,2), UBOUND(OutData%Mi,2) + DO i1 = LBOUND(OutData%Mi,1), UBOUND(OutData%Mi,1) + OutData%Mi(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Oe not allocated Int_Xferred = Int_Xferred + 1 @@ -9006,15 +9111,16 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Oe.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%Oe)>0) OutData%Oe = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Oe))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Oe) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%Oe,4), UBOUND(OutData%Oe,4) + DO i3 = LBOUND(OutData%Oe,3), UBOUND(OutData%Oe,3) + DO i2 = LBOUND(OutData%Oe,2), UBOUND(OutData%Oe,2) + DO i1 = LBOUND(OutData%Oe,1), UBOUND(OutData%Oe,1) + OutData%Oe(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Pe not allocated Int_Xferred = Int_Xferred + 1 @@ -9038,15 +9144,16 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Pe.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%Pe)>0) OutData%Pe = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Pe))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Pe) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%Pe,4), UBOUND(OutData%Pe,4) + DO i3 = LBOUND(OutData%Pe,3), UBOUND(OutData%Pe,3) + DO i2 = LBOUND(OutData%Pe,2), UBOUND(OutData%Pe,2) + DO i1 = LBOUND(OutData%Pe,1), UBOUND(OutData%Pe,1) + OutData%Pe(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Qe not allocated Int_Xferred = Int_Xferred + 1 @@ -9070,15 +9177,16 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Qe.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%Qe)>0) OutData%Qe = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Qe))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Qe) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%Qe,4), UBOUND(OutData%Qe,4) + DO i3 = LBOUND(OutData%Qe,3), UBOUND(OutData%Qe,3) + DO i2 = LBOUND(OutData%Qe,2), UBOUND(OutData%Qe,2) + DO i1 = LBOUND(OutData%Qe,1), UBOUND(OutData%Qe,1) + OutData%Qe(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Gd not allocated Int_Xferred = Int_Xferred + 1 @@ -9102,15 +9210,16 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Gd.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%Gd)>0) OutData%Gd = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Gd))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Gd) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%Gd,4), UBOUND(OutData%Gd,4) + DO i3 = LBOUND(OutData%Gd,3), UBOUND(OutData%Gd,3) + DO i2 = LBOUND(OutData%Gd,2), UBOUND(OutData%Gd,2) + DO i1 = LBOUND(OutData%Gd,1), UBOUND(OutData%Gd,1) + OutData%Gd(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Od not allocated Int_Xferred = Int_Xferred + 1 @@ -9134,15 +9243,16 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Od.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%Od)>0) OutData%Od = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Od))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Od) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%Od,4), UBOUND(OutData%Od,4) + DO i3 = LBOUND(OutData%Od,3), UBOUND(OutData%Od,3) + DO i2 = LBOUND(OutData%Od,2), UBOUND(OutData%Od,2) + DO i1 = LBOUND(OutData%Od,1), UBOUND(OutData%Od,1) + OutData%Od(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Pd not allocated Int_Xferred = Int_Xferred + 1 @@ -9166,15 +9276,16 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Pd.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%Pd)>0) OutData%Pd = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Pd))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Pd) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%Pd,4), UBOUND(OutData%Pd,4) + DO i3 = LBOUND(OutData%Pd,3), UBOUND(OutData%Pd,3) + DO i2 = LBOUND(OutData%Pd,2), UBOUND(OutData%Pd,2) + DO i1 = LBOUND(OutData%Pd,1), UBOUND(OutData%Pd,1) + OutData%Pd(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Qd not allocated Int_Xferred = Int_Xferred + 1 @@ -9198,15 +9309,16 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Qd.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%Qd)>0) OutData%Qd = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Qd))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Qd) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%Qd,4), UBOUND(OutData%Qd,4) + DO i3 = LBOUND(OutData%Qd,3), UBOUND(OutData%Qd,3) + DO i2 = LBOUND(OutData%Qd,2), UBOUND(OutData%Qd,2) + DO i1 = LBOUND(OutData%Qd,1), UBOUND(OutData%Qd,1) + OutData%Qd(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Sd not allocated Int_Xferred = Int_Xferred + 1 @@ -9230,15 +9342,16 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Sd.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%Sd)>0) OutData%Sd = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Sd))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Sd) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%Sd,4), UBOUND(OutData%Sd,4) + DO i3 = LBOUND(OutData%Sd,3), UBOUND(OutData%Sd,3) + DO i2 = LBOUND(OutData%Sd,2), UBOUND(OutData%Sd,2) + DO i1 = LBOUND(OutData%Sd,1), UBOUND(OutData%Sd,1) + OutData%Sd(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Xd not allocated Int_Xferred = Int_Xferred + 1 @@ -9262,15 +9375,16 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Xd.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%Xd)>0) OutData%Xd = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Xd))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Xd) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%Xd,4), UBOUND(OutData%Xd,4) + DO i3 = LBOUND(OutData%Xd,3), UBOUND(OutData%Xd,3) + DO i2 = LBOUND(OutData%Xd,2), UBOUND(OutData%Xd,2) + DO i1 = LBOUND(OutData%Xd,1), UBOUND(OutData%Xd,1) + OutData%Xd(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Yd not allocated Int_Xferred = Int_Xferred + 1 @@ -9294,15 +9408,16 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Yd.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%Yd)>0) OutData%Yd = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Yd))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Yd) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%Yd,4), UBOUND(OutData%Yd,4) + DO i3 = LBOUND(OutData%Yd,3), UBOUND(OutData%Yd,3) + DO i2 = LBOUND(OutData%Yd,2), UBOUND(OutData%Yd,2) + DO i1 = LBOUND(OutData%Yd,1), UBOUND(OutData%Yd,1) + OutData%Yd(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF END SUBROUTINE BD_UnPackEqMotionQP @@ -10355,8 +10470,8 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Un_Sum - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Un_Sum + Int_Xferred = Int_Xferred + 1 CALL BD_Packeqmotionqp( Re_Buf, Db_Buf, Int_Buf, InData%qp, ErrStat2, ErrMsg2, OnlySize ) ! qp CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -10398,8 +10513,12 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%lin_A,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%lin_A)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%lin_A))-1 ) = PACK(InData%lin_A,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%lin_A) + DO i2 = LBOUND(InData%lin_A,2), UBOUND(InData%lin_A,2) + DO i1 = LBOUND(InData%lin_A,1), UBOUND(InData%lin_A,1) + DbKiBuf(Db_Xferred) = InData%lin_A(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%lin_C) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10414,8 +10533,12 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%lin_C,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%lin_C)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%lin_C))-1 ) = PACK(InData%lin_C,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%lin_C) + DO i2 = LBOUND(InData%lin_C,2), UBOUND(InData%lin_C,2) + DO i1 = LBOUND(InData%lin_C,1), UBOUND(InData%lin_C,1) + DbKiBuf(Db_Xferred) = InData%lin_C(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Nrrr) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10433,8 +10556,14 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nrrr,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Nrrr)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Nrrr))-1 ) = PACK(InData%Nrrr,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Nrrr) + DO i3 = LBOUND(InData%Nrrr,3), UBOUND(InData%Nrrr,3) + DO i2 = LBOUND(InData%Nrrr,2), UBOUND(InData%Nrrr,2) + DO i1 = LBOUND(InData%Nrrr,1), UBOUND(InData%Nrrr,1) + DbKiBuf(Db_Xferred) = InData%Nrrr(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%elf) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10449,8 +10578,12 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%elf,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%elf)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%elf))-1 ) = PACK(InData%elf,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%elf) + DO i2 = LBOUND(InData%elf,2), UBOUND(InData%elf,2) + DO i1 = LBOUND(InData%elf,1), UBOUND(InData%elf,1) + DbKiBuf(Db_Xferred) = InData%elf(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%EFint) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10468,8 +10601,14 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EFint,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%EFint)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%EFint))-1 ) = PACK(InData%EFint,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%EFint) + DO i3 = LBOUND(InData%EFint,3), UBOUND(InData%EFint,3) + DO i2 = LBOUND(InData%EFint,2), UBOUND(InData%EFint,2) + DO i1 = LBOUND(InData%EFint,1), UBOUND(InData%EFint,1) + DbKiBuf(Db_Xferred) = InData%EFint(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%elk) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10490,8 +10629,16 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%elk,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%elk)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%elk))-1 ) = PACK(InData%elk,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%elk) + DO i4 = LBOUND(InData%elk,4), UBOUND(InData%elk,4) + DO i3 = LBOUND(InData%elk,3), UBOUND(InData%elk,3) + DO i2 = LBOUND(InData%elk,2), UBOUND(InData%elk,2) + DO i1 = LBOUND(InData%elk,1), UBOUND(InData%elk,1) + DbKiBuf(Db_Xferred) = InData%elk(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%elg) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10512,8 +10659,16 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%elg,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%elg)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%elg))-1 ) = PACK(InData%elg,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%elg) + DO i4 = LBOUND(InData%elg,4), UBOUND(InData%elg,4) + DO i3 = LBOUND(InData%elg,3), UBOUND(InData%elg,3) + DO i2 = LBOUND(InData%elg,2), UBOUND(InData%elg,2) + DO i1 = LBOUND(InData%elg,1), UBOUND(InData%elg,1) + DbKiBuf(Db_Xferred) = InData%elg(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%elm) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10534,8 +10689,16 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%elm,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%elm)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%elm))-1 ) = PACK(InData%elm,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%elm) + DO i4 = LBOUND(InData%elm,4), UBOUND(InData%elm,4) + DO i3 = LBOUND(InData%elm,3), UBOUND(InData%elm,3) + DO i2 = LBOUND(InData%elm,2), UBOUND(InData%elm,2) + DO i1 = LBOUND(InData%elm,1), UBOUND(InData%elm,1) + DbKiBuf(Db_Xferred) = InData%elm(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%DistrLoad_QP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10553,8 +10716,14 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DistrLoad_QP,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DistrLoad_QP)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%DistrLoad_QP))-1 ) = PACK(InData%DistrLoad_QP,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%DistrLoad_QP) + DO i3 = LBOUND(InData%DistrLoad_QP,3), UBOUND(InData%DistrLoad_QP,3) + DO i2 = LBOUND(InData%DistrLoad_QP,2), UBOUND(InData%DistrLoad_QP,2) + DO i1 = LBOUND(InData%DistrLoad_QP,1), UBOUND(InData%DistrLoad_QP,1) + DbKiBuf(Db_Xferred) = InData%DistrLoad_QP(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PointLoadLcl) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10569,8 +10738,12 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PointLoadLcl,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PointLoadLcl)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%PointLoadLcl))-1 ) = PACK(InData%PointLoadLcl,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%PointLoadLcl) + DO i2 = LBOUND(InData%PointLoadLcl,2), UBOUND(InData%PointLoadLcl,2) + DO i1 = LBOUND(InData%PointLoadLcl,1), UBOUND(InData%PointLoadLcl,1) + DbKiBuf(Db_Xferred) = InData%PointLoadLcl(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%StifK) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10591,8 +10764,16 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StifK,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%StifK)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%StifK))-1 ) = PACK(InData%StifK,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%StifK) + DO i4 = LBOUND(InData%StifK,4), UBOUND(InData%StifK,4) + DO i3 = LBOUND(InData%StifK,3), UBOUND(InData%StifK,3) + DO i2 = LBOUND(InData%StifK,2), UBOUND(InData%StifK,2) + DO i1 = LBOUND(InData%StifK,1), UBOUND(InData%StifK,1) + DbKiBuf(Db_Xferred) = InData%StifK(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%MassM) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10613,8 +10794,16 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MassM,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%MassM)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%MassM))-1 ) = PACK(InData%MassM,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%MassM) + DO i4 = LBOUND(InData%MassM,4), UBOUND(InData%MassM,4) + DO i3 = LBOUND(InData%MassM,3), UBOUND(InData%MassM,3) + DO i2 = LBOUND(InData%MassM,2), UBOUND(InData%MassM,2) + DO i1 = LBOUND(InData%MassM,1), UBOUND(InData%MassM,1) + DbKiBuf(Db_Xferred) = InData%MassM(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%DampG) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10635,8 +10824,16 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DampG,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DampG)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%DampG))-1 ) = PACK(InData%DampG,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%DampG) + DO i4 = LBOUND(InData%DampG,4), UBOUND(InData%DampG,4) + DO i3 = LBOUND(InData%DampG,3), UBOUND(InData%DampG,3) + DO i2 = LBOUND(InData%DampG,2), UBOUND(InData%DampG,2) + DO i1 = LBOUND(InData%DampG,1), UBOUND(InData%DampG,1) + DbKiBuf(Db_Xferred) = InData%DampG(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%StifK_fd) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10657,8 +10854,16 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StifK_fd,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%StifK_fd)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%StifK_fd))-1 ) = PACK(InData%StifK_fd,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%StifK_fd) + DO i4 = LBOUND(InData%StifK_fd,4), UBOUND(InData%StifK_fd,4) + DO i3 = LBOUND(InData%StifK_fd,3), UBOUND(InData%StifK_fd,3) + DO i2 = LBOUND(InData%StifK_fd,2), UBOUND(InData%StifK_fd,2) + DO i1 = LBOUND(InData%StifK_fd,1), UBOUND(InData%StifK_fd,1) + DbKiBuf(Db_Xferred) = InData%StifK_fd(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%MassM_fd) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10679,8 +10884,16 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MassM_fd,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%MassM_fd)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%MassM_fd))-1 ) = PACK(InData%MassM_fd,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%MassM_fd) + DO i4 = LBOUND(InData%MassM_fd,4), UBOUND(InData%MassM_fd,4) + DO i3 = LBOUND(InData%MassM_fd,3), UBOUND(InData%MassM_fd,3) + DO i2 = LBOUND(InData%MassM_fd,2), UBOUND(InData%MassM_fd,2) + DO i1 = LBOUND(InData%MassM_fd,1), UBOUND(InData%MassM_fd,1) + DbKiBuf(Db_Xferred) = InData%MassM_fd(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%DampG_fd) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10701,8 +10914,16 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DampG_fd,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DampG_fd)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%DampG_fd))-1 ) = PACK(InData%DampG_fd,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%DampG_fd) + DO i4 = LBOUND(InData%DampG_fd,4), UBOUND(InData%DampG_fd,4) + DO i3 = LBOUND(InData%DampG_fd,3), UBOUND(InData%DampG_fd,3) + DO i2 = LBOUND(InData%DampG_fd,2), UBOUND(InData%DampG_fd,2) + DO i1 = LBOUND(InData%DampG_fd,1), UBOUND(InData%DampG_fd,1) + DbKiBuf(Db_Xferred) = InData%DampG_fd(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%RHS) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10717,8 +10938,12 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RHS,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RHS)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%RHS))-1 ) = PACK(InData%RHS,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%RHS) + DO i2 = LBOUND(InData%RHS,2), UBOUND(InData%RHS,2) + DO i1 = LBOUND(InData%RHS,1), UBOUND(InData%RHS,1) + DbKiBuf(Db_Xferred) = InData%RHS(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%RHS_p) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10733,8 +10958,12 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RHS_p,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RHS_p)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%RHS_p))-1 ) = PACK(InData%RHS_p,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%RHS_p) + DO i2 = LBOUND(InData%RHS_p,2), UBOUND(InData%RHS_p,2) + DO i1 = LBOUND(InData%RHS_p,1), UBOUND(InData%RHS_p,1) + DbKiBuf(Db_Xferred) = InData%RHS_p(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%RHS_m) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10749,8 +10978,12 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RHS_m,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RHS_m)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%RHS_m))-1 ) = PACK(InData%RHS_m,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%RHS_m) + DO i2 = LBOUND(InData%RHS_m,2), UBOUND(InData%RHS_m,2) + DO i1 = LBOUND(InData%RHS_m,1), UBOUND(InData%RHS_m,1) + DbKiBuf(Db_Xferred) = InData%RHS_m(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%BldInternalForceFE) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10765,8 +10998,12 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldInternalForceFE,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BldInternalForceFE)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%BldInternalForceFE))-1 ) = PACK(InData%BldInternalForceFE,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%BldInternalForceFE) + DO i2 = LBOUND(InData%BldInternalForceFE,2), UBOUND(InData%BldInternalForceFE,2) + DO i1 = LBOUND(InData%BldInternalForceFE,1), UBOUND(InData%BldInternalForceFE,1) + DbKiBuf(Db_Xferred) = InData%BldInternalForceFE(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%BldInternalForceQP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10781,8 +11018,12 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldInternalForceQP,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BldInternalForceQP)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%BldInternalForceQP))-1 ) = PACK(InData%BldInternalForceQP,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%BldInternalForceQP) + DO i2 = LBOUND(InData%BldInternalForceQP,2), UBOUND(InData%BldInternalForceQP,2) + DO i1 = LBOUND(InData%BldInternalForceQP,1), UBOUND(InData%BldInternalForceQP,1) + DbKiBuf(Db_Xferred) = InData%BldInternalForceQP(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FirstNodeReactionLclForceMoment) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10794,8 +11035,10 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FirstNodeReactionLclForceMoment,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FirstNodeReactionLclForceMoment)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%FirstNodeReactionLclForceMoment))-1 ) = PACK(InData%FirstNodeReactionLclForceMoment,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%FirstNodeReactionLclForceMoment) + DO i1 = LBOUND(InData%FirstNodeReactionLclForceMoment,1), UBOUND(InData%FirstNodeReactionLclForceMoment,1) + DbKiBuf(Db_Xferred) = InData%FirstNodeReactionLclForceMoment(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%Solution) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10810,8 +11053,12 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Solution,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Solution)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Solution))-1 ) = PACK(InData%Solution,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Solution) + DO i2 = LBOUND(InData%Solution,2), UBOUND(InData%Solution,2) + DO i1 = LBOUND(InData%Solution,1), UBOUND(InData%Solution,1) + DbKiBuf(Db_Xferred) = InData%Solution(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%LP_StifK) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10826,8 +11073,12 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LP_StifK,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LP_StifK)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%LP_StifK))-1 ) = PACK(InData%LP_StifK,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%LP_StifK) + DO i2 = LBOUND(InData%LP_StifK,2), UBOUND(InData%LP_StifK,2) + DO i1 = LBOUND(InData%LP_StifK,1), UBOUND(InData%LP_StifK,1) + DbKiBuf(Db_Xferred) = InData%LP_StifK(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%LP_MassM) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10842,8 +11093,12 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LP_MassM,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LP_MassM)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%LP_MassM))-1 ) = PACK(InData%LP_MassM,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%LP_MassM) + DO i2 = LBOUND(InData%LP_MassM,2), UBOUND(InData%LP_MassM,2) + DO i1 = LBOUND(InData%LP_MassM,1), UBOUND(InData%LP_MassM,1) + DbKiBuf(Db_Xferred) = InData%LP_MassM(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%LP_MassM_LU) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10858,8 +11113,12 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LP_MassM_LU,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LP_MassM_LU)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%LP_MassM_LU))-1 ) = PACK(InData%LP_MassM_LU,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%LP_MassM_LU) + DO i2 = LBOUND(InData%LP_MassM_LU,2), UBOUND(InData%LP_MassM_LU,2) + DO i1 = LBOUND(InData%LP_MassM_LU,1), UBOUND(InData%LP_MassM_LU,1) + DbKiBuf(Db_Xferred) = InData%LP_MassM_LU(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%LP_RHS) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10871,8 +11130,10 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LP_RHS,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LP_RHS)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%LP_RHS))-1 ) = PACK(InData%LP_RHS,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%LP_RHS) + DO i1 = LBOUND(InData%LP_RHS,1), UBOUND(InData%LP_RHS,1) + DbKiBuf(Db_Xferred) = InData%LP_RHS(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LP_StifK_LU) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10887,8 +11148,12 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LP_StifK_LU,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LP_StifK_LU)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%LP_StifK_LU))-1 ) = PACK(InData%LP_StifK_LU,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%LP_StifK_LU) + DO i2 = LBOUND(InData%LP_StifK_LU,2), UBOUND(InData%LP_StifK_LU,2) + DO i1 = LBOUND(InData%LP_StifK_LU,1), UBOUND(InData%LP_StifK_LU,1) + DbKiBuf(Db_Xferred) = InData%LP_StifK_LU(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%LP_RHS_LU) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10900,8 +11165,10 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LP_RHS_LU,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LP_RHS_LU)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%LP_RHS_LU))-1 ) = PACK(InData%LP_RHS_LU,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%LP_RHS_LU) + DO i1 = LBOUND(InData%LP_RHS_LU,1), UBOUND(InData%LP_RHS_LU,1) + DbKiBuf(Db_Xferred) = InData%LP_RHS_LU(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LP_indx) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10913,8 +11180,10 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LP_indx,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LP_indx)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%LP_indx))-1 ) = PACK(InData%LP_indx,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%LP_indx) + DO i1 = LBOUND(InData%LP_indx,1), UBOUND(InData%LP_indx,1) + IntKiBuf(Int_Xferred) = InData%LP_indx(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF CALL BD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -10987,12 +11256,6 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -11170,8 +11433,8 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%Un_Sum = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%Un_Sum = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -11228,15 +11491,12 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%lin_A.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%lin_A)>0) OutData%lin_A = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%lin_A))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%lin_A) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%lin_A,2), UBOUND(OutData%lin_A,2) + DO i1 = LBOUND(OutData%lin_A,1), UBOUND(OutData%lin_A,1) + OutData%lin_A(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! lin_C not allocated Int_Xferred = Int_Xferred + 1 @@ -11254,15 +11514,12 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%lin_C.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%lin_C)>0) OutData%lin_C = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%lin_C))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%lin_C) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%lin_C,2), UBOUND(OutData%lin_C,2) + DO i1 = LBOUND(OutData%lin_C,1), UBOUND(OutData%lin_C,1) + OutData%lin_C(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Nrrr not allocated Int_Xferred = Int_Xferred + 1 @@ -11283,15 +11540,14 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nrrr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%Nrrr)>0) OutData%Nrrr = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Nrrr))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Nrrr) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%Nrrr,3), UBOUND(OutData%Nrrr,3) + DO i2 = LBOUND(OutData%Nrrr,2), UBOUND(OutData%Nrrr,2) + DO i1 = LBOUND(OutData%Nrrr,1), UBOUND(OutData%Nrrr,1) + OutData%Nrrr(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! elf not allocated Int_Xferred = Int_Xferred + 1 @@ -11309,15 +11565,12 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%elf.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%elf)>0) OutData%elf = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%elf))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%elf) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%elf,2), UBOUND(OutData%elf,2) + DO i1 = LBOUND(OutData%elf,1), UBOUND(OutData%elf,1) + OutData%elf(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! EFint not allocated Int_Xferred = Int_Xferred + 1 @@ -11338,15 +11591,14 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%EFint.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%EFint)>0) OutData%EFint = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%EFint))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%EFint) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%EFint,3), UBOUND(OutData%EFint,3) + DO i2 = LBOUND(OutData%EFint,2), UBOUND(OutData%EFint,2) + DO i1 = LBOUND(OutData%EFint,1), UBOUND(OutData%EFint,1) + OutData%EFint(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! elk not allocated Int_Xferred = Int_Xferred + 1 @@ -11370,15 +11622,16 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%elk.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%elk)>0) OutData%elk = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%elk))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%elk) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%elk,4), UBOUND(OutData%elk,4) + DO i3 = LBOUND(OutData%elk,3), UBOUND(OutData%elk,3) + DO i2 = LBOUND(OutData%elk,2), UBOUND(OutData%elk,2) + DO i1 = LBOUND(OutData%elk,1), UBOUND(OutData%elk,1) + OutData%elk(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! elg not allocated Int_Xferred = Int_Xferred + 1 @@ -11402,15 +11655,16 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%elg.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%elg)>0) OutData%elg = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%elg))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%elg) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%elg,4), UBOUND(OutData%elg,4) + DO i3 = LBOUND(OutData%elg,3), UBOUND(OutData%elg,3) + DO i2 = LBOUND(OutData%elg,2), UBOUND(OutData%elg,2) + DO i1 = LBOUND(OutData%elg,1), UBOUND(OutData%elg,1) + OutData%elg(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! elm not allocated Int_Xferred = Int_Xferred + 1 @@ -11434,15 +11688,16 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%elm.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%elm)>0) OutData%elm = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%elm))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%elm) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%elm,4), UBOUND(OutData%elm,4) + DO i3 = LBOUND(OutData%elm,3), UBOUND(OutData%elm,3) + DO i2 = LBOUND(OutData%elm,2), UBOUND(OutData%elm,2) + DO i1 = LBOUND(OutData%elm,1), UBOUND(OutData%elm,1) + OutData%elm(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DistrLoad_QP not allocated Int_Xferred = Int_Xferred + 1 @@ -11463,15 +11718,14 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DistrLoad_QP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%DistrLoad_QP)>0) OutData%DistrLoad_QP = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%DistrLoad_QP))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%DistrLoad_QP) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%DistrLoad_QP,3), UBOUND(OutData%DistrLoad_QP,3) + DO i2 = LBOUND(OutData%DistrLoad_QP,2), UBOUND(OutData%DistrLoad_QP,2) + DO i1 = LBOUND(OutData%DistrLoad_QP,1), UBOUND(OutData%DistrLoad_QP,1) + OutData%DistrLoad_QP(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PointLoadLcl not allocated Int_Xferred = Int_Xferred + 1 @@ -11489,15 +11743,12 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PointLoadLcl.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PointLoadLcl)>0) OutData%PointLoadLcl = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%PointLoadLcl))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%PointLoadLcl) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PointLoadLcl,2), UBOUND(OutData%PointLoadLcl,2) + DO i1 = LBOUND(OutData%PointLoadLcl,1), UBOUND(OutData%PointLoadLcl,1) + OutData%PointLoadLcl(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StifK not allocated Int_Xferred = Int_Xferred + 1 @@ -11521,15 +11772,16 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StifK.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%StifK)>0) OutData%StifK = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%StifK))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%StifK) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%StifK,4), UBOUND(OutData%StifK,4) + DO i3 = LBOUND(OutData%StifK,3), UBOUND(OutData%StifK,3) + DO i2 = LBOUND(OutData%StifK,2), UBOUND(OutData%StifK,2) + DO i1 = LBOUND(OutData%StifK,1), UBOUND(OutData%StifK,1) + OutData%StifK(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MassM not allocated Int_Xferred = Int_Xferred + 1 @@ -11553,15 +11805,16 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MassM.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%MassM)>0) OutData%MassM = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%MassM))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%MassM) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%MassM,4), UBOUND(OutData%MassM,4) + DO i3 = LBOUND(OutData%MassM,3), UBOUND(OutData%MassM,3) + DO i2 = LBOUND(OutData%MassM,2), UBOUND(OutData%MassM,2) + DO i1 = LBOUND(OutData%MassM,1), UBOUND(OutData%MassM,1) + OutData%MassM(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DampG not allocated Int_Xferred = Int_Xferred + 1 @@ -11585,15 +11838,16 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DampG.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%DampG)>0) OutData%DampG = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%DampG))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%DampG) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%DampG,4), UBOUND(OutData%DampG,4) + DO i3 = LBOUND(OutData%DampG,3), UBOUND(OutData%DampG,3) + DO i2 = LBOUND(OutData%DampG,2), UBOUND(OutData%DampG,2) + DO i1 = LBOUND(OutData%DampG,1), UBOUND(OutData%DampG,1) + OutData%DampG(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StifK_fd not allocated Int_Xferred = Int_Xferred + 1 @@ -11617,15 +11871,16 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StifK_fd.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%StifK_fd)>0) OutData%StifK_fd = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%StifK_fd))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%StifK_fd) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%StifK_fd,4), UBOUND(OutData%StifK_fd,4) + DO i3 = LBOUND(OutData%StifK_fd,3), UBOUND(OutData%StifK_fd,3) + DO i2 = LBOUND(OutData%StifK_fd,2), UBOUND(OutData%StifK_fd,2) + DO i1 = LBOUND(OutData%StifK_fd,1), UBOUND(OutData%StifK_fd,1) + OutData%StifK_fd(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MassM_fd not allocated Int_Xferred = Int_Xferred + 1 @@ -11649,15 +11904,16 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MassM_fd.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%MassM_fd)>0) OutData%MassM_fd = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%MassM_fd))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%MassM_fd) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%MassM_fd,4), UBOUND(OutData%MassM_fd,4) + DO i3 = LBOUND(OutData%MassM_fd,3), UBOUND(OutData%MassM_fd,3) + DO i2 = LBOUND(OutData%MassM_fd,2), UBOUND(OutData%MassM_fd,2) + DO i1 = LBOUND(OutData%MassM_fd,1), UBOUND(OutData%MassM_fd,1) + OutData%MassM_fd(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DampG_fd not allocated Int_Xferred = Int_Xferred + 1 @@ -11681,15 +11937,16 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DampG_fd.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%DampG_fd)>0) OutData%DampG_fd = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%DampG_fd))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%DampG_fd) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%DampG_fd,4), UBOUND(OutData%DampG_fd,4) + DO i3 = LBOUND(OutData%DampG_fd,3), UBOUND(OutData%DampG_fd,3) + DO i2 = LBOUND(OutData%DampG_fd,2), UBOUND(OutData%DampG_fd,2) + DO i1 = LBOUND(OutData%DampG_fd,1), UBOUND(OutData%DampG_fd,1) + OutData%DampG_fd(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RHS not allocated Int_Xferred = Int_Xferred + 1 @@ -11707,15 +11964,12 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RHS.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%RHS)>0) OutData%RHS = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%RHS))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%RHS) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%RHS,2), UBOUND(OutData%RHS,2) + DO i1 = LBOUND(OutData%RHS,1), UBOUND(OutData%RHS,1) + OutData%RHS(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RHS_p not allocated Int_Xferred = Int_Xferred + 1 @@ -11733,15 +11987,12 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RHS_p.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%RHS_p)>0) OutData%RHS_p = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%RHS_p))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%RHS_p) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%RHS_p,2), UBOUND(OutData%RHS_p,2) + DO i1 = LBOUND(OutData%RHS_p,1), UBOUND(OutData%RHS_p,1) + OutData%RHS_p(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RHS_m not allocated Int_Xferred = Int_Xferred + 1 @@ -11759,15 +12010,12 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RHS_m.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%RHS_m)>0) OutData%RHS_m = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%RHS_m))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%RHS_m) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%RHS_m,2), UBOUND(OutData%RHS_m,2) + DO i1 = LBOUND(OutData%RHS_m,1), UBOUND(OutData%RHS_m,1) + OutData%RHS_m(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldInternalForceFE not allocated Int_Xferred = Int_Xferred + 1 @@ -11785,15 +12033,12 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldInternalForceFE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%BldInternalForceFE)>0) OutData%BldInternalForceFE = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%BldInternalForceFE))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%BldInternalForceFE) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%BldInternalForceFE,2), UBOUND(OutData%BldInternalForceFE,2) + DO i1 = LBOUND(OutData%BldInternalForceFE,1), UBOUND(OutData%BldInternalForceFE,1) + OutData%BldInternalForceFE(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldInternalForceQP not allocated Int_Xferred = Int_Xferred + 1 @@ -11811,15 +12056,12 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldInternalForceQP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%BldInternalForceQP)>0) OutData%BldInternalForceQP = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%BldInternalForceQP))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%BldInternalForceQP) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%BldInternalForceQP,2), UBOUND(OutData%BldInternalForceQP,2) + DO i1 = LBOUND(OutData%BldInternalForceQP,1), UBOUND(OutData%BldInternalForceQP,1) + OutData%BldInternalForceQP(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FirstNodeReactionLclForceMoment not allocated Int_Xferred = Int_Xferred + 1 @@ -11834,15 +12076,10 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FirstNodeReactionLclForceMoment.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%FirstNodeReactionLclForceMoment)>0) OutData%FirstNodeReactionLclForceMoment = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%FirstNodeReactionLclForceMoment))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%FirstNodeReactionLclForceMoment) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FirstNodeReactionLclForceMoment,1), UBOUND(OutData%FirstNodeReactionLclForceMoment,1) + OutData%FirstNodeReactionLclForceMoment(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Solution not allocated Int_Xferred = Int_Xferred + 1 @@ -11860,15 +12097,12 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Solution.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Solution)>0) OutData%Solution = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Solution))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Solution) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Solution,2), UBOUND(OutData%Solution,2) + DO i1 = LBOUND(OutData%Solution,1), UBOUND(OutData%Solution,1) + OutData%Solution(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LP_StifK not allocated Int_Xferred = Int_Xferred + 1 @@ -11886,15 +12120,12 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LP_StifK.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%LP_StifK)>0) OutData%LP_StifK = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%LP_StifK))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%LP_StifK) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%LP_StifK,2), UBOUND(OutData%LP_StifK,2) + DO i1 = LBOUND(OutData%LP_StifK,1), UBOUND(OutData%LP_StifK,1) + OutData%LP_StifK(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LP_MassM not allocated Int_Xferred = Int_Xferred + 1 @@ -11912,15 +12143,12 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LP_MassM.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%LP_MassM)>0) OutData%LP_MassM = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%LP_MassM))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%LP_MassM) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%LP_MassM,2), UBOUND(OutData%LP_MassM,2) + DO i1 = LBOUND(OutData%LP_MassM,1), UBOUND(OutData%LP_MassM,1) + OutData%LP_MassM(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LP_MassM_LU not allocated Int_Xferred = Int_Xferred + 1 @@ -11938,15 +12166,12 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LP_MassM_LU.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%LP_MassM_LU)>0) OutData%LP_MassM_LU = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%LP_MassM_LU))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%LP_MassM_LU) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%LP_MassM_LU,2), UBOUND(OutData%LP_MassM_LU,2) + DO i1 = LBOUND(OutData%LP_MassM_LU,1), UBOUND(OutData%LP_MassM_LU,1) + OutData%LP_MassM_LU(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LP_RHS not allocated Int_Xferred = Int_Xferred + 1 @@ -11961,15 +12186,10 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LP_RHS.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LP_RHS)>0) OutData%LP_RHS = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%LP_RHS))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%LP_RHS) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LP_RHS,1), UBOUND(OutData%LP_RHS,1) + OutData%LP_RHS(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LP_StifK_LU not allocated Int_Xferred = Int_Xferred + 1 @@ -11987,15 +12207,12 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LP_StifK_LU.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%LP_StifK_LU)>0) OutData%LP_StifK_LU = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%LP_StifK_LU))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%LP_StifK_LU) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%LP_StifK_LU,2), UBOUND(OutData%LP_StifK_LU,2) + DO i1 = LBOUND(OutData%LP_StifK_LU,1), UBOUND(OutData%LP_StifK_LU,1) + OutData%LP_StifK_LU(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LP_RHS_LU not allocated Int_Xferred = Int_Xferred + 1 @@ -12010,15 +12227,10 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LP_RHS_LU.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LP_RHS_LU)>0) OutData%LP_RHS_LU = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%LP_RHS_LU))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%LP_RHS_LU) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LP_RHS_LU,1), UBOUND(OutData%LP_RHS_LU,1) + OutData%LP_RHS_LU(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LP_indx not allocated Int_Xferred = Int_Xferred + 1 @@ -12033,15 +12245,10 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LP_indx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LP_indx)>0) OutData%LP_indx = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%LP_indx))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%LP_indx) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LP_indx,1), UBOUND(OutData%LP_indx,1) + OutData%LP_indx(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -12200,8 +12407,8 @@ SUBROUTINE BD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'BD_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -12216,6 +12423,8 @@ SUBROUTINE BD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(u1%RootMotion, u2%RootMotion, tin, u_out%RootMotion, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL MeshExtrapInterp1(u1%PointLoad, u2%PointLoad, tin, u_out%PointLoad, tin_out, ErrStat2, ErrMsg2 ) @@ -12253,8 +12462,9 @@ SUBROUTINE BD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'BD_Input_ExtrapInterp2' @@ -12276,6 +12486,8 @@ SUBROUTINE BD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(u1%RootMotion, u2%RootMotion, u3%RootMotion, tin, u_out%RootMotion, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL MeshExtrapInterp2(u1%PointLoad, u2%PointLoad, u3%PointLoad, tin, u_out%PointLoad, tin_out, ErrStat2, ErrMsg2 ) @@ -12361,12 +12573,12 @@ SUBROUTINE BD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'BD_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! 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 :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -12379,21 +12591,21 @@ SUBROUTINE BD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(y1%ReactionForce, y2%ReactionForce, tin, y_out%ReactionForce, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL MeshExtrapInterp1(y1%BldMotion, y2%BldMotion, tin, y_out%BldMotion, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - b0 = -(y1%RootMxr - y2%RootMxr)/t(2) - y_out%RootMxr = y1%RootMxr + b0 * t_out - b0 = -(y1%RootMyr - y2%RootMyr)/t(2) - y_out%RootMyr = y1%RootMyr + b0 * t_out + b = -(y1%RootMxr - y2%RootMxr) + y_out%RootMxr = y1%RootMxr + b * ScaleFactor + b = -(y1%RootMyr - y2%RootMyr) + y_out%RootMyr = y1%RootMyr + b * ScaleFactor IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END IF ! check if allocated END SUBROUTINE BD_Output_ExtrapInterp1 @@ -12424,13 +12636,14 @@ SUBROUTINE BD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'BD_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -12449,24 +12662,24 @@ SUBROUTINE BD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(y1%ReactionForce, y2%ReactionForce, y3%ReactionForce, tin, y_out%ReactionForce, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL MeshExtrapInterp2(y1%BldMotion, y2%BldMotion, y3%BldMotion, tin, y_out%BldMotion, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - b0 = (t(3)**2*(y1%RootMxr - y2%RootMxr) + t(2)**2*(-y1%RootMxr + y3%RootMxr))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%RootMxr + t(3)*y2%RootMxr - t(2)*y3%RootMxr ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%RootMxr = y1%RootMxr + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%RootMyr - y2%RootMyr) + t(2)**2*(-y1%RootMyr + y3%RootMyr))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%RootMyr + t(3)*y2%RootMyr - t(2)*y3%RootMyr ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%RootMyr = y1%RootMyr + b0 * t_out + c0 * t_out**2 + b = (t(3)**2*(y1%RootMxr - y2%RootMxr) + t(2)**2*(-y1%RootMxr + y3%RootMxr))* scaleFactor + c = ( (t(2)-t(3))*y1%RootMxr + t(3)*y2%RootMxr - t(2)*y3%RootMxr ) * scaleFactor + y_out%RootMxr = y1%RootMxr + b + c * t_out + b = (t(3)**2*(y1%RootMyr - y2%RootMyr) + t(2)**2*(-y1%RootMyr + y3%RootMyr))* scaleFactor + c = ( (t(2)-t(3))*y1%RootMyr + t(3)*y2%RootMyr - t(2)*y3%RootMyr ) * scaleFactor + y_out%RootMyr = y1%RootMyr + b + c * t_out IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END IF ! check if allocated END SUBROUTINE BD_Output_ExtrapInterp2 diff --git a/modules/elastodyn/src/ElastoDyn_Types.f90 b/modules/elastodyn/src/ElastoDyn_Types.f90 index cba20f0d4a..8e0ae90bb4 100644 --- a/modules/elastodyn/src/ElastoDyn_Types.f90 +++ b/modules/elastodyn/src/ElastoDyn_Types.f90 @@ -965,22 +965,22 @@ SUBROUTINE ED_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Linearize , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%ADInputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%ADInputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%CompElast , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(InData%InputFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%Linearize, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%ADInputFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%ADInputFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%CompElast, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE ED_PackInitInput SUBROUTINE ED_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -996,12 +996,6 @@ SUBROUTINE ED_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -1020,22 +1014,22 @@ SUBROUTINE ED_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%Linearize = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%ADInputFile) - OutData%ADInputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%CompElast = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%InputFile) + OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%Linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%Linearize) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%ADInputFile) + OutData%ADInputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%CompElast = TRANSFER(IntKiBuf(Int_Xferred), OutData%CompElast) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE ED_UnPackInitInput SUBROUTINE ED_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -1438,12 +1432,12 @@ SUBROUTINE ED_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) + DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) DO I = 1, LEN(InData%WriteOutputHdr) IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdr(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1455,12 +1449,12 @@ SUBROUTINE ED_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) + DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) DO I = 1, LEN(InData%WriteOutputUnt) IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUnt(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1490,10 +1484,10 @@ SUBROUTINE ED_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumBl - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Gravity - Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumBl + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Gravity + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%BlPitch) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1504,17 +1498,19 @@ SUBROUTINE ED_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlPitch,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BlPitch)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlPitch))-1 ) = PACK(InData%BlPitch,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlPitch) + DO i1 = LBOUND(InData%BlPitch,1), UBOUND(InData%BlPitch,1) + ReKiBuf(Re_Xferred) = InData%BlPitch(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%BladeLength - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TowerHeight - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TowerBaseHeight - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HubHt - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%BladeLength + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TowerHeight + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TowerBaseHeight + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HubHt + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%BldRNodes) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1525,8 +1521,10 @@ SUBROUTINE ED_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldRNodes,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BldRNodes)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BldRNodes))-1 ) = PACK(InData%BldRNodes,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BldRNodes) + DO i1 = LBOUND(InData%BldRNodes,1), UBOUND(InData%BldRNodes,1) + ReKiBuf(Re_Xferred) = InData%BldRNodes(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TwrHNodes) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1538,15 +1536,21 @@ SUBROUTINE ED_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrHNodes,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwrHNodes)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwrHNodes))-1 ) = PACK(InData%TwrHNodes,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwrHNodes) + DO i1 = LBOUND(InData%TwrHNodes,1), UBOUND(InData%TwrHNodes,1) + ReKiBuf(Re_Xferred) = InData%TwrHNodes(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PlatformPos))-1 ) = PACK(InData%PlatformPos,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PlatformPos) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwrBasePos))-1 ) = PACK(InData%TwrBasePos,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwrBasePos) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HubRad - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%PlatformPos,1), UBOUND(InData%PlatformPos,1) + ReKiBuf(Re_Xferred) = InData%PlatformPos(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%TwrBasePos,1), UBOUND(InData%TwrBasePos,1) + ReKiBuf(Re_Xferred) = InData%TwrBasePos(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%HubRad + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%LinNames_y) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1557,12 +1561,12 @@ SUBROUTINE ED_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_y,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%LinNames_y,1), UBOUND(InData%LinNames_y,1) + DO i1 = LBOUND(InData%LinNames_y,1), UBOUND(InData%LinNames_y,1) DO I = 1, LEN(InData%LinNames_y) IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_y(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LinNames_x) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1574,12 +1578,12 @@ SUBROUTINE ED_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_x,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%LinNames_x,1), UBOUND(InData%LinNames_x,1) + DO i1 = LBOUND(InData%LinNames_x,1), UBOUND(InData%LinNames_x,1) DO I = 1, LEN(InData%LinNames_x) IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_x(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LinNames_u) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1591,12 +1595,12 @@ SUBROUTINE ED_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_u,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%LinNames_u,1), UBOUND(InData%LinNames_u,1) + DO i1 = LBOUND(InData%LinNames_u,1), UBOUND(InData%LinNames_u,1) DO I = 1, LEN(InData%LinNames_u) IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_u(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%RotFrame_y) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1608,8 +1612,10 @@ SUBROUTINE ED_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_y,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RotFrame_y)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%RotFrame_y)-1 ) = TRANSFER(PACK( InData%RotFrame_y ,.TRUE.), IntKiBuf(1), SIZE(InData%RotFrame_y)) - Int_Xferred = Int_Xferred + SIZE(InData%RotFrame_y) + DO i1 = LBOUND(InData%RotFrame_y,1), UBOUND(InData%RotFrame_y,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_y(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%RotFrame_x) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1621,8 +1627,10 @@ SUBROUTINE ED_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_x,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RotFrame_x)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%RotFrame_x)-1 ) = TRANSFER(PACK( InData%RotFrame_x ,.TRUE.), IntKiBuf(1), SIZE(InData%RotFrame_x)) - Int_Xferred = Int_Xferred + SIZE(InData%RotFrame_x) + DO i1 = LBOUND(InData%RotFrame_x,1), UBOUND(InData%RotFrame_x,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_x(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%DerivOrder_x) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1634,8 +1642,10 @@ SUBROUTINE ED_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DerivOrder_x,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DerivOrder_x)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%DerivOrder_x))-1 ) = PACK(InData%DerivOrder_x,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%DerivOrder_x) + DO i1 = LBOUND(InData%DerivOrder_x,1), UBOUND(InData%DerivOrder_x,1) + IntKiBuf(Int_Xferred) = InData%DerivOrder_x(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%RotFrame_u) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1647,8 +1657,10 @@ SUBROUTINE ED_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_u,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RotFrame_u)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%RotFrame_u)-1 ) = TRANSFER(PACK( InData%RotFrame_u ,.TRUE.), IntKiBuf(1), SIZE(InData%RotFrame_u)) - Int_Xferred = Int_Xferred + SIZE(InData%RotFrame_u) + DO i1 = LBOUND(InData%RotFrame_u,1), UBOUND(InData%RotFrame_u,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_u(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%IsLoad_u) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1660,8 +1672,10 @@ SUBROUTINE ED_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IsLoad_u,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%IsLoad_u)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%IsLoad_u)-1 ) = TRANSFER(PACK( InData%IsLoad_u ,.TRUE.), IntKiBuf(1), SIZE(InData%IsLoad_u)) - Int_Xferred = Int_Xferred + SIZE(InData%IsLoad_u) + DO i1 = LBOUND(InData%IsLoad_u,1), UBOUND(InData%IsLoad_u,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%IsLoad_u(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF END SUBROUTINE ED_PackInitOutput @@ -1678,12 +1692,6 @@ SUBROUTINE ED_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1711,19 +1719,12 @@ SUBROUTINE ED_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) DO I = 1, LEN(OutData%WriteOutputHdr) OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated Int_Xferred = Int_Xferred + 1 @@ -1738,19 +1739,12 @@ SUBROUTINE ED_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) DO I = 1, LEN(OutData%WriteOutputUnt) OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -1792,10 +1786,10 @@ SUBROUTINE ED_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%NumBl = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%Gravity = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%NumBl = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Gravity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlPitch not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1809,24 +1803,19 @@ SUBROUTINE ED_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitch.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BlPitch)>0) OutData%BlPitch = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlPitch))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlPitch) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BlPitch,1), UBOUND(OutData%BlPitch,1) + OutData%BlPitch(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%BladeLength = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TowerHeight = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TowerBaseHeight = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HubHt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%BladeLength = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TowerHeight = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TowerBaseHeight = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HubHt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldRNodes not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1840,15 +1829,10 @@ SUBROUTINE ED_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldRNodes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BldRNodes)>0) OutData%BldRNodes = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BldRNodes))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BldRNodes) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BldRNodes,1), UBOUND(OutData%BldRNodes,1) + OutData%BldRNodes(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrHNodes not allocated Int_Xferred = Int_Xferred + 1 @@ -1863,40 +1847,25 @@ SUBROUTINE ED_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrHNodes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwrHNodes)>0) OutData%TwrHNodes = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwrHNodes))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwrHNodes) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwrHNodes,1), UBOUND(OutData%TwrHNodes,1) + OutData%TwrHNodes(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF i1_l = LBOUND(OutData%PlatformPos,1) i1_u = UBOUND(OutData%PlatformPos,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%PlatformPos = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PlatformPos))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PlatformPos) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%PlatformPos,1), UBOUND(OutData%PlatformPos,1) + OutData%PlatformPos(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%TwrBasePos,1) i1_u = UBOUND(OutData%TwrBasePos,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%TwrBasePos = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwrBasePos))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwrBasePos) - DEALLOCATE(mask1) - OutData%HubRad = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%TwrBasePos,1), UBOUND(OutData%TwrBasePos,1) + OutData%TwrBasePos(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%HubRad = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_y not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1910,19 +1879,12 @@ SUBROUTINE ED_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%LinNames_y,1), UBOUND(OutData%LinNames_y,1) + DO i1 = LBOUND(OutData%LinNames_y,1), UBOUND(OutData%LinNames_y,1) DO I = 1, LEN(OutData%LinNames_y) OutData%LinNames_y(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_x not allocated Int_Xferred = Int_Xferred + 1 @@ -1937,19 +1899,12 @@ SUBROUTINE ED_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_x.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%LinNames_x,1), UBOUND(OutData%LinNames_x,1) + DO i1 = LBOUND(OutData%LinNames_x,1), UBOUND(OutData%LinNames_x,1) DO I = 1, LEN(OutData%LinNames_x) OutData%LinNames_x(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_u not allocated Int_Xferred = Int_Xferred + 1 @@ -1964,19 +1919,12 @@ SUBROUTINE ED_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%LinNames_u,1), UBOUND(OutData%LinNames_u,1) + DO i1 = LBOUND(OutData%LinNames_u,1), UBOUND(OutData%LinNames_u,1) DO I = 1, LEN(OutData%LinNames_u) OutData%LinNames_u(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_y not allocated Int_Xferred = Int_Xferred + 1 @@ -1991,15 +1939,10 @@ SUBROUTINE ED_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RotFrame_y)>0) OutData%RotFrame_y = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%RotFrame_y))-1 ), OutData%RotFrame_y), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%RotFrame_y) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%RotFrame_y,1), UBOUND(OutData%RotFrame_y,1) + OutData%RotFrame_y(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_y(i1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_x not allocated Int_Xferred = Int_Xferred + 1 @@ -2014,15 +1957,10 @@ SUBROUTINE ED_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_x.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RotFrame_x)>0) OutData%RotFrame_x = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%RotFrame_x))-1 ), OutData%RotFrame_x), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%RotFrame_x) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%RotFrame_x,1), UBOUND(OutData%RotFrame_x,1) + OutData%RotFrame_x(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_x(i1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DerivOrder_x not allocated Int_Xferred = Int_Xferred + 1 @@ -2037,15 +1975,10 @@ SUBROUTINE ED_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%DerivOrder_x)>0) OutData%DerivOrder_x = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%DerivOrder_x))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%DerivOrder_x) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%DerivOrder_x,1), UBOUND(OutData%DerivOrder_x,1) + OutData%DerivOrder_x(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_u not allocated Int_Xferred = Int_Xferred + 1 @@ -2060,15 +1993,10 @@ SUBROUTINE ED_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RotFrame_u)>0) OutData%RotFrame_u = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%RotFrame_u))-1 ), OutData%RotFrame_u), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%RotFrame_u) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%RotFrame_u,1), UBOUND(OutData%RotFrame_u,1) + OutData%RotFrame_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_u(i1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IsLoad_u not allocated Int_Xferred = Int_Xferred + 1 @@ -2083,15 +2011,10 @@ SUBROUTINE ED_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%IsLoad_u)>0) OutData%IsLoad_u = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%IsLoad_u))-1 ), OutData%IsLoad_u), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%IsLoad_u) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%IsLoad_u,1), UBOUND(OutData%IsLoad_u,1) + OutData%IsLoad_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsLoad_u(i1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF END SUBROUTINE ED_UnPackInitOutput @@ -2593,8 +2516,8 @@ SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NBlInpSt - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NBlInpSt + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%BlFract) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2605,8 +2528,10 @@ SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlFract,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BlFract)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlFract))-1 ) = PACK(InData%BlFract,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlFract) + DO i1 = LBOUND(InData%BlFract,1), UBOUND(InData%BlFract,1) + ReKiBuf(Re_Xferred) = InData%BlFract(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%PitchAx) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2618,8 +2543,10 @@ SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PitchAx,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PitchAx)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PitchAx))-1 ) = PACK(InData%PitchAx,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PitchAx) + DO i1 = LBOUND(InData%PitchAx,1), UBOUND(InData%PitchAx,1) + ReKiBuf(Re_Xferred) = InData%PitchAx(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%StrcTwst) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2631,8 +2558,10 @@ SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StrcTwst,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%StrcTwst)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%StrcTwst))-1 ) = PACK(InData%StrcTwst,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%StrcTwst) + DO i1 = LBOUND(InData%StrcTwst,1), UBOUND(InData%StrcTwst,1) + ReKiBuf(Re_Xferred) = InData%StrcTwst(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%BMassDen) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2644,8 +2573,10 @@ SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BMassDen,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BMassDen)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BMassDen))-1 ) = PACK(InData%BMassDen,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BMassDen) + DO i1 = LBOUND(InData%BMassDen,1), UBOUND(InData%BMassDen,1) + ReKiBuf(Re_Xferred) = InData%BMassDen(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%FlpStff) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2657,8 +2588,10 @@ SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FlpStff,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FlpStff)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FlpStff))-1 ) = PACK(InData%FlpStff,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FlpStff) + DO i1 = LBOUND(InData%FlpStff,1), UBOUND(InData%FlpStff,1) + ReKiBuf(Re_Xferred) = InData%FlpStff(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%EdgStff) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2670,8 +2603,10 @@ SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EdgStff,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%EdgStff)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%EdgStff))-1 ) = PACK(InData%EdgStff,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%EdgStff) + DO i1 = LBOUND(InData%EdgStff,1), UBOUND(InData%EdgStff,1) + ReKiBuf(Re_Xferred) = InData%EdgStff(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%GJStff) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2683,8 +2618,10 @@ SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GJStff,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%GJStff)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GJStff))-1 ) = PACK(InData%GJStff,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GJStff) + DO i1 = LBOUND(InData%GJStff,1), UBOUND(InData%GJStff,1) + ReKiBuf(Re_Xferred) = InData%GJStff(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%EAStff) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2696,8 +2633,10 @@ SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EAStff,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%EAStff)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%EAStff))-1 ) = PACK(InData%EAStff,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%EAStff) + DO i1 = LBOUND(InData%EAStff,1), UBOUND(InData%EAStff,1) + ReKiBuf(Re_Xferred) = InData%EAStff(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%Alpha) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2709,8 +2648,10 @@ SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Alpha,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Alpha)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Alpha))-1 ) = PACK(InData%Alpha,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Alpha) + DO i1 = LBOUND(InData%Alpha,1), UBOUND(InData%Alpha,1) + ReKiBuf(Re_Xferred) = InData%Alpha(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%FlpIner) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2722,8 +2663,10 @@ SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FlpIner,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FlpIner)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FlpIner))-1 ) = PACK(InData%FlpIner,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FlpIner) + DO i1 = LBOUND(InData%FlpIner,1), UBOUND(InData%FlpIner,1) + ReKiBuf(Re_Xferred) = InData%FlpIner(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%EdgIner) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2735,8 +2678,10 @@ SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EdgIner,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%EdgIner)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%EdgIner))-1 ) = PACK(InData%EdgIner,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%EdgIner) + DO i1 = LBOUND(InData%EdgIner,1), UBOUND(InData%EdgIner,1) + ReKiBuf(Re_Xferred) = InData%EdgIner(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%PrecrvRef) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2748,8 +2693,10 @@ SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PrecrvRef,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PrecrvRef)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PrecrvRef))-1 ) = PACK(InData%PrecrvRef,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PrecrvRef) + DO i1 = LBOUND(InData%PrecrvRef,1), UBOUND(InData%PrecrvRef,1) + ReKiBuf(Re_Xferred) = InData%PrecrvRef(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%PreswpRef) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2761,8 +2708,10 @@ SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PreswpRef,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PreswpRef)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PreswpRef))-1 ) = PACK(InData%PreswpRef,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PreswpRef) + DO i1 = LBOUND(InData%PreswpRef,1), UBOUND(InData%PreswpRef,1) + ReKiBuf(Re_Xferred) = InData%PreswpRef(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%FlpcgOf) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2774,8 +2723,10 @@ SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FlpcgOf,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FlpcgOf)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FlpcgOf))-1 ) = PACK(InData%FlpcgOf,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FlpcgOf) + DO i1 = LBOUND(InData%FlpcgOf,1), UBOUND(InData%FlpcgOf,1) + ReKiBuf(Re_Xferred) = InData%FlpcgOf(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%EdgcgOf) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2787,8 +2738,10 @@ SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EdgcgOf,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%EdgcgOf)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%EdgcgOf))-1 ) = PACK(InData%EdgcgOf,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%EdgcgOf) + DO i1 = LBOUND(InData%EdgcgOf,1), UBOUND(InData%EdgcgOf,1) + ReKiBuf(Re_Xferred) = InData%EdgcgOf(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%FlpEAOf) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2800,8 +2753,10 @@ SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FlpEAOf,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FlpEAOf)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FlpEAOf))-1 ) = PACK(InData%FlpEAOf,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FlpEAOf) + DO i1 = LBOUND(InData%FlpEAOf,1), UBOUND(InData%FlpEAOf,1) + ReKiBuf(Re_Xferred) = InData%FlpEAOf(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%EdgEAOf) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2813,15 +2768,23 @@ SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EdgEAOf,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%EdgEAOf)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%EdgEAOf))-1 ) = PACK(InData%EdgEAOf,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%EdgEAOf) + DO i1 = LBOUND(InData%EdgEAOf,1), UBOUND(InData%EdgEAOf,1) + ReKiBuf(Re_Xferred) = InData%EdgEAOf(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BldFlDmp))-1 ) = PACK(InData%BldFlDmp,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BldFlDmp) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BldEdDmp))-1 ) = PACK(InData%BldEdDmp,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BldEdDmp) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FlStTunr))-1 ) = PACK(InData%FlStTunr,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FlStTunr) + DO i1 = LBOUND(InData%BldFlDmp,1), UBOUND(InData%BldFlDmp,1) + ReKiBuf(Re_Xferred) = InData%BldFlDmp(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%BldEdDmp,1), UBOUND(InData%BldEdDmp,1) + ReKiBuf(Re_Xferred) = InData%BldEdDmp(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%FlStTunr,1), UBOUND(InData%FlStTunr,1) + ReKiBuf(Re_Xferred) = InData%FlStTunr(i1) + Re_Xferred = Re_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%BldFl1Sh) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2832,8 +2795,10 @@ SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldFl1Sh,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BldFl1Sh)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BldFl1Sh))-1 ) = PACK(InData%BldFl1Sh,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BldFl1Sh) + DO i1 = LBOUND(InData%BldFl1Sh,1), UBOUND(InData%BldFl1Sh,1) + ReKiBuf(Re_Xferred) = InData%BldFl1Sh(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%BldFl2Sh) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2845,8 +2810,10 @@ SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldFl2Sh,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BldFl2Sh)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BldFl2Sh))-1 ) = PACK(InData%BldFl2Sh,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BldFl2Sh) + DO i1 = LBOUND(InData%BldFl2Sh,1), UBOUND(InData%BldFl2Sh,1) + ReKiBuf(Re_Xferred) = InData%BldFl2Sh(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%BldEdgSh) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2858,8 +2825,10 @@ SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldEdgSh,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BldEdgSh)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BldEdgSh))-1 ) = PACK(InData%BldEdgSh,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BldEdgSh) + DO i1 = LBOUND(InData%BldEdgSh,1), UBOUND(InData%BldEdgSh,1) + ReKiBuf(Re_Xferred) = InData%BldEdgSh(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE ED_PackBladeInputData @@ -2876,12 +2845,6 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -2896,8 +2859,8 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%NBlInpSt = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NBlInpSt = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlFract not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2911,15 +2874,10 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlFract.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BlFract)>0) OutData%BlFract = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlFract))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlFract) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BlFract,1), UBOUND(OutData%BlFract,1) + OutData%BlFract(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PitchAx not allocated Int_Xferred = Int_Xferred + 1 @@ -2934,15 +2892,10 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PitchAx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%PitchAx)>0) OutData%PitchAx = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PitchAx))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PitchAx) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%PitchAx,1), UBOUND(OutData%PitchAx,1) + OutData%PitchAx(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StrcTwst not allocated Int_Xferred = Int_Xferred + 1 @@ -2957,15 +2910,10 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StrcTwst.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%StrcTwst)>0) OutData%StrcTwst = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%StrcTwst))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%StrcTwst) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%StrcTwst,1), UBOUND(OutData%StrcTwst,1) + OutData%StrcTwst(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BMassDen not allocated Int_Xferred = Int_Xferred + 1 @@ -2980,15 +2928,10 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BMassDen.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BMassDen)>0) OutData%BMassDen = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BMassDen))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BMassDen) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BMassDen,1), UBOUND(OutData%BMassDen,1) + OutData%BMassDen(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FlpStff not allocated Int_Xferred = Int_Xferred + 1 @@ -3003,15 +2946,10 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FlpStff.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%FlpStff)>0) OutData%FlpStff = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FlpStff))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FlpStff) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FlpStff,1), UBOUND(OutData%FlpStff,1) + OutData%FlpStff(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! EdgStff not allocated Int_Xferred = Int_Xferred + 1 @@ -3026,15 +2964,10 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%EdgStff.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%EdgStff)>0) OutData%EdgStff = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%EdgStff))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%EdgStff) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%EdgStff,1), UBOUND(OutData%EdgStff,1) + OutData%EdgStff(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GJStff not allocated Int_Xferred = Int_Xferred + 1 @@ -3049,15 +2982,10 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GJStff.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%GJStff)>0) OutData%GJStff = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GJStff))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GJStff) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%GJStff,1), UBOUND(OutData%GJStff,1) + OutData%GJStff(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! EAStff not allocated Int_Xferred = Int_Xferred + 1 @@ -3072,15 +3000,10 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%EAStff.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%EAStff)>0) OutData%EAStff = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%EAStff))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%EAStff) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%EAStff,1), UBOUND(OutData%EAStff,1) + OutData%EAStff(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Alpha not allocated Int_Xferred = Int_Xferred + 1 @@ -3095,15 +3018,10 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Alpha.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Alpha)>0) OutData%Alpha = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Alpha))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Alpha) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Alpha,1), UBOUND(OutData%Alpha,1) + OutData%Alpha(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FlpIner not allocated Int_Xferred = Int_Xferred + 1 @@ -3118,15 +3036,10 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FlpIner.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%FlpIner)>0) OutData%FlpIner = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FlpIner))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FlpIner) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FlpIner,1), UBOUND(OutData%FlpIner,1) + OutData%FlpIner(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! EdgIner not allocated Int_Xferred = Int_Xferred + 1 @@ -3141,15 +3054,10 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%EdgIner.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%EdgIner)>0) OutData%EdgIner = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%EdgIner))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%EdgIner) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%EdgIner,1), UBOUND(OutData%EdgIner,1) + OutData%EdgIner(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PrecrvRef not allocated Int_Xferred = Int_Xferred + 1 @@ -3164,15 +3072,10 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PrecrvRef.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%PrecrvRef)>0) OutData%PrecrvRef = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PrecrvRef))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PrecrvRef) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%PrecrvRef,1), UBOUND(OutData%PrecrvRef,1) + OutData%PrecrvRef(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PreswpRef not allocated Int_Xferred = Int_Xferred + 1 @@ -3187,15 +3090,10 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PreswpRef.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%PreswpRef)>0) OutData%PreswpRef = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PreswpRef))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PreswpRef) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%PreswpRef,1), UBOUND(OutData%PreswpRef,1) + OutData%PreswpRef(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FlpcgOf not allocated Int_Xferred = Int_Xferred + 1 @@ -3210,15 +3108,10 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FlpcgOf.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%FlpcgOf)>0) OutData%FlpcgOf = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FlpcgOf))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FlpcgOf) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FlpcgOf,1), UBOUND(OutData%FlpcgOf,1) + OutData%FlpcgOf(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! EdgcgOf not allocated Int_Xferred = Int_Xferred + 1 @@ -3233,15 +3126,10 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%EdgcgOf.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%EdgcgOf)>0) OutData%EdgcgOf = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%EdgcgOf))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%EdgcgOf) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%EdgcgOf,1), UBOUND(OutData%EdgcgOf,1) + OutData%EdgcgOf(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FlpEAOf not allocated Int_Xferred = Int_Xferred + 1 @@ -3256,15 +3144,10 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FlpEAOf.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%FlpEAOf)>0) OutData%FlpEAOf = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FlpEAOf))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FlpEAOf) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FlpEAOf,1), UBOUND(OutData%FlpEAOf,1) + OutData%FlpEAOf(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! EdgEAOf not allocated Int_Xferred = Int_Xferred + 1 @@ -3279,49 +3162,29 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%EdgEAOf.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%EdgEAOf)>0) OutData%EdgEAOf = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%EdgEAOf))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%EdgEAOf) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%EdgEAOf,1), UBOUND(OutData%EdgEAOf,1) + OutData%EdgEAOf(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF i1_l = LBOUND(OutData%BldFlDmp,1) i1_u = UBOUND(OutData%BldFlDmp,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%BldFlDmp = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BldFlDmp))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BldFlDmp) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BldFlDmp,1), UBOUND(OutData%BldFlDmp,1) + OutData%BldFlDmp(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%BldEdDmp,1) i1_u = UBOUND(OutData%BldEdDmp,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%BldEdDmp = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BldEdDmp))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BldEdDmp) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BldEdDmp,1), UBOUND(OutData%BldEdDmp,1) + OutData%BldEdDmp(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%FlStTunr,1) i1_u = UBOUND(OutData%FlStTunr,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%FlStTunr = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FlStTunr))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FlStTunr) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FlStTunr,1), UBOUND(OutData%FlStTunr,1) + OutData%FlStTunr(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldFl1Sh not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3335,15 +3198,10 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldFl1Sh.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BldFl1Sh)>0) OutData%BldFl1Sh = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BldFl1Sh))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BldFl1Sh) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BldFl1Sh,1), UBOUND(OutData%BldFl1Sh,1) + OutData%BldFl1Sh(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldFl2Sh not allocated Int_Xferred = Int_Xferred + 1 @@ -3358,15 +3216,10 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldFl2Sh.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BldFl2Sh)>0) OutData%BldFl2Sh = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BldFl2Sh))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BldFl2Sh) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BldFl2Sh,1), UBOUND(OutData%BldFl2Sh,1) + OutData%BldFl2Sh(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldEdgSh not allocated Int_Xferred = Int_Xferred + 1 @@ -3381,15 +3234,10 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldEdgSh.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BldEdgSh)>0) OutData%BldEdgSh = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BldEdgSh))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BldEdgSh) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BldEdgSh,1), UBOUND(OutData%BldEdgSh,1) + OutData%BldEdgSh(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE ED_UnPackBladeInputData @@ -3545,8 +3393,8 @@ SUBROUTINE ED_PackBladeMeshInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%BldNodes - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%BldNodes + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%RNodes) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -3557,8 +3405,10 @@ SUBROUTINE ED_PackBladeMeshInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RNodes,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RNodes)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RNodes))-1 ) = PACK(InData%RNodes,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RNodes) + DO i1 = LBOUND(InData%RNodes,1), UBOUND(InData%RNodes,1) + ReKiBuf(Re_Xferred) = InData%RNodes(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%AeroTwst) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3570,8 +3420,10 @@ SUBROUTINE ED_PackBladeMeshInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AeroTwst,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AeroTwst)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AeroTwst))-1 ) = PACK(InData%AeroTwst,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AeroTwst) + DO i1 = LBOUND(InData%AeroTwst,1), UBOUND(InData%AeroTwst,1) + ReKiBuf(Re_Xferred) = InData%AeroTwst(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%Chord) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3583,8 +3435,10 @@ SUBROUTINE ED_PackBladeMeshInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Chord,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Chord)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Chord))-1 ) = PACK(InData%Chord,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Chord) + DO i1 = LBOUND(InData%Chord,1), UBOUND(InData%Chord,1) + ReKiBuf(Re_Xferred) = InData%Chord(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE ED_PackBladeMeshInputData @@ -3601,12 +3455,6 @@ SUBROUTINE ED_UnPackBladeMeshInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -3621,8 +3469,8 @@ SUBROUTINE ED_UnPackBladeMeshInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%BldNodes = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%BldNodes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RNodes not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3636,15 +3484,10 @@ SUBROUTINE ED_UnPackBladeMeshInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RNodes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RNodes)>0) OutData%RNodes = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RNodes))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RNodes) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%RNodes,1), UBOUND(OutData%RNodes,1) + OutData%RNodes(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AeroTwst not allocated Int_Xferred = Int_Xferred + 1 @@ -3659,15 +3502,10 @@ SUBROUTINE ED_UnPackBladeMeshInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AeroTwst.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%AeroTwst)>0) OutData%AeroTwst = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AeroTwst))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AeroTwst) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AeroTwst,1), UBOUND(OutData%AeroTwst,1) + OutData%AeroTwst(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Chord not allocated Int_Xferred = Int_Xferred + 1 @@ -3682,15 +3520,10 @@ SUBROUTINE ED_UnPackBladeMeshInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Chord.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Chord)>0) OutData%Chord = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Chord))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Chord) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Chord,1), UBOUND(OutData%Chord,1) + OutData%Chord(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE ED_UnPackBladeMeshInputData @@ -4551,48 +4384,48 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%FlapDOF1 , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%FlapDOF2 , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%EdgeDOF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TeetDOF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%DrTrDOF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%GenDOF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%YawDOF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TwFADOF1 , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TwFADOF2 , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TwSSDOF1 , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TwSSDOF2 , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmSgDOF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmSwDOF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmHvDOF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmRDOF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmPDOF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmYDOF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%OoPDefl - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%IPDefl - Re_Xferred = Re_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Gravity + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%FlapDOF1, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%FlapDOF2, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%EdgeDOF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TeetDOF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%DrTrDOF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%GenDOF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%YawDOF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TwFADOF1, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TwFADOF2, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TwSSDOF1, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TwSSDOF2, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmSgDOF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmSwDOF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmHvDOF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmRDOF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmPDOF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmYDOF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%OoPDefl + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%IPDefl + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%BlPitch) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4603,39 +4436,41 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlPitch,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BlPitch)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlPitch))-1 ) = PACK(InData%BlPitch,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlPitch) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TeetDefl - Re_Xferred = Re_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%Azimuth - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RotSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NacYaw - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TTDspFA - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TTDspSS - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmSurge - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmSway - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmHeave - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmRoll - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmPitch - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmYaw - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumBl - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TipRad - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HubRad - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%BlPitch,1), UBOUND(InData%BlPitch,1) + ReKiBuf(Re_Xferred) = InData%BlPitch(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%TeetDefl + Re_Xferred = Re_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%Azimuth + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RotSpeed + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NacYaw + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TTDspFA + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TTDspSS + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmSurge + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmSway + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmHeave + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmRoll + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmPitch + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmYaw + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumBl + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TipRad + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HubRad + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%PreCone) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4646,49 +4481,51 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PreCone,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PreCone)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PreCone))-1 ) = PACK(InData%PreCone,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PreCone) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HubCM - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%UndSling - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Delta3 - Re_Xferred = Re_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%AzimB1Up - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%OverHang - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ShftGagL - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ShftTilt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NacCMxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NacCMyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NacCMzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NcIMUxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NcIMUyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NcIMUzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Twr2Shft - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TowerHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TowerBsHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmCMxt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmCMyt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmCMzt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmRefzt - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%PreCone,1), UBOUND(InData%PreCone,1) + ReKiBuf(Re_Xferred) = InData%PreCone(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%HubCM + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%UndSling + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Delta3 + Re_Xferred = Re_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%AzimB1Up + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%OverHang + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ShftGagL + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ShftTilt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NacCMxn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NacCMyn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NacCMzn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NcIMUxn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NcIMUyn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NcIMUzn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Twr2Shft + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TowerHt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TowerBsHt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmCMxt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmCMyt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmCMzt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmRefzt + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%TipMass) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4699,31 +4536,33 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TipMass,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TipMass)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TipMass))-1 ) = PACK(InData%TipMass,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TipMass) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HubMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HubIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GenIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NacMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NacYIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawBrMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmRIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmPIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmYIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%BldNodes - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%TipMass,1), UBOUND(InData%TipMass,1) + ReKiBuf(Re_Xferred) = InData%TipMass(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%HubMass + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HubIner + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GenIner + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NacMass + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NacYIner + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawBrMass + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmMass + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmRIner + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmPIner + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmYIner + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%BldNodes + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%InpBlMesh) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4806,58 +4645,62 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TeetMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TeetDmpP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TeetDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TeetCDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TeetSStP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TeetHStP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TeetSSSp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TeetHSSp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GBoxEff - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GBRatio - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DTTorSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DTTorDmp - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Furling , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TwrNodes - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%SumPrint , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%OutFile - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TabDelim , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%Tstart - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DecFact - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NTwGages - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%TwrGagNd))-1 ) = PACK(InData%TwrGagNd,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%TwrGagNd) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NBlGages - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%BldGagNd))-1 ) = PACK(InData%BldGagNd,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%BldGagNd) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TeetMod + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TeetDmpP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TeetDmp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TeetCDmp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TeetSStP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TeetHStP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TeetSSSp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TeetHSSp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GBoxEff + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GBRatio + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DTTorSpr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DTTorDmp + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%Furling, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TwrNodes + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%SumPrint, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%OutFile + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TabDelim, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%OutFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DbKiBuf(Db_Xferred) = InData%Tstart + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DecFact + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NTwGages + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%TwrGagNd,1), UBOUND(InData%TwrGagNd,1) + IntKiBuf(Int_Xferred) = InData%TwrGagNd(i1) + Int_Xferred = Int_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%NBlGages + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%BldGagNd,1), UBOUND(InData%BldGagNd,1) + IntKiBuf(Int_Xferred) = InData%BldGagNd(i1) + Int_Xferred = Int_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%OutList) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4868,23 +4711,31 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutList,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) + DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) DO I = 1, LEN(InData%OutList) IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NTwInpSt - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwrFADmp))-1 ) = PACK(InData%TwrFADmp,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwrFADmp) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwrSSDmp))-1 ) = PACK(InData%TwrSSDmp,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwrSSDmp) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FAStTunr))-1 ) = PACK(InData%FAStTunr,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FAStTunr) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SSStTunr))-1 ) = PACK(InData%SSStTunr,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SSStTunr) + END DO + END IF + IntKiBuf(Int_Xferred) = InData%NTwInpSt + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%TwrFADmp,1), UBOUND(InData%TwrFADmp,1) + ReKiBuf(Re_Xferred) = InData%TwrFADmp(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%TwrSSDmp,1), UBOUND(InData%TwrSSDmp,1) + ReKiBuf(Re_Xferred) = InData%TwrSSDmp(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%FAStTunr,1), UBOUND(InData%FAStTunr,1) + ReKiBuf(Re_Xferred) = InData%FAStTunr(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%SSStTunr,1), UBOUND(InData%SSStTunr,1) + ReKiBuf(Re_Xferred) = InData%SSStTunr(i1) + Re_Xferred = Re_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%HtFract) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4895,8 +4746,10 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HtFract,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%HtFract)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%HtFract))-1 ) = PACK(InData%HtFract,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%HtFract) + DO i1 = LBOUND(InData%HtFract,1), UBOUND(InData%HtFract,1) + ReKiBuf(Re_Xferred) = InData%HtFract(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TMassDen) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4908,8 +4761,10 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TMassDen,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TMassDen)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TMassDen))-1 ) = PACK(InData%TMassDen,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TMassDen) + DO i1 = LBOUND(InData%TMassDen,1), UBOUND(InData%TMassDen,1) + ReKiBuf(Re_Xferred) = InData%TMassDen(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TwFAStif) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4921,8 +4776,10 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwFAStif,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwFAStif)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwFAStif))-1 ) = PACK(InData%TwFAStif,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwFAStif) + DO i1 = LBOUND(InData%TwFAStif,1), UBOUND(InData%TwFAStif,1) + ReKiBuf(Re_Xferred) = InData%TwFAStif(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TwSSStif) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4934,8 +4791,10 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwSSStif,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwSSStif)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwSSStif))-1 ) = PACK(InData%TwSSStif,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwSSStif) + DO i1 = LBOUND(InData%TwSSStif,1), UBOUND(InData%TwSSStif,1) + ReKiBuf(Re_Xferred) = InData%TwSSStif(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TwFAM1Sh) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4947,8 +4806,10 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwFAM1Sh,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwFAM1Sh)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwFAM1Sh))-1 ) = PACK(InData%TwFAM1Sh,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwFAM1Sh) + DO i1 = LBOUND(InData%TwFAM1Sh,1), UBOUND(InData%TwFAM1Sh,1) + ReKiBuf(Re_Xferred) = InData%TwFAM1Sh(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TwFAM2Sh) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4960,8 +4821,10 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwFAM2Sh,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwFAM2Sh)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwFAM2Sh))-1 ) = PACK(InData%TwFAM2Sh,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwFAM2Sh) + DO i1 = LBOUND(InData%TwFAM2Sh,1), UBOUND(InData%TwFAM2Sh,1) + ReKiBuf(Re_Xferred) = InData%TwFAM2Sh(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TwSSM1Sh) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4973,8 +4836,10 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwSSM1Sh,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwSSM1Sh)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwSSM1Sh))-1 ) = PACK(InData%TwSSM1Sh,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwSSM1Sh) + DO i1 = LBOUND(InData%TwSSM1Sh,1), UBOUND(InData%TwSSM1Sh,1) + ReKiBuf(Re_Xferred) = InData%TwSSM1Sh(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TwSSM2Sh) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4986,8 +4851,10 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwSSM2Sh,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwSSM2Sh)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwSSM2Sh))-1 ) = PACK(InData%TwSSM2Sh,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwSSM2Sh) + DO i1 = LBOUND(InData%TwSSM2Sh,1), UBOUND(InData%TwSSM2Sh,1) + ReKiBuf(Re_Xferred) = InData%TwSSM2Sh(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TwGJStif) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4999,8 +4866,10 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwGJStif,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwGJStif)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwGJStif))-1 ) = PACK(InData%TwGJStif,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwGJStif) + DO i1 = LBOUND(InData%TwGJStif,1), UBOUND(InData%TwGJStif,1) + ReKiBuf(Re_Xferred) = InData%TwGJStif(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TwEAStif) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5012,8 +4881,10 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwEAStif,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwEAStif)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwEAStif))-1 ) = PACK(InData%TwEAStif,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwEAStif) + DO i1 = LBOUND(InData%TwEAStif,1), UBOUND(InData%TwEAStif,1) + ReKiBuf(Re_Xferred) = InData%TwEAStif(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TwFAIner) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5025,8 +4896,10 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwFAIner,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwFAIner)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwFAIner))-1 ) = PACK(InData%TwFAIner,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwFAIner) + DO i1 = LBOUND(InData%TwFAIner,1), UBOUND(InData%TwFAIner,1) + ReKiBuf(Re_Xferred) = InData%TwFAIner(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TwSSIner) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5038,8 +4911,10 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwSSIner,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwSSIner)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwSSIner))-1 ) = PACK(InData%TwSSIner,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwSSIner) + DO i1 = LBOUND(InData%TwSSIner,1), UBOUND(InData%TwSSIner,1) + ReKiBuf(Re_Xferred) = InData%TwSSIner(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TwFAcgOf) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5051,8 +4926,10 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwFAcgOf,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwFAcgOf)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwFAcgOf))-1 ) = PACK(InData%TwFAcgOf,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwFAcgOf) + DO i1 = LBOUND(InData%TwFAcgOf,1), UBOUND(InData%TwFAcgOf,1) + ReKiBuf(Re_Xferred) = InData%TwFAcgOf(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TwSScgOf) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5064,131 +4941,133 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwSScgOf,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwSScgOf)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwSScgOf))-1 ) = PACK(InData%TwSScgOf,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwSScgOf) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%RFrlDOF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TFrlDOF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RotFurl - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TailFurl - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Yaw2Shft - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ShftSkew - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlCMxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlCMyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlCMzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%BoomCMxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%BoomCMyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%BoomCMzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFinCMxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFinCMyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFinCMzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFinCPxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFinCPyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFinCPzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFinSkew - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFinTilt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFinBank - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlPntxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlPntyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlPntzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlSkew - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlTilt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlPntxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlPntyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlPntzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlSkew - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlTilt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%BoomMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFinMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlIner - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%RFrlMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlCDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlUSSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlDSSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlUSSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlDSSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlUSDP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlDSDP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlUSDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlDSDmp - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TFrlMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlCDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlUSSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlDSSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlUSSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlDSSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlUSDP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlDSDP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlUSDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlDSDmp - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%method - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%TwSScgOf,1), UBOUND(InData%TwSScgOf,1) + ReKiBuf(Re_Xferred) = InData%TwSScgOf(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = TRANSFER(InData%RFrlDOF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TFrlDOF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RotFurl + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TailFurl + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Yaw2Shft + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ShftSkew + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlCMxn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlCMyn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlCMzn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%BoomCMxn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%BoomCMyn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%BoomCMzn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFinCMxn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFinCMyn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFinCMzn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFinCPxn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFinCPyn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFinCPzn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFinSkew + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFinTilt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFinBank + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlPntxn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlPntyn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlPntzn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlSkew + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlTilt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlPntxn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlPntyn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlPntzn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlSkew + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlTilt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlMass + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%BoomMass + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFinMass + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlIner + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlIner + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%RFrlMod + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlSpr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlDmp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlCDmp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlUSSP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlDSSP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlUSSpr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlDSSpr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlUSDP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlDSDP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlUSDmp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlDSDmp + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TFrlMod + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlSpr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlDmp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlCDmp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlUSSP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlDSSP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlUSSpr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlDSSpr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlUSDP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlDSDP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlUSDmp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlDSDmp + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%method + Int_Xferred = Int_Xferred + 1 END SUBROUTINE ED_PackInputFile SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -5204,12 +5083,6 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -5224,48 +5097,48 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%Gravity = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%FlapDOF1 = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%FlapDOF2 = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%EdgeDOF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%TeetDOF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%DrTrDOF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%GenDOF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%YawDOF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%TwFADOF1 = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%TwFADOF2 = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%TwSSDOF1 = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%TwSSDOF2 = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmSgDOF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmSwDOF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmHvDOF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmRDOF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmPDOF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmYDOF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%OoPDefl = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%IPDefl = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%Gravity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%FlapDOF1 = TRANSFER(IntKiBuf(Int_Xferred), OutData%FlapDOF1) + Int_Xferred = Int_Xferred + 1 + OutData%FlapDOF2 = TRANSFER(IntKiBuf(Int_Xferred), OutData%FlapDOF2) + Int_Xferred = Int_Xferred + 1 + OutData%EdgeDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%EdgeDOF) + Int_Xferred = Int_Xferred + 1 + OutData%TeetDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%TeetDOF) + Int_Xferred = Int_Xferred + 1 + OutData%DrTrDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%DrTrDOF) + Int_Xferred = Int_Xferred + 1 + OutData%GenDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%GenDOF) + Int_Xferred = Int_Xferred + 1 + OutData%YawDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%YawDOF) + Int_Xferred = Int_Xferred + 1 + OutData%TwFADOF1 = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwFADOF1) + Int_Xferred = Int_Xferred + 1 + OutData%TwFADOF2 = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwFADOF2) + Int_Xferred = Int_Xferred + 1 + OutData%TwSSDOF1 = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwSSDOF1) + Int_Xferred = Int_Xferred + 1 + OutData%TwSSDOF2 = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwSSDOF2) + Int_Xferred = Int_Xferred + 1 + OutData%PtfmSgDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmSgDOF) + Int_Xferred = Int_Xferred + 1 + OutData%PtfmSwDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmSwDOF) + Int_Xferred = Int_Xferred + 1 + OutData%PtfmHvDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmHvDOF) + Int_Xferred = Int_Xferred + 1 + OutData%PtfmRDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmRDOF) + Int_Xferred = Int_Xferred + 1 + OutData%PtfmPDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmPDOF) + Int_Xferred = Int_Xferred + 1 + OutData%PtfmYDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmYDOF) + Int_Xferred = Int_Xferred + 1 + OutData%OoPDefl = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%IPDefl = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlPitch not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5279,46 +5152,41 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitch.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BlPitch)>0) OutData%BlPitch = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlPitch))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlPitch) - DEALLOCATE(mask1) - END IF - OutData%TeetDefl = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Azimuth = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%RotSpeed = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NacYaw = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TTDspFA = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TTDspSS = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmSurge = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmSway = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmHeave = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmRoll = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmPitch = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmYaw = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NumBl = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TipRad = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HubRad = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%BlPitch,1), UBOUND(OutData%BlPitch,1) + OutData%BlPitch(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%TeetDefl = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Azimuth = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%RotSpeed = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NacYaw = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TTDspFA = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TTDspSS = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmSurge = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmSway = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmHeave = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmRoll = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmPitch = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmYaw = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NumBl = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TipRad = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HubRad = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PreCone not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5332,56 +5200,51 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PreCone.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%PreCone)>0) OutData%PreCone = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PreCone))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PreCone) - DEALLOCATE(mask1) - END IF - OutData%HubCM = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%UndSling = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Delta3 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%AzimB1Up = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%OverHang = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%ShftGagL = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%ShftTilt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NacCMxn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NacCMyn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NacCMzn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NcIMUxn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NcIMUyn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NcIMUzn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Twr2Shft = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TowerHt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TowerBsHt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmCMxt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmCMyt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmCMzt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmRefzt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%PreCone,1), UBOUND(OutData%PreCone,1) + OutData%PreCone(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%HubCM = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%UndSling = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Delta3 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AzimB1Up = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%OverHang = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%ShftGagL = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%ShftTilt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NacCMxn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NacCMyn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NacCMzn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NcIMUxn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NcIMUyn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NcIMUzn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Twr2Shft = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TowerHt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TowerBsHt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmCMxt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmCMyt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmCMzt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmRefzt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TipMass not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5395,38 +5258,33 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TipMass.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TipMass)>0) OutData%TipMass = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TipMass))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TipMass) - DEALLOCATE(mask1) - END IF - OutData%HubMass = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HubIner = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GenIner = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NacMass = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NacYIner = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawBrMass = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmMass = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmRIner = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmPIner = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmYIner = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%BldNodes = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%TipMass,1), UBOUND(OutData%TipMass,1) + OutData%TipMass(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%HubMass = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HubIner = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GenIner = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NacMass = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NacYIner = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawBrMass = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmMass = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmRIner = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmPIner = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmYIner = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%BldNodes = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InpBlMesh not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5539,76 +5397,66 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%TeetMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TeetDmpP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TeetDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TeetCDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TeetSStP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TeetHStP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TeetSSSp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TeetHSSp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GBoxEff = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GBRatio = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%DTTorSpr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%DTTorDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Furling = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%TwrNodes = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%SumPrint = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%OutFile = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TabDelim = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%Tstart = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%DecFact = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NTwGages = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%TeetMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TeetDmpP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TeetDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TeetCDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TeetSStP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TeetHStP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TeetSSSp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TeetHSSp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GBoxEff = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GBRatio = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%DTTorSpr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%DTTorDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Furling = TRANSFER(IntKiBuf(Int_Xferred), OutData%Furling) + Int_Xferred = Int_Xferred + 1 + OutData%TwrNodes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%SumPrint = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumPrint) + Int_Xferred = Int_Xferred + 1 + OutData%OutFile = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TabDelim = TRANSFER(IntKiBuf(Int_Xferred), OutData%TabDelim) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%OutFmt) + OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%Tstart = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%DecFact = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NTwGages = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%TwrGagNd,1) i1_u = UBOUND(OutData%TwrGagNd,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%TwrGagNd = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%TwrGagNd))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%TwrGagNd) - DEALLOCATE(mask1) - OutData%NBlGages = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%TwrGagNd,1), UBOUND(OutData%TwrGagNd,1) + OutData%TwrGagNd(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + OutData%NBlGages = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%BldGagNd,1) i1_u = UBOUND(OutData%BldGagNd,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%BldGagNd = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%BldGagNd))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%BldGagNd) - DEALLOCATE(mask1) - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%BldGagNd,1), UBOUND(OutData%BldGagNd,1) + OutData%BldGagNd(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutList not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5622,66 +5470,39 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) + DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) DO I = 1, LEN(OutData%OutList) OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF - OutData%NTwInpSt = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NTwInpSt = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%TwrFADmp,1) i1_u = UBOUND(OutData%TwrFADmp,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%TwrFADmp = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwrFADmp))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwrFADmp) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwrFADmp,1), UBOUND(OutData%TwrFADmp,1) + OutData%TwrFADmp(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%TwrSSDmp,1) i1_u = UBOUND(OutData%TwrSSDmp,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%TwrSSDmp = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwrSSDmp))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwrSSDmp) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwrSSDmp,1), UBOUND(OutData%TwrSSDmp,1) + OutData%TwrSSDmp(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%FAStTunr,1) i1_u = UBOUND(OutData%FAStTunr,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%FAStTunr = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FAStTunr))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FAStTunr) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FAStTunr,1), UBOUND(OutData%FAStTunr,1) + OutData%FAStTunr(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%SSStTunr,1) i1_u = UBOUND(OutData%SSStTunr,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%SSStTunr = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SSStTunr))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SSStTunr) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%SSStTunr,1), UBOUND(OutData%SSStTunr,1) + OutData%SSStTunr(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! HtFract not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5695,15 +5516,10 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%HtFract.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%HtFract)>0) OutData%HtFract = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%HtFract))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%HtFract) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%HtFract,1), UBOUND(OutData%HtFract,1) + OutData%HtFract(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TMassDen not allocated Int_Xferred = Int_Xferred + 1 @@ -5718,15 +5534,10 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TMassDen.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TMassDen)>0) OutData%TMassDen = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TMassDen))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TMassDen) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TMassDen,1), UBOUND(OutData%TMassDen,1) + OutData%TMassDen(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwFAStif not allocated Int_Xferred = Int_Xferred + 1 @@ -5741,15 +5552,10 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwFAStif.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwFAStif)>0) OutData%TwFAStif = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwFAStif))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwFAStif) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwFAStif,1), UBOUND(OutData%TwFAStif,1) + OutData%TwFAStif(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwSSStif not allocated Int_Xferred = Int_Xferred + 1 @@ -5764,15 +5570,10 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwSSStif.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwSSStif)>0) OutData%TwSSStif = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwSSStif))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwSSStif) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwSSStif,1), UBOUND(OutData%TwSSStif,1) + OutData%TwSSStif(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwFAM1Sh not allocated Int_Xferred = Int_Xferred + 1 @@ -5787,15 +5588,10 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwFAM1Sh.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwFAM1Sh)>0) OutData%TwFAM1Sh = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwFAM1Sh))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwFAM1Sh) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwFAM1Sh,1), UBOUND(OutData%TwFAM1Sh,1) + OutData%TwFAM1Sh(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwFAM2Sh not allocated Int_Xferred = Int_Xferred + 1 @@ -5810,15 +5606,10 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwFAM2Sh.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwFAM2Sh)>0) OutData%TwFAM2Sh = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwFAM2Sh))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwFAM2Sh) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwFAM2Sh,1), UBOUND(OutData%TwFAM2Sh,1) + OutData%TwFAM2Sh(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwSSM1Sh not allocated Int_Xferred = Int_Xferred + 1 @@ -5833,15 +5624,10 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwSSM1Sh.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwSSM1Sh)>0) OutData%TwSSM1Sh = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwSSM1Sh))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwSSM1Sh) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwSSM1Sh,1), UBOUND(OutData%TwSSM1Sh,1) + OutData%TwSSM1Sh(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwSSM2Sh not allocated Int_Xferred = Int_Xferred + 1 @@ -5856,15 +5642,10 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwSSM2Sh.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwSSM2Sh)>0) OutData%TwSSM2Sh = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwSSM2Sh))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwSSM2Sh) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwSSM2Sh,1), UBOUND(OutData%TwSSM2Sh,1) + OutData%TwSSM2Sh(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwGJStif not allocated Int_Xferred = Int_Xferred + 1 @@ -5879,15 +5660,10 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwGJStif.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwGJStif)>0) OutData%TwGJStif = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwGJStif))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwGJStif) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwGJStif,1), UBOUND(OutData%TwGJStif,1) + OutData%TwGJStif(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwEAStif not allocated Int_Xferred = Int_Xferred + 1 @@ -5902,15 +5678,10 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwEAStif.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwEAStif)>0) OutData%TwEAStif = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwEAStif))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwEAStif) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwEAStif,1), UBOUND(OutData%TwEAStif,1) + OutData%TwEAStif(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwFAIner not allocated Int_Xferred = Int_Xferred + 1 @@ -5925,15 +5696,10 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwFAIner.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwFAIner)>0) OutData%TwFAIner = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwFAIner))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwFAIner) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwFAIner,1), UBOUND(OutData%TwFAIner,1) + OutData%TwFAIner(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwSSIner not allocated Int_Xferred = Int_Xferred + 1 @@ -5948,15 +5714,10 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwSSIner.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwSSIner)>0) OutData%TwSSIner = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwSSIner))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwSSIner) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwSSIner,1), UBOUND(OutData%TwSSIner,1) + OutData%TwSSIner(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwFAcgOf not allocated Int_Xferred = Int_Xferred + 1 @@ -5971,15 +5732,10 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwFAcgOf.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwFAcgOf)>0) OutData%TwFAcgOf = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwFAcgOf))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwFAcgOf) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwFAcgOf,1), UBOUND(OutData%TwFAcgOf,1) + OutData%TwFAcgOf(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwSScgOf not allocated Int_Xferred = Int_Xferred + 1 @@ -5994,138 +5750,133 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwSScgOf.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwSScgOf)>0) OutData%TwSScgOf = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwSScgOf))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwSScgOf) - DEALLOCATE(mask1) - END IF - OutData%RFrlDOF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%TFrlDOF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%RotFurl = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TailFurl = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Yaw2Shft = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%ShftSkew = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlCMxn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlCMyn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlCMzn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%BoomCMxn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%BoomCMyn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%BoomCMzn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFinCMxn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFinCMyn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFinCMzn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFinCPxn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFinCPyn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFinCPzn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFinSkew = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFinTilt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFinBank = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlPntxn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlPntyn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlPntzn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlSkew = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlTilt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlPntxn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlPntyn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlPntzn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlSkew = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlTilt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlMass = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%BoomMass = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFinMass = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlIner = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlIner = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%RFrlSpr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlCDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlUSSP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlDSSP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlUSSpr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlDSSpr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlUSDP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlDSDP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlUSDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlDSDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TFrlSpr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlCDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlUSSP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlDSSP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlUSSpr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlDSSpr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlUSDP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlDSDP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlUSDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlDSDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%method = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%TwSScgOf,1), UBOUND(OutData%TwSScgOf,1) + OutData%TwSScgOf(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%RFrlDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%RFrlDOF) + Int_Xferred = Int_Xferred + 1 + OutData%TFrlDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%TFrlDOF) + Int_Xferred = Int_Xferred + 1 + OutData%RotFurl = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TailFurl = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Yaw2Shft = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%ShftSkew = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlCMxn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlCMyn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlCMzn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%BoomCMxn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%BoomCMyn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%BoomCMzn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFinCMxn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFinCMyn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFinCMzn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFinCPxn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFinCPyn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFinCPzn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFinSkew = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFinTilt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFinBank = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlPntxn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlPntyn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlPntzn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlSkew = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlTilt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlPntxn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlPntyn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlPntzn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlSkew = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlTilt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlMass = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%BoomMass = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFinMass = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlIner = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlIner = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%RFrlSpr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlCDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlUSSP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlDSSP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlUSSpr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlDSSpr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlUSDP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlDSDP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlUSDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlDSDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TFrlSpr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlCDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlUSSP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlDSSP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlUSSpr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlDSSpr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlUSDP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlDSDP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlUSDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlDSDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%method = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE ED_UnPackInputFile SUBROUTINE ED_CopyCoordSys( SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, ErrMsg ) @@ -6704,48 +6455,90 @@ SUBROUTINE ED_PackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%a1))-1 ) = PACK(InData%a1,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%a1) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%a2))-1 ) = PACK(InData%a2,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%a2) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%a3))-1 ) = PACK(InData%a3,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%a3) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%b1))-1 ) = PACK(InData%b1,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%b1) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%b2))-1 ) = PACK(InData%b2,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%b2) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%b3))-1 ) = PACK(InData%b3,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%b3) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%c1))-1 ) = PACK(InData%c1,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%c1) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%c2))-1 ) = PACK(InData%c2,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%c2) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%c3))-1 ) = PACK(InData%c3,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%c3) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%d1))-1 ) = PACK(InData%d1,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%d1) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%d2))-1 ) = PACK(InData%d2,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%d2) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%d3))-1 ) = PACK(InData%d3,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%d3) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%e1))-1 ) = PACK(InData%e1,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%e1) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%e2))-1 ) = PACK(InData%e2,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%e2) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%e3))-1 ) = PACK(InData%e3,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%e3) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%f1))-1 ) = PACK(InData%f1,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%f1) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%f2))-1 ) = PACK(InData%f2,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%f2) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%f3))-1 ) = PACK(InData%f3,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%f3) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%g1))-1 ) = PACK(InData%g1,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%g1) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%g2))-1 ) = PACK(InData%g2,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%g2) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%g3))-1 ) = PACK(InData%g3,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%g3) + DO i1 = LBOUND(InData%a1,1), UBOUND(InData%a1,1) + DbKiBuf(Db_Xferred) = InData%a1(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%a2,1), UBOUND(InData%a2,1) + DbKiBuf(Db_Xferred) = InData%a2(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%a3,1), UBOUND(InData%a3,1) + DbKiBuf(Db_Xferred) = InData%a3(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%b1,1), UBOUND(InData%b1,1) + DbKiBuf(Db_Xferred) = InData%b1(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%b2,1), UBOUND(InData%b2,1) + DbKiBuf(Db_Xferred) = InData%b2(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%b3,1), UBOUND(InData%b3,1) + DbKiBuf(Db_Xferred) = InData%b3(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%c1,1), UBOUND(InData%c1,1) + DbKiBuf(Db_Xferred) = InData%c1(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%c2,1), UBOUND(InData%c2,1) + DbKiBuf(Db_Xferred) = InData%c2(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%c3,1), UBOUND(InData%c3,1) + DbKiBuf(Db_Xferred) = InData%c3(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%d1,1), UBOUND(InData%d1,1) + DbKiBuf(Db_Xferred) = InData%d1(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%d2,1), UBOUND(InData%d2,1) + DbKiBuf(Db_Xferred) = InData%d2(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%d3,1), UBOUND(InData%d3,1) + DbKiBuf(Db_Xferred) = InData%d3(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%e1,1), UBOUND(InData%e1,1) + DbKiBuf(Db_Xferred) = InData%e1(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%e2,1), UBOUND(InData%e2,1) + DbKiBuf(Db_Xferred) = InData%e2(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%e3,1), UBOUND(InData%e3,1) + DbKiBuf(Db_Xferred) = InData%e3(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%f1,1), UBOUND(InData%f1,1) + DbKiBuf(Db_Xferred) = InData%f1(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%f2,1), UBOUND(InData%f2,1) + DbKiBuf(Db_Xferred) = InData%f2(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%f3,1), UBOUND(InData%f3,1) + DbKiBuf(Db_Xferred) = InData%f3(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%g1,1), UBOUND(InData%g1,1) + DbKiBuf(Db_Xferred) = InData%g1(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%g2,1), UBOUND(InData%g2,1) + DbKiBuf(Db_Xferred) = InData%g2(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%g3,1), UBOUND(InData%g3,1) + DbKiBuf(Db_Xferred) = InData%g3(i1) + Db_Xferred = Db_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%i1) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -6759,8 +6552,12 @@ SUBROUTINE ED_PackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%i1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%i1)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%i1))-1 ) = PACK(InData%i1,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%i1) + DO i2 = LBOUND(InData%i1,2), UBOUND(InData%i1,2) + DO i1 = LBOUND(InData%i1,1), UBOUND(InData%i1,1) + DbKiBuf(Db_Xferred) = InData%i1(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%i2) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6775,8 +6572,12 @@ SUBROUTINE ED_PackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%i2,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%i2)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%i2))-1 ) = PACK(InData%i2,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%i2) + DO i2 = LBOUND(InData%i2,2), UBOUND(InData%i2,2) + DO i1 = LBOUND(InData%i2,1), UBOUND(InData%i2,1) + DbKiBuf(Db_Xferred) = InData%i2(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%i3) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6791,8 +6592,12 @@ SUBROUTINE ED_PackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%i3,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%i3)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%i3))-1 ) = PACK(InData%i3,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%i3) + DO i2 = LBOUND(InData%i3,2), UBOUND(InData%i3,2) + DO i1 = LBOUND(InData%i3,1), UBOUND(InData%i3,1) + DbKiBuf(Db_Xferred) = InData%i3(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%j1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6807,8 +6612,12 @@ SUBROUTINE ED_PackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%j1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%j1)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%j1))-1 ) = PACK(InData%j1,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%j1) + DO i2 = LBOUND(InData%j1,2), UBOUND(InData%j1,2) + DO i1 = LBOUND(InData%j1,1), UBOUND(InData%j1,1) + DbKiBuf(Db_Xferred) = InData%j1(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%j2) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6823,8 +6632,12 @@ SUBROUTINE ED_PackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%j2,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%j2)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%j2))-1 ) = PACK(InData%j2,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%j2) + DO i2 = LBOUND(InData%j2,2), UBOUND(InData%j2,2) + DO i1 = LBOUND(InData%j2,1), UBOUND(InData%j2,1) + DbKiBuf(Db_Xferred) = InData%j2(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%j3) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6839,8 +6652,12 @@ SUBROUTINE ED_PackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%j3,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%j3)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%j3))-1 ) = PACK(InData%j3,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%j3) + DO i2 = LBOUND(InData%j3,2), UBOUND(InData%j3,2) + DO i1 = LBOUND(InData%j3,1), UBOUND(InData%j3,1) + DbKiBuf(Db_Xferred) = InData%j3(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%m1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6858,8 +6675,14 @@ SUBROUTINE ED_PackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%m1,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%m1)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%m1))-1 ) = PACK(InData%m1,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%m1) + DO i3 = LBOUND(InData%m1,3), UBOUND(InData%m1,3) + DO i2 = LBOUND(InData%m1,2), UBOUND(InData%m1,2) + DO i1 = LBOUND(InData%m1,1), UBOUND(InData%m1,1) + DbKiBuf(Db_Xferred) = InData%m1(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%m2) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6877,8 +6700,14 @@ SUBROUTINE ED_PackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%m2,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%m2)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%m2))-1 ) = PACK(InData%m2,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%m2) + DO i3 = LBOUND(InData%m2,3), UBOUND(InData%m2,3) + DO i2 = LBOUND(InData%m2,2), UBOUND(InData%m2,2) + DO i1 = LBOUND(InData%m2,1), UBOUND(InData%m2,1) + DbKiBuf(Db_Xferred) = InData%m2(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%m3) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6896,8 +6725,14 @@ SUBROUTINE ED_PackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%m3,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%m3)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%m3))-1 ) = PACK(InData%m3,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%m3) + DO i3 = LBOUND(InData%m3,3), UBOUND(InData%m3,3) + DO i2 = LBOUND(InData%m3,2), UBOUND(InData%m3,2) + DO i1 = LBOUND(InData%m3,1), UBOUND(InData%m3,1) + DbKiBuf(Db_Xferred) = InData%m3(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%n1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6915,8 +6750,14 @@ SUBROUTINE ED_PackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%n1,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%n1)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%n1))-1 ) = PACK(InData%n1,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%n1) + DO i3 = LBOUND(InData%n1,3), UBOUND(InData%n1,3) + DO i2 = LBOUND(InData%n1,2), UBOUND(InData%n1,2) + DO i1 = LBOUND(InData%n1,1), UBOUND(InData%n1,1) + DbKiBuf(Db_Xferred) = InData%n1(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%n2) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6934,8 +6775,14 @@ SUBROUTINE ED_PackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%n2,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%n2)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%n2))-1 ) = PACK(InData%n2,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%n2) + DO i3 = LBOUND(InData%n2,3), UBOUND(InData%n2,3) + DO i2 = LBOUND(InData%n2,2), UBOUND(InData%n2,2) + DO i1 = LBOUND(InData%n2,1), UBOUND(InData%n2,1) + DbKiBuf(Db_Xferred) = InData%n2(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%n3) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6953,23 +6800,43 @@ SUBROUTINE ED_PackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%n3,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%n3)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%n3))-1 ) = PACK(InData%n3,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%n3) - END IF - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%p1))-1 ) = PACK(InData%p1,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%p1) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%p2))-1 ) = PACK(InData%p2,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%p2) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%p3))-1 ) = PACK(InData%p3,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%p3) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rf1))-1 ) = PACK(InData%rf1,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rf1) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rf2))-1 ) = PACK(InData%rf2,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rf2) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rf3))-1 ) = PACK(InData%rf3,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rf3) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rfa))-1 ) = PACK(InData%rfa,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rfa) + DO i3 = LBOUND(InData%n3,3), UBOUND(InData%n3,3) + DO i2 = LBOUND(InData%n3,2), UBOUND(InData%n3,2) + DO i1 = LBOUND(InData%n3,1), UBOUND(InData%n3,1) + DbKiBuf(Db_Xferred) = InData%n3(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END IF + DO i1 = LBOUND(InData%p1,1), UBOUND(InData%p1,1) + DbKiBuf(Db_Xferred) = InData%p1(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%p2,1), UBOUND(InData%p2,1) + DbKiBuf(Db_Xferred) = InData%p2(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%p3,1), UBOUND(InData%p3,1) + DbKiBuf(Db_Xferred) = InData%p3(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rf1,1), UBOUND(InData%rf1,1) + DbKiBuf(Db_Xferred) = InData%rf1(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rf2,1), UBOUND(InData%rf2,1) + DbKiBuf(Db_Xferred) = InData%rf2(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rf3,1), UBOUND(InData%rf3,1) + DbKiBuf(Db_Xferred) = InData%rf3(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rfa,1), UBOUND(InData%rfa,1) + DbKiBuf(Db_Xferred) = InData%rfa(i1) + Db_Xferred = Db_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%t1) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -6983,8 +6850,12 @@ SUBROUTINE ED_PackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%t1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%t1)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%t1))-1 ) = PACK(InData%t1,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%t1) + DO i2 = LBOUND(InData%t1,2), UBOUND(InData%t1,2) + DO i1 = LBOUND(InData%t1,1), UBOUND(InData%t1,1) + DbKiBuf(Db_Xferred) = InData%t1(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%t2) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6999,8 +6870,12 @@ SUBROUTINE ED_PackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%t2,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%t2)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%t2))-1 ) = PACK(InData%t2,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%t2) + DO i2 = LBOUND(InData%t2,2), UBOUND(InData%t2,2) + DO i1 = LBOUND(InData%t2,1), UBOUND(InData%t2,1) + DbKiBuf(Db_Xferred) = InData%t2(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%t3) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7015,8 +6890,12 @@ SUBROUTINE ED_PackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%t3,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%t3)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%t3))-1 ) = PACK(InData%t3,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%t3) + DO i2 = LBOUND(InData%t3,2), UBOUND(InData%t3,2) + DO i1 = LBOUND(InData%t3,1), UBOUND(InData%t3,1) + DbKiBuf(Db_Xferred) = InData%t3(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%te1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7034,8 +6913,14 @@ SUBROUTINE ED_PackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%te1,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%te1)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%te1))-1 ) = PACK(InData%te1,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%te1) + DO i3 = LBOUND(InData%te1,3), UBOUND(InData%te1,3) + DO i2 = LBOUND(InData%te1,2), UBOUND(InData%te1,2) + DO i1 = LBOUND(InData%te1,1), UBOUND(InData%te1,1) + DbKiBuf(Db_Xferred) = InData%te1(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%te2) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7053,8 +6938,14 @@ SUBROUTINE ED_PackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%te2,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%te2)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%te2))-1 ) = PACK(InData%te2,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%te2) + DO i3 = LBOUND(InData%te2,3), UBOUND(InData%te2,3) + DO i2 = LBOUND(InData%te2,2), UBOUND(InData%te2,2) + DO i1 = LBOUND(InData%te2,1), UBOUND(InData%te2,1) + DbKiBuf(Db_Xferred) = InData%te2(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%te3) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7072,23 +6963,43 @@ SUBROUTINE ED_PackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%te3,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%te3)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%te3))-1 ) = PACK(InData%te3,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%te3) - END IF - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%tf1))-1 ) = PACK(InData%tf1,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%tf1) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%tf2))-1 ) = PACK(InData%tf2,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%tf2) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%tf3))-1 ) = PACK(InData%tf3,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%tf3) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%tfa))-1 ) = PACK(InData%tfa,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%tfa) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%z1))-1 ) = PACK(InData%z1,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%z1) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%z2))-1 ) = PACK(InData%z2,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%z2) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%z3))-1 ) = PACK(InData%z3,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%z3) + DO i3 = LBOUND(InData%te3,3), UBOUND(InData%te3,3) + DO i2 = LBOUND(InData%te3,2), UBOUND(InData%te3,2) + DO i1 = LBOUND(InData%te3,1), UBOUND(InData%te3,1) + DbKiBuf(Db_Xferred) = InData%te3(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END IF + DO i1 = LBOUND(InData%tf1,1), UBOUND(InData%tf1,1) + DbKiBuf(Db_Xferred) = InData%tf1(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%tf2,1), UBOUND(InData%tf2,1) + DbKiBuf(Db_Xferred) = InData%tf2(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%tf3,1), UBOUND(InData%tf3,1) + DbKiBuf(Db_Xferred) = InData%tf3(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%tfa,1), UBOUND(InData%tfa,1) + DbKiBuf(Db_Xferred) = InData%tfa(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%z1,1), UBOUND(InData%z1,1) + DbKiBuf(Db_Xferred) = InData%z1(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%z2,1), UBOUND(InData%z2,1) + DbKiBuf(Db_Xferred) = InData%z2(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%z3,1), UBOUND(InData%z3,1) + DbKiBuf(Db_Xferred) = InData%z3(i1) + Db_Xferred = Db_Xferred + 1 + END DO END SUBROUTINE ED_PackCoordSys SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -7104,12 +7015,6 @@ SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -7128,235 +7033,130 @@ SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM Int_Xferred = 1 i1_l = LBOUND(OutData%a1,1) i1_u = UBOUND(OutData%a1,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%a1 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%a1))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%a1) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%a1,1), UBOUND(OutData%a1,1) + OutData%a1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%a2,1) i1_u = UBOUND(OutData%a2,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%a2 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%a2))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%a2) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%a2,1), UBOUND(OutData%a2,1) + OutData%a2(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%a3,1) i1_u = UBOUND(OutData%a3,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%a3 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%a3))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%a3) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%a3,1), UBOUND(OutData%a3,1) + OutData%a3(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%b1,1) i1_u = UBOUND(OutData%b1,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%b1 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%b1))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%b1) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%b1,1), UBOUND(OutData%b1,1) + OutData%b1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%b2,1) i1_u = UBOUND(OutData%b2,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%b2 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%b2))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%b2) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%b2,1), UBOUND(OutData%b2,1) + OutData%b2(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%b3,1) i1_u = UBOUND(OutData%b3,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%b3 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%b3))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%b3) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%b3,1), UBOUND(OutData%b3,1) + OutData%b3(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%c1,1) i1_u = UBOUND(OutData%c1,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%c1 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%c1))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%c1) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%c1,1), UBOUND(OutData%c1,1) + OutData%c1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%c2,1) i1_u = UBOUND(OutData%c2,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%c2 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%c2))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%c2) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%c2,1), UBOUND(OutData%c2,1) + OutData%c2(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%c3,1) i1_u = UBOUND(OutData%c3,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%c3 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%c3))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%c3) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%c3,1), UBOUND(OutData%c3,1) + OutData%c3(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%d1,1) i1_u = UBOUND(OutData%d1,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%d1 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%d1))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%d1) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%d1,1), UBOUND(OutData%d1,1) + OutData%d1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%d2,1) i1_u = UBOUND(OutData%d2,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%d2 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%d2))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%d2) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%d2,1), UBOUND(OutData%d2,1) + OutData%d2(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%d3,1) i1_u = UBOUND(OutData%d3,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%d3 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%d3))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%d3) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%d3,1), UBOUND(OutData%d3,1) + OutData%d3(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%e1,1) i1_u = UBOUND(OutData%e1,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%e1 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%e1))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%e1) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%e1,1), UBOUND(OutData%e1,1) + OutData%e1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%e2,1) i1_u = UBOUND(OutData%e2,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%e2 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%e2))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%e2) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%e2,1), UBOUND(OutData%e2,1) + OutData%e2(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%e3,1) i1_u = UBOUND(OutData%e3,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%e3 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%e3))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%e3) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%e3,1), UBOUND(OutData%e3,1) + OutData%e3(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%f1,1) i1_u = UBOUND(OutData%f1,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%f1 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%f1))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%f1) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%f1,1), UBOUND(OutData%f1,1) + OutData%f1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%f2,1) i1_u = UBOUND(OutData%f2,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%f2 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%f2))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%f2) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%f2,1), UBOUND(OutData%f2,1) + OutData%f2(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%f3,1) i1_u = UBOUND(OutData%f3,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%f3 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%f3))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%f3) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%f3,1), UBOUND(OutData%f3,1) + OutData%f3(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%g1,1) i1_u = UBOUND(OutData%g1,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%g1 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%g1))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%g1) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%g1,1), UBOUND(OutData%g1,1) + OutData%g1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%g2,1) i1_u = UBOUND(OutData%g2,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%g2 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%g2))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%g2) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%g2,1), UBOUND(OutData%g2,1) + OutData%g2(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%g3,1) i1_u = UBOUND(OutData%g3,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%g3 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%g3))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%g3) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%g3,1), UBOUND(OutData%g3,1) + OutData%g3(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! i1 not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -7373,15 +7173,12 @@ SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%i1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%i1)>0) OutData%i1 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%i1))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%i1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%i1,2), UBOUND(OutData%i1,2) + DO i1 = LBOUND(OutData%i1,1), UBOUND(OutData%i1,1) + OutData%i1(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! i2 not allocated Int_Xferred = Int_Xferred + 1 @@ -7399,15 +7196,12 @@ SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%i2.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%i2)>0) OutData%i2 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%i2))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%i2) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%i2,2), UBOUND(OutData%i2,2) + DO i1 = LBOUND(OutData%i2,1), UBOUND(OutData%i2,1) + OutData%i2(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! i3 not allocated Int_Xferred = Int_Xferred + 1 @@ -7425,15 +7219,12 @@ SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%i3.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%i3)>0) OutData%i3 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%i3))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%i3) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%i3,2), UBOUND(OutData%i3,2) + DO i1 = LBOUND(OutData%i3,1), UBOUND(OutData%i3,1) + OutData%i3(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! j1 not allocated Int_Xferred = Int_Xferred + 1 @@ -7451,15 +7242,12 @@ SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%j1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%j1)>0) OutData%j1 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%j1))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%j1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%j1,2), UBOUND(OutData%j1,2) + DO i1 = LBOUND(OutData%j1,1), UBOUND(OutData%j1,1) + OutData%j1(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! j2 not allocated Int_Xferred = Int_Xferred + 1 @@ -7477,15 +7265,12 @@ SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%j2.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%j2)>0) OutData%j2 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%j2))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%j2) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%j2,2), UBOUND(OutData%j2,2) + DO i1 = LBOUND(OutData%j2,1), UBOUND(OutData%j2,1) + OutData%j2(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! j3 not allocated Int_Xferred = Int_Xferred + 1 @@ -7503,15 +7288,12 @@ SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%j3.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%j3)>0) OutData%j3 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%j3))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%j3) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%j3,2), UBOUND(OutData%j3,2) + DO i1 = LBOUND(OutData%j3,1), UBOUND(OutData%j3,1) + OutData%j3(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! m1 not allocated Int_Xferred = Int_Xferred + 1 @@ -7532,15 +7314,14 @@ SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%m1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%m1)>0) OutData%m1 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%m1))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%m1) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%m1,3), UBOUND(OutData%m1,3) + DO i2 = LBOUND(OutData%m1,2), UBOUND(OutData%m1,2) + DO i1 = LBOUND(OutData%m1,1), UBOUND(OutData%m1,1) + OutData%m1(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! m2 not allocated Int_Xferred = Int_Xferred + 1 @@ -7561,15 +7342,14 @@ SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%m2.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%m2)>0) OutData%m2 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%m2))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%m2) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%m2,3), UBOUND(OutData%m2,3) + DO i2 = LBOUND(OutData%m2,2), UBOUND(OutData%m2,2) + DO i1 = LBOUND(OutData%m2,1), UBOUND(OutData%m2,1) + OutData%m2(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! m3 not allocated Int_Xferred = Int_Xferred + 1 @@ -7590,15 +7370,14 @@ SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%m3.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%m3)>0) OutData%m3 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%m3))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%m3) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%m3,3), UBOUND(OutData%m3,3) + DO i2 = LBOUND(OutData%m3,2), UBOUND(OutData%m3,2) + DO i1 = LBOUND(OutData%m3,1), UBOUND(OutData%m3,1) + OutData%m3(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! n1 not allocated Int_Xferred = Int_Xferred + 1 @@ -7619,15 +7398,14 @@ SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%n1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%n1)>0) OutData%n1 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%n1))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%n1) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%n1,3), UBOUND(OutData%n1,3) + DO i2 = LBOUND(OutData%n1,2), UBOUND(OutData%n1,2) + DO i1 = LBOUND(OutData%n1,1), UBOUND(OutData%n1,1) + OutData%n1(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! n2 not allocated Int_Xferred = Int_Xferred + 1 @@ -7648,15 +7426,14 @@ SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%n2.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%n2)>0) OutData%n2 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%n2))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%n2) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%n2,3), UBOUND(OutData%n2,3) + DO i2 = LBOUND(OutData%n2,2), UBOUND(OutData%n2,2) + DO i1 = LBOUND(OutData%n2,1), UBOUND(OutData%n2,1) + OutData%n2(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! n3 not allocated Int_Xferred = Int_Xferred + 1 @@ -7677,93 +7454,57 @@ SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%n3.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%n3)>0) OutData%n3 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%n3))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%n3) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%n3,3), UBOUND(OutData%n3,3) + DO i2 = LBOUND(OutData%n3,2), UBOUND(OutData%n3,2) + DO i1 = LBOUND(OutData%n3,1), UBOUND(OutData%n3,1) + OutData%n3(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF i1_l = LBOUND(OutData%p1,1) i1_u = UBOUND(OutData%p1,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%p1 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%p1))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%p1) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%p1,1), UBOUND(OutData%p1,1) + OutData%p1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%p2,1) i1_u = UBOUND(OutData%p2,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%p2 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%p2))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%p2) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%p2,1), UBOUND(OutData%p2,1) + OutData%p2(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%p3,1) i1_u = UBOUND(OutData%p3,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%p3 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%p3))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%p3) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%p3,1), UBOUND(OutData%p3,1) + OutData%p3(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%rf1,1) i1_u = UBOUND(OutData%rf1,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rf1 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rf1))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rf1) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rf1,1), UBOUND(OutData%rf1,1) + OutData%rf1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%rf2,1) i1_u = UBOUND(OutData%rf2,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rf2 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rf2))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rf2) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rf2,1), UBOUND(OutData%rf2,1) + OutData%rf2(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%rf3,1) i1_u = UBOUND(OutData%rf3,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rf3 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rf3))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rf3) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rf3,1), UBOUND(OutData%rf3,1) + OutData%rf3(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%rfa,1) i1_u = UBOUND(OutData%rfa,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rfa = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rfa))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rfa) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rfa,1), UBOUND(OutData%rfa,1) + OutData%rfa(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! t1 not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -7780,15 +7521,12 @@ SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%t1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%t1)>0) OutData%t1 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%t1))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%t1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%t1,2), UBOUND(OutData%t1,2) + DO i1 = LBOUND(OutData%t1,1), UBOUND(OutData%t1,1) + OutData%t1(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! t2 not allocated Int_Xferred = Int_Xferred + 1 @@ -7806,15 +7544,12 @@ SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%t2.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%t2)>0) OutData%t2 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%t2))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%t2) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%t2,2), UBOUND(OutData%t2,2) + DO i1 = LBOUND(OutData%t2,1), UBOUND(OutData%t2,1) + OutData%t2(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! t3 not allocated Int_Xferred = Int_Xferred + 1 @@ -7832,15 +7567,12 @@ SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%t3.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%t3)>0) OutData%t3 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%t3))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%t3) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%t3,2), UBOUND(OutData%t3,2) + DO i1 = LBOUND(OutData%t3,1), UBOUND(OutData%t3,1) + OutData%t3(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! te1 not allocated Int_Xferred = Int_Xferred + 1 @@ -7861,15 +7593,14 @@ SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%te1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%te1)>0) OutData%te1 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%te1))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%te1) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%te1,3), UBOUND(OutData%te1,3) + DO i2 = LBOUND(OutData%te1,2), UBOUND(OutData%te1,2) + DO i1 = LBOUND(OutData%te1,1), UBOUND(OutData%te1,1) + OutData%te1(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! te2 not allocated Int_Xferred = Int_Xferred + 1 @@ -7890,15 +7621,14 @@ SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%te2.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%te2)>0) OutData%te2 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%te2))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%te2) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%te2,3), UBOUND(OutData%te2,3) + DO i2 = LBOUND(OutData%te2,2), UBOUND(OutData%te2,2) + DO i1 = LBOUND(OutData%te2,1), UBOUND(OutData%te2,1) + OutData%te2(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! te3 not allocated Int_Xferred = Int_Xferred + 1 @@ -7919,93 +7649,57 @@ SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%te3.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%te3)>0) OutData%te3 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%te3))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%te3) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%te3,3), UBOUND(OutData%te3,3) + DO i2 = LBOUND(OutData%te3,2), UBOUND(OutData%te3,2) + DO i1 = LBOUND(OutData%te3,1), UBOUND(OutData%te3,1) + OutData%te3(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF i1_l = LBOUND(OutData%tf1,1) i1_u = UBOUND(OutData%tf1,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%tf1 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%tf1))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%tf1) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%tf1,1), UBOUND(OutData%tf1,1) + OutData%tf1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%tf2,1) i1_u = UBOUND(OutData%tf2,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%tf2 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%tf2))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%tf2) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%tf2,1), UBOUND(OutData%tf2,1) + OutData%tf2(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%tf3,1) i1_u = UBOUND(OutData%tf3,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%tf3 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%tf3))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%tf3) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%tf3,1), UBOUND(OutData%tf3,1) + OutData%tf3(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%tfa,1) i1_u = UBOUND(OutData%tfa,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%tfa = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%tfa))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%tfa) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%tfa,1), UBOUND(OutData%tfa,1) + OutData%tfa(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%z1,1) i1_u = UBOUND(OutData%z1,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%z1 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%z1))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%z1) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%z1,1), UBOUND(OutData%z1,1) + OutData%z1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%z2,1) i1_u = UBOUND(OutData%z2,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%z2 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%z2))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%z2) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%z2,1), UBOUND(OutData%z2,1) + OutData%z2(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%z3,1) i1_u = UBOUND(OutData%z3,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%z3 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%z3))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%z3) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%z3,1), UBOUND(OutData%z3,1) + OutData%z3(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO END SUBROUTINE ED_UnPackCoordSys SUBROUTINE ED_CopyActiveDOFs( SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, ErrStat, ErrMsg ) @@ -8419,30 +8113,32 @@ SUBROUTINE ED_PackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NActvDOF - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NPCE - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NPDE - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NPIE - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NPTE - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NPTTE - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%NPSBE) ) THEN - IntKiBuf( Int_Xferred ) = 0 + IntKiBuf(Int_Xferred) = InData%NActvDOF Int_Xferred = Int_Xferred + 1 - ELSE + IntKiBuf(Int_Xferred) = InData%NPCE + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NPDE + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NPIE + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NPTE + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NPTTE + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%NPSBE) ) 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%NPSBE,1) IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NPSBE,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%NPSBE)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%NPSBE))-1 ) = PACK(InData%NPSBE,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%NPSBE) + DO i1 = LBOUND(InData%NPSBE,1), UBOUND(InData%NPSBE,1) + IntKiBuf(Int_Xferred) = InData%NPSBE(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%NPSE) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8454,13 +8150,15 @@ SUBROUTINE ED_PackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NPSE,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%NPSE)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%NPSE))-1 ) = PACK(InData%NPSE,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%NPSE) + DO i1 = LBOUND(InData%NPSE,1), UBOUND(InData%NPSE,1) + IntKiBuf(Int_Xferred) = InData%NPSE(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NPUE - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NPYE - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NPUE + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NPYE + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%PCE) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -8471,8 +8169,10 @@ SUBROUTINE ED_PackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PCE,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PCE)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%PCE))-1 ) = PACK(InData%PCE,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%PCE) + DO i1 = LBOUND(InData%PCE,1), UBOUND(InData%PCE,1) + IntKiBuf(Int_Xferred) = InData%PCE(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%PDE) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8484,8 +8184,10 @@ SUBROUTINE ED_PackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PDE,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PDE)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%PDE))-1 ) = PACK(InData%PDE,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%PDE) + DO i1 = LBOUND(InData%PDE,1), UBOUND(InData%PDE,1) + IntKiBuf(Int_Xferred) = InData%PDE(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%PIE) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8497,8 +8199,10 @@ SUBROUTINE ED_PackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PIE,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PIE)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%PIE))-1 ) = PACK(InData%PIE,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%PIE) + DO i1 = LBOUND(InData%PIE,1), UBOUND(InData%PIE,1) + IntKiBuf(Int_Xferred) = InData%PIE(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%PTE) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8510,8 +8214,10 @@ SUBROUTINE ED_PackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PTE,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PTE)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%PTE))-1 ) = PACK(InData%PTE,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%PTE) + DO i1 = LBOUND(InData%PTE,1), UBOUND(InData%PTE,1) + IntKiBuf(Int_Xferred) = InData%PTE(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%PTTE) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8523,8 +8229,10 @@ SUBROUTINE ED_PackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PTTE,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PTTE)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%PTTE))-1 ) = PACK(InData%PTTE,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%PTTE) + DO i1 = LBOUND(InData%PTTE,1), UBOUND(InData%PTTE,1) + IntKiBuf(Int_Xferred) = InData%PTTE(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%PS) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8536,8 +8244,10 @@ SUBROUTINE ED_PackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PS,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PS)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%PS))-1 ) = PACK(InData%PS,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%PS) + DO i1 = LBOUND(InData%PS,1), UBOUND(InData%PS,1) + IntKiBuf(Int_Xferred) = InData%PS(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%PSBE) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8552,8 +8262,12 @@ SUBROUTINE ED_PackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PSBE,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PSBE)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%PSBE))-1 ) = PACK(InData%PSBE,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%PSBE) + DO i2 = LBOUND(InData%PSBE,2), UBOUND(InData%PSBE,2) + DO i1 = LBOUND(InData%PSBE,1), UBOUND(InData%PSBE,1) + IntKiBuf(Int_Xferred) = InData%PSBE(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PSE) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8568,8 +8282,12 @@ SUBROUTINE ED_PackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PSE,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PSE)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%PSE))-1 ) = PACK(InData%PSE,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%PSE) + DO i2 = LBOUND(InData%PSE,2), UBOUND(InData%PSE,2) + DO i1 = LBOUND(InData%PSE,1), UBOUND(InData%PSE,1) + IntKiBuf(Int_Xferred) = InData%PSE(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PUE) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8581,8 +8299,10 @@ SUBROUTINE ED_PackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PUE,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PUE)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%PUE))-1 ) = PACK(InData%PUE,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%PUE) + DO i1 = LBOUND(InData%PUE,1), UBOUND(InData%PUE,1) + IntKiBuf(Int_Xferred) = InData%PUE(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%PYE) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8594,8 +8314,10 @@ SUBROUTINE ED_PackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PYE,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PYE)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%PYE))-1 ) = PACK(InData%PYE,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%PYE) + DO i1 = LBOUND(InData%PYE,1), UBOUND(InData%PYE,1) + IntKiBuf(Int_Xferred) = InData%PYE(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%SrtPS) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8607,8 +8329,10 @@ SUBROUTINE ED_PackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SrtPS,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%SrtPS)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%SrtPS))-1 ) = PACK(InData%SrtPS,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%SrtPS) + DO i1 = LBOUND(InData%SrtPS,1), UBOUND(InData%SrtPS,1) + IntKiBuf(Int_Xferred) = InData%SrtPS(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%SrtPSNAUG) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8620,8 +8344,10 @@ SUBROUTINE ED_PackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SrtPSNAUG,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%SrtPSNAUG)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%SrtPSNAUG))-1 ) = PACK(InData%SrtPSNAUG,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%SrtPSNAUG) + DO i1 = LBOUND(InData%SrtPSNAUG,1), UBOUND(InData%SrtPSNAUG,1) + IntKiBuf(Int_Xferred) = InData%SrtPSNAUG(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%Diag) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8633,8 +8359,10 @@ SUBROUTINE ED_PackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Diag,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Diag)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%Diag))-1 ) = PACK(InData%Diag,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%Diag) + DO i1 = LBOUND(InData%Diag,1), UBOUND(InData%Diag,1) + IntKiBuf(Int_Xferred) = InData%Diag(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF END SUBROUTINE ED_PackActiveDOFs @@ -8651,12 +8379,6 @@ SUBROUTINE ED_UnPackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -8672,18 +8394,18 @@ SUBROUTINE ED_UnPackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%NActvDOF = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NPCE = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NPDE = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NPIE = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NPTE = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NPTTE = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NActvDOF = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NPCE = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NPDE = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NPIE = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NPTE = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NPTTE = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NPSBE not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -8697,15 +8419,10 @@ SUBROUTINE ED_UnPackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NPSBE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%NPSBE)>0) OutData%NPSBE = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%NPSBE))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%NPSBE) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%NPSBE,1), UBOUND(OutData%NPSBE,1) + OutData%NPSBE(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NPSE not allocated Int_Xferred = Int_Xferred + 1 @@ -8720,20 +8437,15 @@ SUBROUTINE ED_UnPackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NPSE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%NPSE)>0) OutData%NPSE = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%NPSE))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%NPSE) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%NPSE,1), UBOUND(OutData%NPSE,1) + OutData%NPSE(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF - OutData%NPUE = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NPYE = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NPUE = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NPYE = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PCE not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -8747,15 +8459,10 @@ SUBROUTINE ED_UnPackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PCE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%PCE)>0) OutData%PCE = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%PCE))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%PCE) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%PCE,1), UBOUND(OutData%PCE,1) + OutData%PCE(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PDE not allocated Int_Xferred = Int_Xferred + 1 @@ -8770,15 +8477,10 @@ SUBROUTINE ED_UnPackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PDE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%PDE)>0) OutData%PDE = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%PDE))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%PDE) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%PDE,1), UBOUND(OutData%PDE,1) + OutData%PDE(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PIE not allocated Int_Xferred = Int_Xferred + 1 @@ -8793,15 +8495,10 @@ SUBROUTINE ED_UnPackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PIE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%PIE)>0) OutData%PIE = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%PIE))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%PIE) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%PIE,1), UBOUND(OutData%PIE,1) + OutData%PIE(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PTE not allocated Int_Xferred = Int_Xferred + 1 @@ -8816,15 +8513,10 @@ SUBROUTINE ED_UnPackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PTE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%PTE)>0) OutData%PTE = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%PTE))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%PTE) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%PTE,1), UBOUND(OutData%PTE,1) + OutData%PTE(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PTTE not allocated Int_Xferred = Int_Xferred + 1 @@ -8839,15 +8531,10 @@ SUBROUTINE ED_UnPackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PTTE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%PTTE)>0) OutData%PTTE = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%PTTE))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%PTTE) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%PTTE,1), UBOUND(OutData%PTTE,1) + OutData%PTTE(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PS not allocated Int_Xferred = Int_Xferred + 1 @@ -8862,15 +8549,10 @@ SUBROUTINE ED_UnPackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PS.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%PS)>0) OutData%PS = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%PS))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%PS) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%PS,1), UBOUND(OutData%PS,1) + OutData%PS(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PSBE not allocated Int_Xferred = Int_Xferred + 1 @@ -8888,15 +8570,12 @@ SUBROUTINE ED_UnPackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PSBE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PSBE)>0) OutData%PSBE = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%PSBE))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%PSBE) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PSBE,2), UBOUND(OutData%PSBE,2) + DO i1 = LBOUND(OutData%PSBE,1), UBOUND(OutData%PSBE,1) + OutData%PSBE(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PSE not allocated Int_Xferred = Int_Xferred + 1 @@ -8914,15 +8593,12 @@ SUBROUTINE ED_UnPackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PSE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PSE)>0) OutData%PSE = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%PSE))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%PSE) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PSE,2), UBOUND(OutData%PSE,2) + DO i1 = LBOUND(OutData%PSE,1), UBOUND(OutData%PSE,1) + OutData%PSE(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PUE not allocated Int_Xferred = Int_Xferred + 1 @@ -8937,15 +8613,10 @@ SUBROUTINE ED_UnPackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PUE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%PUE)>0) OutData%PUE = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%PUE))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%PUE) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%PUE,1), UBOUND(OutData%PUE,1) + OutData%PUE(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PYE not allocated Int_Xferred = Int_Xferred + 1 @@ -8960,15 +8631,10 @@ SUBROUTINE ED_UnPackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PYE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%PYE)>0) OutData%PYE = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%PYE))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%PYE) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%PYE,1), UBOUND(OutData%PYE,1) + OutData%PYE(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SrtPS not allocated Int_Xferred = Int_Xferred + 1 @@ -8983,15 +8649,10 @@ SUBROUTINE ED_UnPackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SrtPS.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%SrtPS)>0) OutData%SrtPS = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%SrtPS))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%SrtPS) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%SrtPS,1), UBOUND(OutData%SrtPS,1) + OutData%SrtPS(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SrtPSNAUG not allocated Int_Xferred = Int_Xferred + 1 @@ -9006,15 +8667,10 @@ SUBROUTINE ED_UnPackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SrtPSNAUG.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%SrtPSNAUG)>0) OutData%SrtPSNAUG = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%SrtPSNAUG))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%SrtPSNAUG) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%SrtPSNAUG,1), UBOUND(OutData%SrtPSNAUG,1) + OutData%SrtPSNAUG(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Diag not allocated Int_Xferred = Int_Xferred + 1 @@ -9029,15 +8685,10 @@ SUBROUTINE ED_UnPackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Diag.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Diag)>0) OutData%Diag = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%Diag))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%Diag) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Diag,1), UBOUND(OutData%Diag,1) + OutData%Diag(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF END SUBROUTINE ED_UnPackActiveDOFs @@ -10843,8 +10494,10 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rO))-1 ) = PACK(InData%rO,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rO) + DO i1 = LBOUND(InData%rO,1), UBOUND(InData%rO,1) + DbKiBuf(Db_Xferred) = InData%rO(i1) + Db_Xferred = Db_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%rQS) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -10861,8 +10514,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rQS,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rQS)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rQS))-1 ) = PACK(InData%rQS,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rQS) + DO i3 = LBOUND(InData%rQS,3), UBOUND(InData%rQS,3) + DO i2 = LBOUND(InData%rQS,2), UBOUND(InData%rQS,2) + DO i1 = LBOUND(InData%rQS,1), UBOUND(InData%rQS,1) + DbKiBuf(Db_Xferred) = InData%rQS(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%rS) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10880,8 +10539,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rS,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rS)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rS))-1 ) = PACK(InData%rS,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rS) + DO i3 = LBOUND(InData%rS,3), UBOUND(InData%rS,3) + DO i2 = LBOUND(InData%rS,2), UBOUND(InData%rS,2) + DO i1 = LBOUND(InData%rS,1), UBOUND(InData%rS,1) + DbKiBuf(Db_Xferred) = InData%rS(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%rS0S) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10899,8 +10564,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rS0S,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rS0S)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rS0S))-1 ) = PACK(InData%rS0S,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rS0S) + DO i3 = LBOUND(InData%rS0S,3), UBOUND(InData%rS0S,3) + DO i2 = LBOUND(InData%rS0S,2), UBOUND(InData%rS0S,2) + DO i1 = LBOUND(InData%rS0S,1), UBOUND(InData%rS0S,1) + DbKiBuf(Db_Xferred) = InData%rS0S(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%rT) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10915,11 +10586,17 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rT,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rT)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rT))-1 ) = PACK(InData%rT,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rT) + DO i2 = LBOUND(InData%rT,2), UBOUND(InData%rT,2) + DO i1 = LBOUND(InData%rT,1), UBOUND(InData%rT,1) + DbKiBuf(Db_Xferred) = InData%rT(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rT0O))-1 ) = PACK(InData%rT0O,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rT0O) + DO i1 = LBOUND(InData%rT0O,1), UBOUND(InData%rT0O,1) + DbKiBuf(Db_Xferred) = InData%rT0O(i1) + Db_Xferred = Db_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%rT0T) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -10933,13 +10610,21 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rT0T,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rT0T)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rT0T))-1 ) = PACK(InData%rT0T,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rT0T) + DO i2 = LBOUND(InData%rT0T,2), UBOUND(InData%rT0T,2) + DO i1 = LBOUND(InData%rT0T,1), UBOUND(InData%rT0T,1) + DbKiBuf(Db_Xferred) = InData%rT0T(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rZ))-1 ) = PACK(InData%rZ,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rZ) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rZO))-1 ) = PACK(InData%rZO,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rZO) + DO i1 = LBOUND(InData%rZ,1), UBOUND(InData%rZ,1) + DbKiBuf(Db_Xferred) = InData%rZ(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rZO,1), UBOUND(InData%rZO,1) + DbKiBuf(Db_Xferred) = InData%rZO(i1) + Db_Xferred = Db_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%rZT) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -10953,27 +10638,49 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rZT,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rZT)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rZT))-1 ) = PACK(InData%rZT,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rZT) - END IF - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rPQ))-1 ) = PACK(InData%rPQ,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rPQ) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rP))-1 ) = PACK(InData%rP,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rP) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rV))-1 ) = PACK(InData%rV,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rV) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rZY))-1 ) = PACK(InData%rZY,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rZY) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rOU))-1 ) = PACK(InData%rOU,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rOU) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rOV))-1 ) = PACK(InData%rOV,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rOV) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rVD))-1 ) = PACK(InData%rVD,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rVD) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rOW))-1 ) = PACK(InData%rOW,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rOW) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rPC))-1 ) = PACK(InData%rPC,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rPC) + DO i2 = LBOUND(InData%rZT,2), UBOUND(InData%rZT,2) + DO i1 = LBOUND(InData%rZT,1), UBOUND(InData%rZT,1) + DbKiBuf(Db_Xferred) = InData%rZT(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + DO i1 = LBOUND(InData%rPQ,1), UBOUND(InData%rPQ,1) + DbKiBuf(Db_Xferred) = InData%rPQ(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rP,1), UBOUND(InData%rP,1) + DbKiBuf(Db_Xferred) = InData%rP(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rV,1), UBOUND(InData%rV,1) + DbKiBuf(Db_Xferred) = InData%rV(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rZY,1), UBOUND(InData%rZY,1) + DbKiBuf(Db_Xferred) = InData%rZY(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rOU,1), UBOUND(InData%rOU,1) + DbKiBuf(Db_Xferred) = InData%rOU(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rOV,1), UBOUND(InData%rOV,1) + DbKiBuf(Db_Xferred) = InData%rOV(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rVD,1), UBOUND(InData%rVD,1) + DbKiBuf(Db_Xferred) = InData%rVD(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rOW,1), UBOUND(InData%rOW,1) + DbKiBuf(Db_Xferred) = InData%rOW(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rPC,1), UBOUND(InData%rPC,1) + DbKiBuf(Db_Xferred) = InData%rPC(i1) + Db_Xferred = Db_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%rPS0) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -10987,25 +10694,45 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rPS0,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rPS0)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rPS0))-1 ) = PACK(InData%rPS0,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rPS0) - END IF - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rQ))-1 ) = PACK(InData%rQ,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rQ) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rQC))-1 ) = PACK(InData%rQC,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rQC) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rVIMU))-1 ) = PACK(InData%rVIMU,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rVIMU) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rVP))-1 ) = PACK(InData%rVP,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rVP) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rWI))-1 ) = PACK(InData%rWI,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rWI) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rWJ))-1 ) = PACK(InData%rWJ,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rWJ) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rWK))-1 ) = PACK(InData%rWK,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rWK) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rZT0))-1 ) = PACK(InData%rZT0,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rZT0) + DO i2 = LBOUND(InData%rPS0,2), UBOUND(InData%rPS0,2) + DO i1 = LBOUND(InData%rPS0,1), UBOUND(InData%rPS0,1) + DbKiBuf(Db_Xferred) = InData%rPS0(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + DO i1 = LBOUND(InData%rQ,1), UBOUND(InData%rQ,1) + DbKiBuf(Db_Xferred) = InData%rQ(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rQC,1), UBOUND(InData%rQC,1) + DbKiBuf(Db_Xferred) = InData%rQC(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rVIMU,1), UBOUND(InData%rVIMU,1) + DbKiBuf(Db_Xferred) = InData%rVIMU(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rVP,1), UBOUND(InData%rVP,1) + DbKiBuf(Db_Xferred) = InData%rVP(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rWI,1), UBOUND(InData%rWI,1) + DbKiBuf(Db_Xferred) = InData%rWI(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rWJ,1), UBOUND(InData%rWJ,1) + DbKiBuf(Db_Xferred) = InData%rWJ(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rWK,1), UBOUND(InData%rWK,1) + DbKiBuf(Db_Xferred) = InData%rWK(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rZT0,1), UBOUND(InData%rZT0,1) + DbKiBuf(Db_Xferred) = InData%rZT0(i1) + Db_Xferred = Db_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%AngPosEF) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -11019,8 +10746,12 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngPosEF,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AngPosEF)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngPosEF))-1 ) = PACK(InData%AngPosEF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngPosEF) + DO i2 = LBOUND(InData%AngPosEF,2), UBOUND(InData%AngPosEF,2) + DO i1 = LBOUND(InData%AngPosEF,1), UBOUND(InData%AngPosEF,1) + ReKiBuf(Re_Xferred) = InData%AngPosEF(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%AngPosXF) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11035,8 +10766,12 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngPosXF,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AngPosXF)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngPosXF))-1 ) = PACK(InData%AngPosXF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngPosXF) + DO i2 = LBOUND(InData%AngPosXF,2), UBOUND(InData%AngPosXF,2) + DO i1 = LBOUND(InData%AngPosXF,1), UBOUND(InData%AngPosXF,1) + ReKiBuf(Re_Xferred) = InData%AngPosXF(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%AngPosHM) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11054,13 +10789,23 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngPosHM,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AngPosHM)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngPosHM))-1 ) = PACK(InData%AngPosHM,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngPosHM) + DO i3 = LBOUND(InData%AngPosHM,3), UBOUND(InData%AngPosHM,3) + DO i2 = LBOUND(InData%AngPosHM,2), UBOUND(InData%AngPosHM,2) + DO i1 = LBOUND(InData%AngPosHM,1), UBOUND(InData%AngPosHM,1) + ReKiBuf(Re_Xferred) = InData%AngPosHM(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngPosXB))-1 ) = PACK(InData%AngPosXB,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngPosXB) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngPosEX))-1 ) = PACK(InData%AngPosEX,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngPosEX) + DO i1 = LBOUND(InData%AngPosXB,1), UBOUND(InData%AngPosXB,1) + ReKiBuf(Re_Xferred) = InData%AngPosXB(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%AngPosEX,1), UBOUND(InData%AngPosEX,1) + ReKiBuf(Re_Xferred) = InData%AngPosEX(i1) + Re_Xferred = Re_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%PAngVelEA) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -11077,8 +10822,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEA,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PAngVelEA)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PAngVelEA))-1 ) = PACK(InData%PAngVelEA,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PAngVelEA) + DO i3 = LBOUND(InData%PAngVelEA,3), UBOUND(InData%PAngVelEA,3) + DO i2 = LBOUND(InData%PAngVelEA,2), UBOUND(InData%PAngVelEA,2) + DO i1 = LBOUND(InData%PAngVelEA,1), UBOUND(InData%PAngVelEA,1) + ReKiBuf(Re_Xferred) = InData%PAngVelEA(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PAngVelEF) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11099,8 +10850,16 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEF,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PAngVelEF)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PAngVelEF))-1 ) = PACK(InData%PAngVelEF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PAngVelEF) + DO i4 = LBOUND(InData%PAngVelEF,4), UBOUND(InData%PAngVelEF,4) + DO i3 = LBOUND(InData%PAngVelEF,3), UBOUND(InData%PAngVelEF,3) + DO i2 = LBOUND(InData%PAngVelEF,2), UBOUND(InData%PAngVelEF,2) + DO i1 = LBOUND(InData%PAngVelEF,1), UBOUND(InData%PAngVelEF,1) + ReKiBuf(Re_Xferred) = InData%PAngVelEF(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PAngVelEG) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11118,8 +10877,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEG,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PAngVelEG)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PAngVelEG))-1 ) = PACK(InData%PAngVelEG,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PAngVelEG) + DO i3 = LBOUND(InData%PAngVelEG,3), UBOUND(InData%PAngVelEG,3) + DO i2 = LBOUND(InData%PAngVelEG,2), UBOUND(InData%PAngVelEG,2) + DO i1 = LBOUND(InData%PAngVelEG,1), UBOUND(InData%PAngVelEG,1) + ReKiBuf(Re_Xferred) = InData%PAngVelEG(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PAngVelEH) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11137,8 +10902,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEH,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PAngVelEH)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PAngVelEH))-1 ) = PACK(InData%PAngVelEH,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PAngVelEH) + DO i3 = LBOUND(InData%PAngVelEH,3), UBOUND(InData%PAngVelEH,3) + DO i2 = LBOUND(InData%PAngVelEH,2), UBOUND(InData%PAngVelEH,2) + DO i1 = LBOUND(InData%PAngVelEH,1), UBOUND(InData%PAngVelEH,1) + ReKiBuf(Re_Xferred) = InData%PAngVelEH(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PAngVelEL) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11156,8 +10927,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEL,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PAngVelEL)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PAngVelEL))-1 ) = PACK(InData%PAngVelEL,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PAngVelEL) + DO i3 = LBOUND(InData%PAngVelEL,3), UBOUND(InData%PAngVelEL,3) + DO i2 = LBOUND(InData%PAngVelEL,2), UBOUND(InData%PAngVelEL,2) + DO i1 = LBOUND(InData%PAngVelEL,1), UBOUND(InData%PAngVelEL,1) + ReKiBuf(Re_Xferred) = InData%PAngVelEL(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PAngVelEM) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11181,8 +10958,18 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEM,5) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PAngVelEM)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PAngVelEM))-1 ) = PACK(InData%PAngVelEM,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PAngVelEM) + DO i5 = LBOUND(InData%PAngVelEM,5), UBOUND(InData%PAngVelEM,5) + DO i4 = LBOUND(InData%PAngVelEM,4), UBOUND(InData%PAngVelEM,4) + DO i3 = LBOUND(InData%PAngVelEM,3), UBOUND(InData%PAngVelEM,3) + DO i2 = LBOUND(InData%PAngVelEM,2), UBOUND(InData%PAngVelEM,2) + DO i1 = LBOUND(InData%PAngVelEM,1), UBOUND(InData%PAngVelEM,1) + ReKiBuf(Re_Xferred) = InData%PAngVelEM(i1,i2,i3,i4,i5) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PAngVelEN) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11200,11 +10987,19 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEN,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PAngVelEN)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PAngVelEN))-1 ) = PACK(InData%PAngVelEN,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PAngVelEN) + DO i3 = LBOUND(InData%PAngVelEN,3), UBOUND(InData%PAngVelEN,3) + DO i2 = LBOUND(InData%PAngVelEN,2), UBOUND(InData%PAngVelEN,2) + DO i1 = LBOUND(InData%PAngVelEN,1), UBOUND(InData%PAngVelEN,1) + ReKiBuf(Re_Xferred) = InData%PAngVelEN(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngVelEA))-1 ) = PACK(InData%AngVelEA,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngVelEA) + DO i1 = LBOUND(InData%AngVelEA,1), UBOUND(InData%AngVelEA,1) + ReKiBuf(Re_Xferred) = InData%AngVelEA(i1) + Re_Xferred = Re_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%PAngVelEB) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -11221,8 +11016,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEB,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PAngVelEB)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PAngVelEB))-1 ) = PACK(InData%PAngVelEB,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PAngVelEB) + DO i3 = LBOUND(InData%PAngVelEB,3), UBOUND(InData%PAngVelEB,3) + DO i2 = LBOUND(InData%PAngVelEB,2), UBOUND(InData%PAngVelEB,2) + DO i1 = LBOUND(InData%PAngVelEB,1), UBOUND(InData%PAngVelEB,1) + ReKiBuf(Re_Xferred) = InData%PAngVelEB(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PAngVelER) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11240,8 +11041,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelER,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PAngVelER)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PAngVelER))-1 ) = PACK(InData%PAngVelER,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PAngVelER) + DO i3 = LBOUND(InData%PAngVelER,3), UBOUND(InData%PAngVelER,3) + DO i2 = LBOUND(InData%PAngVelER,2), UBOUND(InData%PAngVelER,2) + DO i1 = LBOUND(InData%PAngVelER,1), UBOUND(InData%PAngVelER,1) + ReKiBuf(Re_Xferred) = InData%PAngVelER(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PAngVelEX) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11259,31 +11066,57 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEX,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PAngVelEX)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PAngVelEX))-1 ) = PACK(InData%PAngVelEX,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PAngVelEX) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngVelEG))-1 ) = PACK(InData%AngVelEG,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngVelEG) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngVelEH))-1 ) = PACK(InData%AngVelEH,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngVelEH) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngVelEL))-1 ) = PACK(InData%AngVelEL,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngVelEL) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngVelEN))-1 ) = PACK(InData%AngVelEN,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngVelEN) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngVelEB))-1 ) = PACK(InData%AngVelEB,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngVelEB) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngVelER))-1 ) = PACK(InData%AngVelER,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngVelER) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngVelEX))-1 ) = PACK(InData%AngVelEX,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngVelEX) - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TeetAngVel - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngAccEBt))-1 ) = PACK(InData%AngAccEBt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngAccEBt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngAccERt))-1 ) = PACK(InData%AngAccERt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngAccERt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngAccEXt))-1 ) = PACK(InData%AngAccEXt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngAccEXt) + DO i3 = LBOUND(InData%PAngVelEX,3), UBOUND(InData%PAngVelEX,3) + DO i2 = LBOUND(InData%PAngVelEX,2), UBOUND(InData%PAngVelEX,2) + DO i1 = LBOUND(InData%PAngVelEX,1), UBOUND(InData%PAngVelEX,1) + ReKiBuf(Re_Xferred) = InData%PAngVelEX(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + DO i1 = LBOUND(InData%AngVelEG,1), UBOUND(InData%AngVelEG,1) + ReKiBuf(Re_Xferred) = InData%AngVelEG(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%AngVelEH,1), UBOUND(InData%AngVelEH,1) + ReKiBuf(Re_Xferred) = InData%AngVelEH(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%AngVelEL,1), UBOUND(InData%AngVelEL,1) + ReKiBuf(Re_Xferred) = InData%AngVelEL(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%AngVelEN,1), UBOUND(InData%AngVelEN,1) + ReKiBuf(Re_Xferred) = InData%AngVelEN(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%AngVelEB,1), UBOUND(InData%AngVelEB,1) + ReKiBuf(Re_Xferred) = InData%AngVelEB(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%AngVelER,1), UBOUND(InData%AngVelER,1) + ReKiBuf(Re_Xferred) = InData%AngVelER(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%AngVelEX,1), UBOUND(InData%AngVelEX,1) + ReKiBuf(Re_Xferred) = InData%AngVelEX(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DbKiBuf(Db_Xferred) = InData%TeetAngVel + Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(InData%AngAccEBt,1), UBOUND(InData%AngAccEBt,1) + ReKiBuf(Re_Xferred) = InData%AngAccEBt(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%AngAccERt,1), UBOUND(InData%AngAccERt,1) + ReKiBuf(Re_Xferred) = InData%AngAccERt(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%AngAccEXt,1), UBOUND(InData%AngAccEXt,1) + ReKiBuf(Re_Xferred) = InData%AngAccEXt(i1) + Re_Xferred = Re_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%AngAccEFt) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -11297,8 +11130,12 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngAccEFt,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AngAccEFt)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngAccEFt))-1 ) = PACK(InData%AngAccEFt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngAccEFt) + DO i2 = LBOUND(InData%AngAccEFt,2), UBOUND(InData%AngAccEFt,2) + DO i1 = LBOUND(InData%AngAccEFt,1), UBOUND(InData%AngAccEFt,1) + ReKiBuf(Re_Xferred) = InData%AngAccEFt(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%AngVelEF) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11313,29 +11150,53 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngVelEF,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AngVelEF)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngVelEF))-1 ) = PACK(InData%AngVelEF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngVelEF) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngAccEAt))-1 ) = PACK(InData%AngAccEAt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngAccEAt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngAccEGt))-1 ) = PACK(InData%AngAccEGt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngAccEGt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngAccEHt))-1 ) = PACK(InData%AngAccEHt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngAccEHt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngAccENt))-1 ) = PACK(InData%AngAccENt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngAccENt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LinAccECt))-1 ) = PACK(InData%LinAccECt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LinAccECt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LinAccEDt))-1 ) = PACK(InData%LinAccEDt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LinAccEDt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LinAccEIt))-1 ) = PACK(InData%LinAccEIt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LinAccEIt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LinAccEJt))-1 ) = PACK(InData%LinAccEJt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LinAccEJt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LinAccEUt))-1 ) = PACK(InData%LinAccEUt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LinAccEUt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LinAccEYt))-1 ) = PACK(InData%LinAccEYt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LinAccEYt) + DO i2 = LBOUND(InData%AngVelEF,2), UBOUND(InData%AngVelEF,2) + DO i1 = LBOUND(InData%AngVelEF,1), UBOUND(InData%AngVelEF,1) + ReKiBuf(Re_Xferred) = InData%AngVelEF(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + DO i1 = LBOUND(InData%AngAccEAt,1), UBOUND(InData%AngAccEAt,1) + ReKiBuf(Re_Xferred) = InData%AngAccEAt(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%AngAccEGt,1), UBOUND(InData%AngAccEGt,1) + ReKiBuf(Re_Xferred) = InData%AngAccEGt(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%AngAccEHt,1), UBOUND(InData%AngAccEHt,1) + ReKiBuf(Re_Xferred) = InData%AngAccEHt(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%AngAccENt,1), UBOUND(InData%AngAccENt,1) + ReKiBuf(Re_Xferred) = InData%AngAccENt(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%LinAccECt,1), UBOUND(InData%LinAccECt,1) + ReKiBuf(Re_Xferred) = InData%LinAccECt(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%LinAccEDt,1), UBOUND(InData%LinAccEDt,1) + ReKiBuf(Re_Xferred) = InData%LinAccEDt(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%LinAccEIt,1), UBOUND(InData%LinAccEIt,1) + ReKiBuf(Re_Xferred) = InData%LinAccEIt(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%LinAccEJt,1), UBOUND(InData%LinAccEJt,1) + ReKiBuf(Re_Xferred) = InData%LinAccEJt(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%LinAccEUt,1), UBOUND(InData%LinAccEUt,1) + ReKiBuf(Re_Xferred) = InData%LinAccEUt(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%LinAccEYt,1), UBOUND(InData%LinAccEYt,1) + ReKiBuf(Re_Xferred) = InData%LinAccEYt(i1) + Re_Xferred = Re_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%LinVelES) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -11352,11 +11213,19 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinVelES,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LinVelES)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LinVelES))-1 ) = PACK(InData%LinVelES,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LinVelES) + DO i3 = LBOUND(InData%LinVelES,3), UBOUND(InData%LinVelES,3) + DO i2 = LBOUND(InData%LinVelES,2), UBOUND(InData%LinVelES,2) + DO i1 = LBOUND(InData%LinVelES,1), UBOUND(InData%LinVelES,1) + ReKiBuf(Re_Xferred) = InData%LinVelES(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LinVelEQ))-1 ) = PACK(InData%LinVelEQ,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LinVelEQ) + DO i1 = LBOUND(InData%LinVelEQ,1), UBOUND(InData%LinVelEQ,1) + ReKiBuf(Re_Xferred) = InData%LinVelEQ(i1) + Re_Xferred = Re_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%LinVelET) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -11370,8 +11239,12 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinVelET,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LinVelET)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LinVelET))-1 ) = PACK(InData%LinVelET,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LinVelET) + DO i2 = LBOUND(InData%LinVelET,2), UBOUND(InData%LinVelET,2) + DO i1 = LBOUND(InData%LinVelET,1), UBOUND(InData%LinVelET,1) + ReKiBuf(Re_Xferred) = InData%LinVelET(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%LinVelESm2) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11383,8 +11256,10 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinVelESm2,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LinVelESm2)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LinVelESm2))-1 ) = PACK(InData%LinVelESm2,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LinVelESm2) + DO i1 = LBOUND(InData%LinVelESm2,1), UBOUND(InData%LinVelESm2,1) + ReKiBuf(Re_Xferred) = InData%LinVelESm2(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%PLinVelEIMU) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11402,8 +11277,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEIMU,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PLinVelEIMU)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PLinVelEIMU))-1 ) = PACK(InData%PLinVelEIMU,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PLinVelEIMU) + DO i3 = LBOUND(InData%PLinVelEIMU,3), UBOUND(InData%PLinVelEIMU,3) + DO i2 = LBOUND(InData%PLinVelEIMU,2), UBOUND(InData%PLinVelEIMU,2) + DO i1 = LBOUND(InData%PLinVelEIMU,1), UBOUND(InData%PLinVelEIMU,1) + ReKiBuf(Re_Xferred) = InData%PLinVelEIMU(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PLinVelEO) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11421,8 +11302,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEO,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PLinVelEO)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PLinVelEO))-1 ) = PACK(InData%PLinVelEO,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PLinVelEO) + DO i3 = LBOUND(InData%PLinVelEO,3), UBOUND(InData%PLinVelEO,3) + DO i2 = LBOUND(InData%PLinVelEO,2), UBOUND(InData%PLinVelEO,2) + DO i1 = LBOUND(InData%PLinVelEO,1), UBOUND(InData%PLinVelEO,1) + ReKiBuf(Re_Xferred) = InData%PLinVelEO(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PLinVelES) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11446,8 +11333,18 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelES,5) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PLinVelES)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PLinVelES))-1 ) = PACK(InData%PLinVelES,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PLinVelES) + DO i5 = LBOUND(InData%PLinVelES,5), UBOUND(InData%PLinVelES,5) + DO i4 = LBOUND(InData%PLinVelES,4), UBOUND(InData%PLinVelES,4) + DO i3 = LBOUND(InData%PLinVelES,3), UBOUND(InData%PLinVelES,3) + DO i2 = LBOUND(InData%PLinVelES,2), UBOUND(InData%PLinVelES,2) + DO i1 = LBOUND(InData%PLinVelES,1), UBOUND(InData%PLinVelES,1) + ReKiBuf(Re_Xferred) = InData%PLinVelES(i1,i2,i3,i4,i5) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PLinVelET) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11468,8 +11365,16 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelET,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PLinVelET)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PLinVelET))-1 ) = PACK(InData%PLinVelET,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PLinVelET) + DO i4 = LBOUND(InData%PLinVelET,4), UBOUND(InData%PLinVelET,4) + DO i3 = LBOUND(InData%PLinVelET,3), UBOUND(InData%PLinVelET,3) + DO i2 = LBOUND(InData%PLinVelET,2), UBOUND(InData%PLinVelET,2) + DO i1 = LBOUND(InData%PLinVelET,1), UBOUND(InData%PLinVelET,1) + ReKiBuf(Re_Xferred) = InData%PLinVelET(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PLinVelEZ) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11487,8 +11392,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEZ,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PLinVelEZ)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PLinVelEZ))-1 ) = PACK(InData%PLinVelEZ,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PLinVelEZ) + DO i3 = LBOUND(InData%PLinVelEZ,3), UBOUND(InData%PLinVelEZ,3) + DO i2 = LBOUND(InData%PLinVelEZ,2), UBOUND(InData%PLinVelEZ,2) + DO i1 = LBOUND(InData%PLinVelEZ,1), UBOUND(InData%PLinVelEZ,1) + ReKiBuf(Re_Xferred) = InData%PLinVelEZ(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PLinVelEC) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11506,8 +11417,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEC,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PLinVelEC)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PLinVelEC))-1 ) = PACK(InData%PLinVelEC,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PLinVelEC) + DO i3 = LBOUND(InData%PLinVelEC,3), UBOUND(InData%PLinVelEC,3) + DO i2 = LBOUND(InData%PLinVelEC,2), UBOUND(InData%PLinVelEC,2) + DO i1 = LBOUND(InData%PLinVelEC,1), UBOUND(InData%PLinVelEC,1) + ReKiBuf(Re_Xferred) = InData%PLinVelEC(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PLinVelED) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11525,8 +11442,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelED,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PLinVelED)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PLinVelED))-1 ) = PACK(InData%PLinVelED,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PLinVelED) + DO i3 = LBOUND(InData%PLinVelED,3), UBOUND(InData%PLinVelED,3) + DO i2 = LBOUND(InData%PLinVelED,2), UBOUND(InData%PLinVelED,2) + DO i1 = LBOUND(InData%PLinVelED,1), UBOUND(InData%PLinVelED,1) + ReKiBuf(Re_Xferred) = InData%PLinVelED(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PLinVelEI) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11544,8 +11467,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEI,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PLinVelEI)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PLinVelEI))-1 ) = PACK(InData%PLinVelEI,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PLinVelEI) + DO i3 = LBOUND(InData%PLinVelEI,3), UBOUND(InData%PLinVelEI,3) + DO i2 = LBOUND(InData%PLinVelEI,2), UBOUND(InData%PLinVelEI,2) + DO i1 = LBOUND(InData%PLinVelEI,1), UBOUND(InData%PLinVelEI,1) + ReKiBuf(Re_Xferred) = InData%PLinVelEI(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PLinVelEJ) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11563,8 +11492,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEJ,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PLinVelEJ)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PLinVelEJ))-1 ) = PACK(InData%PLinVelEJ,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PLinVelEJ) + DO i3 = LBOUND(InData%PLinVelEJ,3), UBOUND(InData%PLinVelEJ,3) + DO i2 = LBOUND(InData%PLinVelEJ,2), UBOUND(InData%PLinVelEJ,2) + DO i1 = LBOUND(InData%PLinVelEJ,1), UBOUND(InData%PLinVelEJ,1) + ReKiBuf(Re_Xferred) = InData%PLinVelEJ(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PLinVelEK) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11582,8 +11517,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEK,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PLinVelEK)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PLinVelEK))-1 ) = PACK(InData%PLinVelEK,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PLinVelEK) + DO i3 = LBOUND(InData%PLinVelEK,3), UBOUND(InData%PLinVelEK,3) + DO i2 = LBOUND(InData%PLinVelEK,2), UBOUND(InData%PLinVelEK,2) + DO i1 = LBOUND(InData%PLinVelEK,1), UBOUND(InData%PLinVelEK,1) + ReKiBuf(Re_Xferred) = InData%PLinVelEK(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PLinVelEP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11601,8 +11542,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEP,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PLinVelEP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PLinVelEP))-1 ) = PACK(InData%PLinVelEP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PLinVelEP) + DO i3 = LBOUND(InData%PLinVelEP,3), UBOUND(InData%PLinVelEP,3) + DO i2 = LBOUND(InData%PLinVelEP,2), UBOUND(InData%PLinVelEP,2) + DO i1 = LBOUND(InData%PLinVelEP,1), UBOUND(InData%PLinVelEP,1) + ReKiBuf(Re_Xferred) = InData%PLinVelEP(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PLinVelEQ) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11620,8 +11567,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEQ,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PLinVelEQ)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PLinVelEQ))-1 ) = PACK(InData%PLinVelEQ,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PLinVelEQ) + DO i3 = LBOUND(InData%PLinVelEQ,3), UBOUND(InData%PLinVelEQ,3) + DO i2 = LBOUND(InData%PLinVelEQ,2), UBOUND(InData%PLinVelEQ,2) + DO i1 = LBOUND(InData%PLinVelEQ,1), UBOUND(InData%PLinVelEQ,1) + ReKiBuf(Re_Xferred) = InData%PLinVelEQ(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PLinVelEU) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11639,8 +11592,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEU,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PLinVelEU)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PLinVelEU))-1 ) = PACK(InData%PLinVelEU,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PLinVelEU) + DO i3 = LBOUND(InData%PLinVelEU,3), UBOUND(InData%PLinVelEU,3) + DO i2 = LBOUND(InData%PLinVelEU,2), UBOUND(InData%PLinVelEU,2) + DO i1 = LBOUND(InData%PLinVelEU,1), UBOUND(InData%PLinVelEU,1) + ReKiBuf(Re_Xferred) = InData%PLinVelEU(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PLinVelEV) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11658,8 +11617,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEV,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PLinVelEV)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PLinVelEV))-1 ) = PACK(InData%PLinVelEV,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PLinVelEV) + DO i3 = LBOUND(InData%PLinVelEV,3), UBOUND(InData%PLinVelEV,3) + DO i2 = LBOUND(InData%PLinVelEV,2), UBOUND(InData%PLinVelEV,2) + DO i1 = LBOUND(InData%PLinVelEV,1), UBOUND(InData%PLinVelEV,1) + ReKiBuf(Re_Xferred) = InData%PLinVelEV(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PLinVelEW) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11677,8 +11642,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEW,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PLinVelEW)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PLinVelEW))-1 ) = PACK(InData%PLinVelEW,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PLinVelEW) + DO i3 = LBOUND(InData%PLinVelEW,3), UBOUND(InData%PLinVelEW,3) + DO i2 = LBOUND(InData%PLinVelEW,2), UBOUND(InData%PLinVelEW,2) + DO i1 = LBOUND(InData%PLinVelEW,1), UBOUND(InData%PLinVelEW,1) + ReKiBuf(Re_Xferred) = InData%PLinVelEW(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PLinVelEY) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11696,13 +11667,23 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEY,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PLinVelEY)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PLinVelEY))-1 ) = PACK(InData%PLinVelEY,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PLinVelEY) + DO i3 = LBOUND(InData%PLinVelEY,3), UBOUND(InData%PLinVelEY,3) + DO i2 = LBOUND(InData%PLinVelEY,2), UBOUND(InData%PLinVelEY,2) + DO i1 = LBOUND(InData%PLinVelEY,1), UBOUND(InData%PLinVelEY,1) + ReKiBuf(Re_Xferred) = InData%PLinVelEY(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LinAccEIMUt))-1 ) = PACK(InData%LinAccEIMUt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LinAccEIMUt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LinAccEOt))-1 ) = PACK(InData%LinAccEOt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LinAccEOt) + DO i1 = LBOUND(InData%LinAccEIMUt,1), UBOUND(InData%LinAccEIMUt,1) + ReKiBuf(Re_Xferred) = InData%LinAccEIMUt(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%LinAccEOt,1), UBOUND(InData%LinAccEOt,1) + ReKiBuf(Re_Xferred) = InData%LinAccEOt(i1) + Re_Xferred = Re_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%LinAccESt) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -11719,8 +11700,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinAccESt,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LinAccESt)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LinAccESt))-1 ) = PACK(InData%LinAccESt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LinAccESt) + DO i3 = LBOUND(InData%LinAccESt,3), UBOUND(InData%LinAccESt,3) + DO i2 = LBOUND(InData%LinAccESt,2), UBOUND(InData%LinAccESt,2) + DO i1 = LBOUND(InData%LinAccESt,1), UBOUND(InData%LinAccESt,1) + ReKiBuf(Re_Xferred) = InData%LinAccESt(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%LinAccETt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11735,21 +11722,37 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinAccETt,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LinAccETt)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LinAccETt))-1 ) = PACK(InData%LinAccETt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LinAccETt) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LinAccEZt))-1 ) = PACK(InData%LinAccEZt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LinAccEZt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LinVelEIMU))-1 ) = PACK(InData%LinVelEIMU,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LinVelEIMU) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LinVelEZ))-1 ) = PACK(InData%LinVelEZ,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LinVelEZ) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LinVelEO))-1 ) = PACK(InData%LinVelEO,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LinVelEO) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FrcONcRtt))-1 ) = PACK(InData%FrcONcRtt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FrcONcRtt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FrcPRott))-1 ) = PACK(InData%FrcPRott,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FrcPRott) + DO i2 = LBOUND(InData%LinAccETt,2), UBOUND(InData%LinAccETt,2) + DO i1 = LBOUND(InData%LinAccETt,1), UBOUND(InData%LinAccETt,1) + ReKiBuf(Re_Xferred) = InData%LinAccETt(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + DO i1 = LBOUND(InData%LinAccEZt,1), UBOUND(InData%LinAccEZt,1) + ReKiBuf(Re_Xferred) = InData%LinAccEZt(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%LinVelEIMU,1), UBOUND(InData%LinVelEIMU,1) + ReKiBuf(Re_Xferred) = InData%LinVelEIMU(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%LinVelEZ,1), UBOUND(InData%LinVelEZ,1) + ReKiBuf(Re_Xferred) = InData%LinVelEZ(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%LinVelEO,1), UBOUND(InData%LinVelEO,1) + ReKiBuf(Re_Xferred) = InData%LinVelEO(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%FrcONcRtt,1), UBOUND(InData%FrcONcRtt,1) + ReKiBuf(Re_Xferred) = InData%FrcONcRtt(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%FrcPRott,1), UBOUND(InData%FrcPRott,1) + ReKiBuf(Re_Xferred) = InData%FrcPRott(i1) + Re_Xferred = Re_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%FrcS0Bt) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -11763,11 +11766,17 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FrcS0Bt,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FrcS0Bt)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FrcS0Bt))-1 ) = PACK(InData%FrcS0Bt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FrcS0Bt) + DO i2 = LBOUND(InData%FrcS0Bt,2), UBOUND(InData%FrcS0Bt,2) + DO i1 = LBOUND(InData%FrcS0Bt,1), UBOUND(InData%FrcS0Bt,1) + ReKiBuf(Re_Xferred) = InData%FrcS0Bt(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FrcT0Trbt))-1 ) = PACK(InData%FrcT0Trbt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FrcT0Trbt) + DO i1 = LBOUND(InData%FrcT0Trbt,1), UBOUND(InData%FrcT0Trbt,1) + ReKiBuf(Re_Xferred) = InData%FrcT0Trbt(i1) + Re_Xferred = Re_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%FSAero) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -11784,8 +11793,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FSAero,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FSAero)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FSAero))-1 ) = PACK(InData%FSAero,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FSAero) + DO i3 = LBOUND(InData%FSAero,3), UBOUND(InData%FSAero,3) + DO i2 = LBOUND(InData%FSAero,2), UBOUND(InData%FSAero,2) + DO i1 = LBOUND(InData%FSAero,1), UBOUND(InData%FSAero,1) + ReKiBuf(Re_Xferred) = InData%FSAero(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FSTipDrag) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11800,8 +11815,12 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FSTipDrag,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FSTipDrag)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FSTipDrag))-1 ) = PACK(InData%FSTipDrag,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FSTipDrag) + DO i2 = LBOUND(InData%FSTipDrag,2), UBOUND(InData%FSTipDrag,2) + DO i1 = LBOUND(InData%FSTipDrag,1), UBOUND(InData%FSTipDrag,1) + ReKiBuf(Re_Xferred) = InData%FSTipDrag(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FTHydrot) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11816,11 +11835,17 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FTHydrot,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FTHydrot)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FTHydrot))-1 ) = PACK(InData%FTHydrot,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FTHydrot) + DO i2 = LBOUND(InData%FTHydrot,2), UBOUND(InData%FTHydrot,2) + DO i1 = LBOUND(InData%FTHydrot,1), UBOUND(InData%FTHydrot,1) + ReKiBuf(Re_Xferred) = InData%FTHydrot(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FZHydrot))-1 ) = PACK(InData%FZHydrot,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FZHydrot) + DO i1 = LBOUND(InData%FZHydrot,1), UBOUND(InData%FZHydrot,1) + ReKiBuf(Re_Xferred) = InData%FZHydrot(i1) + Re_Xferred = Re_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%MFHydrot) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -11834,11 +11859,17 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MFHydrot,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%MFHydrot)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MFHydrot))-1 ) = PACK(InData%MFHydrot,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MFHydrot) + DO i2 = LBOUND(InData%MFHydrot,2), UBOUND(InData%MFHydrot,2) + DO i1 = LBOUND(InData%MFHydrot,1), UBOUND(InData%MFHydrot,1) + ReKiBuf(Re_Xferred) = InData%MFHydrot(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MomBNcRtt))-1 ) = PACK(InData%MomBNcRtt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MomBNcRtt) + DO i1 = LBOUND(InData%MomBNcRtt,1), UBOUND(InData%MomBNcRtt,1) + ReKiBuf(Re_Xferred) = InData%MomBNcRtt(i1) + Re_Xferred = Re_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%MomH0Bt) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -11852,17 +11883,29 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MomH0Bt,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%MomH0Bt)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MomH0Bt))-1 ) = PACK(InData%MomH0Bt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MomH0Bt) + DO i2 = LBOUND(InData%MomH0Bt,2), UBOUND(InData%MomH0Bt,2) + DO i1 = LBOUND(InData%MomH0Bt,1), UBOUND(InData%MomH0Bt,1) + ReKiBuf(Re_Xferred) = InData%MomH0Bt(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MomLPRott))-1 ) = PACK(InData%MomLPRott,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MomLPRott) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MomNGnRtt))-1 ) = PACK(InData%MomNGnRtt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MomNGnRtt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MomNTailt))-1 ) = PACK(InData%MomNTailt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MomNTailt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MomX0Trbt))-1 ) = PACK(InData%MomX0Trbt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MomX0Trbt) + DO i1 = LBOUND(InData%MomLPRott,1), UBOUND(InData%MomLPRott,1) + ReKiBuf(Re_Xferred) = InData%MomLPRott(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%MomNGnRtt,1), UBOUND(InData%MomNGnRtt,1) + ReKiBuf(Re_Xferred) = InData%MomNGnRtt(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%MomNTailt,1), UBOUND(InData%MomNTailt,1) + ReKiBuf(Re_Xferred) = InData%MomNTailt(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%MomX0Trbt,1), UBOUND(InData%MomX0Trbt,1) + ReKiBuf(Re_Xferred) = InData%MomX0Trbt(i1) + Re_Xferred = Re_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%MMAero) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -11879,11 +11922,19 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MMAero,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%MMAero)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MMAero))-1 ) = PACK(InData%MMAero,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MMAero) + DO i3 = LBOUND(InData%MMAero,3), UBOUND(InData%MMAero,3) + DO i2 = LBOUND(InData%MMAero,2), UBOUND(InData%MMAero,2) + DO i1 = LBOUND(InData%MMAero,1), UBOUND(InData%MMAero,1) + ReKiBuf(Re_Xferred) = InData%MMAero(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MXHydrot))-1 ) = PACK(InData%MXHydrot,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MXHydrot) + DO i1 = LBOUND(InData%MXHydrot,1), UBOUND(InData%MXHydrot,1) + ReKiBuf(Re_Xferred) = InData%MXHydrot(i1) + Re_Xferred = Re_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%PFrcONcRt) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -11897,8 +11948,12 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcONcRt,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PFrcONcRt)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PFrcONcRt))-1 ) = PACK(InData%PFrcONcRt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PFrcONcRt) + DO i2 = LBOUND(InData%PFrcONcRt,2), UBOUND(InData%PFrcONcRt,2) + DO i1 = LBOUND(InData%PFrcONcRt,1), UBOUND(InData%PFrcONcRt,1) + ReKiBuf(Re_Xferred) = InData%PFrcONcRt(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PFrcPRot) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11913,8 +11968,12 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcPRot,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PFrcPRot)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PFrcPRot))-1 ) = PACK(InData%PFrcPRot,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PFrcPRot) + DO i2 = LBOUND(InData%PFrcPRot,2), UBOUND(InData%PFrcPRot,2) + DO i1 = LBOUND(InData%PFrcPRot,1), UBOUND(InData%PFrcPRot,1) + ReKiBuf(Re_Xferred) = InData%PFrcPRot(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PFrcS0B) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11932,8 +11991,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcS0B,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PFrcS0B)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PFrcS0B))-1 ) = PACK(InData%PFrcS0B,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PFrcS0B) + DO i3 = LBOUND(InData%PFrcS0B,3), UBOUND(InData%PFrcS0B,3) + DO i2 = LBOUND(InData%PFrcS0B,2), UBOUND(InData%PFrcS0B,2) + DO i1 = LBOUND(InData%PFrcS0B,1), UBOUND(InData%PFrcS0B,1) + ReKiBuf(Re_Xferred) = InData%PFrcS0B(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PFrcT0Trb) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11948,8 +12013,12 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcT0Trb,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PFrcT0Trb)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PFrcT0Trb))-1 ) = PACK(InData%PFrcT0Trb,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PFrcT0Trb) + DO i2 = LBOUND(InData%PFrcT0Trb,2), UBOUND(InData%PFrcT0Trb,2) + DO i1 = LBOUND(InData%PFrcT0Trb,1), UBOUND(InData%PFrcT0Trb,1) + ReKiBuf(Re_Xferred) = InData%PFrcT0Trb(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PFTHydro) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11967,11 +12036,21 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFTHydro,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PFTHydro)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PFTHydro))-1 ) = PACK(InData%PFTHydro,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PFTHydro) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PFZHydro))-1 ) = PACK(InData%PFZHydro,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PFZHydro) + DO i3 = LBOUND(InData%PFTHydro,3), UBOUND(InData%PFTHydro,3) + DO i2 = LBOUND(InData%PFTHydro,2), UBOUND(InData%PFTHydro,2) + DO i1 = LBOUND(InData%PFTHydro,1), UBOUND(InData%PFTHydro,1) + ReKiBuf(Re_Xferred) = InData%PFTHydro(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + DO i2 = LBOUND(InData%PFZHydro,2), UBOUND(InData%PFZHydro,2) + DO i1 = LBOUND(InData%PFZHydro,1), UBOUND(InData%PFZHydro,1) + ReKiBuf(Re_Xferred) = InData%PFZHydro(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO IF ( .NOT. ALLOCATED(InData%PMFHydro) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -11988,8 +12067,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMFHydro,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PMFHydro)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PMFHydro))-1 ) = PACK(InData%PMFHydro,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PMFHydro) + DO i3 = LBOUND(InData%PMFHydro,3), UBOUND(InData%PMFHydro,3) + DO i2 = LBOUND(InData%PMFHydro,2), UBOUND(InData%PMFHydro,2) + DO i1 = LBOUND(InData%PMFHydro,1), UBOUND(InData%PMFHydro,1) + ReKiBuf(Re_Xferred) = InData%PMFHydro(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PMomBNcRt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -12004,8 +12089,12 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomBNcRt,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PMomBNcRt)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PMomBNcRt))-1 ) = PACK(InData%PMomBNcRt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PMomBNcRt) + DO i2 = LBOUND(InData%PMomBNcRt,2), UBOUND(InData%PMomBNcRt,2) + DO i1 = LBOUND(InData%PMomBNcRt,1), UBOUND(InData%PMomBNcRt,1) + ReKiBuf(Re_Xferred) = InData%PMomBNcRt(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PMomH0B) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -12023,8 +12112,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomH0B,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PMomH0B)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PMomH0B))-1 ) = PACK(InData%PMomH0B,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PMomH0B) + DO i3 = LBOUND(InData%PMomH0B,3), UBOUND(InData%PMomH0B,3) + DO i2 = LBOUND(InData%PMomH0B,2), UBOUND(InData%PMomH0B,2) + DO i1 = LBOUND(InData%PMomH0B,1), UBOUND(InData%PMomH0B,1) + ReKiBuf(Re_Xferred) = InData%PMomH0B(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PMomLPRot) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -12039,8 +12134,12 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomLPRot,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PMomLPRot)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PMomLPRot))-1 ) = PACK(InData%PMomLPRot,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PMomLPRot) + DO i2 = LBOUND(InData%PMomLPRot,2), UBOUND(InData%PMomLPRot,2) + DO i1 = LBOUND(InData%PMomLPRot,1), UBOUND(InData%PMomLPRot,1) + ReKiBuf(Re_Xferred) = InData%PMomLPRot(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PMomNGnRt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -12055,8 +12154,12 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomNGnRt,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PMomNGnRt)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PMomNGnRt))-1 ) = PACK(InData%PMomNGnRt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PMomNGnRt) + DO i2 = LBOUND(InData%PMomNGnRt,2), UBOUND(InData%PMomNGnRt,2) + DO i1 = LBOUND(InData%PMomNGnRt,1), UBOUND(InData%PMomNGnRt,1) + ReKiBuf(Re_Xferred) = InData%PMomNGnRt(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PMomNTail) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -12071,8 +12174,12 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomNTail,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PMomNTail)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PMomNTail))-1 ) = PACK(InData%PMomNTail,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PMomNTail) + DO i2 = LBOUND(InData%PMomNTail,2), UBOUND(InData%PMomNTail,2) + DO i1 = LBOUND(InData%PMomNTail,1), UBOUND(InData%PMomNTail,1) + ReKiBuf(Re_Xferred) = InData%PMomNTail(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PMomX0Trb) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -12087,21 +12194,37 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomX0Trb,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PMomX0Trb)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PMomX0Trb))-1 ) = PACK(InData%PMomX0Trb,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PMomX0Trb) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PMXHydro))-1 ) = PACK(InData%PMXHydro,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PMXHydro) - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TeetAng - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FrcVGnRtt))-1 ) = PACK(InData%FrcVGnRtt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FrcVGnRtt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FrcWTailt))-1 ) = PACK(InData%FrcWTailt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FrcWTailt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FrcZAllt))-1 ) = PACK(InData%FrcZAllt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FrcZAllt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MomXAllt))-1 ) = PACK(InData%MomXAllt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MomXAllt) + DO i2 = LBOUND(InData%PMomX0Trb,2), UBOUND(InData%PMomX0Trb,2) + DO i1 = LBOUND(InData%PMomX0Trb,1), UBOUND(InData%PMomX0Trb,1) + ReKiBuf(Re_Xferred) = InData%PMomX0Trb(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + DO i2 = LBOUND(InData%PMXHydro,2), UBOUND(InData%PMXHydro,2) + DO i1 = LBOUND(InData%PMXHydro,1), UBOUND(InData%PMXHydro,1) + ReKiBuf(Re_Xferred) = InData%PMXHydro(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DbKiBuf(Db_Xferred) = InData%TeetAng + Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(InData%FrcVGnRtt,1), UBOUND(InData%FrcVGnRtt,1) + ReKiBuf(Re_Xferred) = InData%FrcVGnRtt(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%FrcWTailt,1), UBOUND(InData%FrcWTailt,1) + ReKiBuf(Re_Xferred) = InData%FrcWTailt(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%FrcZAllt,1), UBOUND(InData%FrcZAllt,1) + ReKiBuf(Re_Xferred) = InData%FrcZAllt(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%MomXAllt,1), UBOUND(InData%MomXAllt,1) + ReKiBuf(Re_Xferred) = InData%MomXAllt(i1) + Re_Xferred = Re_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%PFrcVGnRt) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -12115,8 +12238,12 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcVGnRt,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PFrcVGnRt)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PFrcVGnRt))-1 ) = PACK(InData%PFrcVGnRt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PFrcVGnRt) + DO i2 = LBOUND(InData%PFrcVGnRt,2), UBOUND(InData%PFrcVGnRt,2) + DO i1 = LBOUND(InData%PFrcVGnRt,1), UBOUND(InData%PFrcVGnRt,1) + ReKiBuf(Re_Xferred) = InData%PFrcVGnRt(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PFrcWTail) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -12131,8 +12258,12 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcWTail,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PFrcWTail)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PFrcWTail))-1 ) = PACK(InData%PFrcWTail,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PFrcWTail) + DO i2 = LBOUND(InData%PFrcWTail,2), UBOUND(InData%PFrcWTail,2) + DO i1 = LBOUND(InData%PFrcWTail,1), UBOUND(InData%PFrcWTail,1) + ReKiBuf(Re_Xferred) = InData%PFrcWTail(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PFrcZAll) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -12147,8 +12278,12 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcZAll,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PFrcZAll)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PFrcZAll))-1 ) = PACK(InData%PFrcZAll,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PFrcZAll) + DO i2 = LBOUND(InData%PFrcZAll,2), UBOUND(InData%PFrcZAll,2) + DO i1 = LBOUND(InData%PFrcZAll,1), UBOUND(InData%PFrcZAll,1) + ReKiBuf(Re_Xferred) = InData%PFrcZAll(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PMomXAll) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -12163,17 +12298,21 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomXAll,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PMomXAll)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PMomXAll))-1 ) = PACK(InData%PMomXAll,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PMomXAll) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TeetMom - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlMom - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlMom - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GBoxEffFac - Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(InData%PMomXAll,2), UBOUND(InData%PMomXAll,2) + DO i1 = LBOUND(InData%PMomXAll,1), UBOUND(InData%PMomXAll,1) + ReKiBuf(Re_Xferred) = InData%PMomXAll(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + ReKiBuf(Re_Xferred) = InData%TeetMom + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlMom + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlMom + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GBoxEffFac + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%rSAerCen) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -12190,8 +12329,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rSAerCen,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rSAerCen)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%rSAerCen))-1 ) = PACK(InData%rSAerCen,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%rSAerCen) + DO i3 = LBOUND(InData%rSAerCen,3), UBOUND(InData%rSAerCen,3) + DO i2 = LBOUND(InData%rSAerCen,2), UBOUND(InData%rSAerCen,2) + DO i1 = LBOUND(InData%rSAerCen,1), UBOUND(InData%rSAerCen,1) + ReKiBuf(Re_Xferred) = InData%rSAerCen(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF END SUBROUTINE ED_PackRtHndSide @@ -12208,12 +12353,6 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -12234,15 +12373,10 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Int_Xferred = 1 i1_l = LBOUND(OutData%rO,1) i1_u = UBOUND(OutData%rO,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rO = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rO))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rO) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rO,1), UBOUND(OutData%rO,1) + OutData%rO(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rQS not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -12262,15 +12396,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rQS.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%rQS)>0) OutData%rQS = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rQS))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rQS) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%rQS,3), UBOUND(OutData%rQS,3) + DO i2 = LBOUND(OutData%rQS,2), UBOUND(OutData%rQS,2) + DO i1 = LBOUND(OutData%rQS,1), UBOUND(OutData%rQS,1) + OutData%rQS(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rS not allocated Int_Xferred = Int_Xferred + 1 @@ -12291,15 +12424,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rS.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%rS)>0) OutData%rS = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rS))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rS) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%rS,3), UBOUND(OutData%rS,3) + DO i2 = LBOUND(OutData%rS,2), UBOUND(OutData%rS,2) + DO i1 = LBOUND(OutData%rS,1), UBOUND(OutData%rS,1) + OutData%rS(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rS0S not allocated Int_Xferred = Int_Xferred + 1 @@ -12320,15 +12452,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rS0S.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%rS0S)>0) OutData%rS0S = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rS0S))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rS0S) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%rS0S,3), UBOUND(OutData%rS0S,3) + DO i2 = LBOUND(OutData%rS0S,2), UBOUND(OutData%rS0S,2) + DO i1 = LBOUND(OutData%rS0S,1), UBOUND(OutData%rS0S,1) + OutData%rS0S(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rT not allocated Int_Xferred = Int_Xferred + 1 @@ -12346,27 +12477,19 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rT.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%rT)>0) OutData%rT = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rT))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rT) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%rT,2), UBOUND(OutData%rT,2) + DO i1 = LBOUND(OutData%rT,1), UBOUND(OutData%rT,1) + OutData%rT(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF i1_l = LBOUND(OutData%rT0O,1) i1_u = UBOUND(OutData%rT0O,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rT0O = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rT0O))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rT0O) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rT0O,1), UBOUND(OutData%rT0O,1) + OutData%rT0O(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rT0T not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -12383,38 +12506,25 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rT0T.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%rT0T)>0) OutData%rT0T = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rT0T))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rT0T) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%rT0T,2), UBOUND(OutData%rT0T,2) + DO i1 = LBOUND(OutData%rT0T,1), UBOUND(OutData%rT0T,1) + OutData%rT0T(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF i1_l = LBOUND(OutData%rZ,1) i1_u = UBOUND(OutData%rZ,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rZ = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rZ))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rZ) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rZ,1), UBOUND(OutData%rZ,1) + OutData%rZ(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%rZO,1) i1_u = UBOUND(OutData%rZO,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rZO = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rZO))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rZO) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rZO,1), UBOUND(OutData%rZO,1) + OutData%rZO(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rZT not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -12431,115 +12541,67 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rZT.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%rZT)>0) OutData%rZT = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rZT))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rZT) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%rZT,2), UBOUND(OutData%rZT,2) + DO i1 = LBOUND(OutData%rZT,1), UBOUND(OutData%rZT,1) + OutData%rZT(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF i1_l = LBOUND(OutData%rPQ,1) i1_u = UBOUND(OutData%rPQ,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rPQ = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rPQ))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rPQ) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rPQ,1), UBOUND(OutData%rPQ,1) + OutData%rPQ(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%rP,1) i1_u = UBOUND(OutData%rP,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rP = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rP))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rP) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rP,1), UBOUND(OutData%rP,1) + OutData%rP(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%rV,1) i1_u = UBOUND(OutData%rV,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rV = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rV))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rV) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rV,1), UBOUND(OutData%rV,1) + OutData%rV(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%rZY,1) i1_u = UBOUND(OutData%rZY,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rZY = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rZY))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rZY) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rZY,1), UBOUND(OutData%rZY,1) + OutData%rZY(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%rOU,1) i1_u = UBOUND(OutData%rOU,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rOU = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rOU))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rOU) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rOU,1), UBOUND(OutData%rOU,1) + OutData%rOU(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%rOV,1) i1_u = UBOUND(OutData%rOV,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rOV = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rOV))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rOV) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rOV,1), UBOUND(OutData%rOV,1) + OutData%rOV(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%rVD,1) i1_u = UBOUND(OutData%rVD,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rVD = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rVD))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rVD) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rVD,1), UBOUND(OutData%rVD,1) + OutData%rVD(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%rOW,1) i1_u = UBOUND(OutData%rOW,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rOW = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rOW))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rOW) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rOW,1), UBOUND(OutData%rOW,1) + OutData%rOW(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%rPC,1) i1_u = UBOUND(OutData%rPC,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rPC = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rPC))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rPC) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rPC,1), UBOUND(OutData%rPC,1) + OutData%rPC(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rPS0 not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -12556,104 +12618,61 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rPS0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%rPS0)>0) OutData%rPS0 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rPS0))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rPS0) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%rPS0,2), UBOUND(OutData%rPS0,2) + DO i1 = LBOUND(OutData%rPS0,1), UBOUND(OutData%rPS0,1) + OutData%rPS0(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF i1_l = LBOUND(OutData%rQ,1) i1_u = UBOUND(OutData%rQ,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rQ = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rQ))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rQ) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rQ,1), UBOUND(OutData%rQ,1) + OutData%rQ(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%rQC,1) i1_u = UBOUND(OutData%rQC,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rQC = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rQC))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rQC) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rQC,1), UBOUND(OutData%rQC,1) + OutData%rQC(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%rVIMU,1) i1_u = UBOUND(OutData%rVIMU,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rVIMU = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rVIMU))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rVIMU) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rVIMU,1), UBOUND(OutData%rVIMU,1) + OutData%rVIMU(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%rVP,1) i1_u = UBOUND(OutData%rVP,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rVP = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rVP))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rVP) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rVP,1), UBOUND(OutData%rVP,1) + OutData%rVP(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%rWI,1) i1_u = UBOUND(OutData%rWI,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rWI = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rWI))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rWI) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rWI,1), UBOUND(OutData%rWI,1) + OutData%rWI(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%rWJ,1) i1_u = UBOUND(OutData%rWJ,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rWJ = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rWJ))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rWJ) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rWJ,1), UBOUND(OutData%rWJ,1) + OutData%rWJ(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%rWK,1) i1_u = UBOUND(OutData%rWK,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rWK = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rWK))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rWK) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rWK,1), UBOUND(OutData%rWK,1) + OutData%rWK(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%rZT0,1) i1_u = UBOUND(OutData%rZT0,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rZT0 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rZT0))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rZT0) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rZT0,1), UBOUND(OutData%rZT0,1) + OutData%rZT0(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AngPosEF not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -12670,15 +12689,12 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngPosEF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%AngPosEF)>0) OutData%AngPosEF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngPosEF))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngPosEF) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AngPosEF,2), UBOUND(OutData%AngPosEF,2) + DO i1 = LBOUND(OutData%AngPosEF,1), UBOUND(OutData%AngPosEF,1) + OutData%AngPosEF(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AngPosXF not allocated Int_Xferred = Int_Xferred + 1 @@ -12696,15 +12712,12 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngPosXF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%AngPosXF)>0) OutData%AngPosXF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngPosXF))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngPosXF) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AngPosXF,2), UBOUND(OutData%AngPosXF,2) + DO i1 = LBOUND(OutData%AngPosXF,1), UBOUND(OutData%AngPosXF,1) + OutData%AngPosXF(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AngPosHM not allocated Int_Xferred = Int_Xferred + 1 @@ -12725,38 +12738,27 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngPosHM.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%AngPosHM)>0) OutData%AngPosHM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngPosHM))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngPosHM) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%AngPosHM,3), UBOUND(OutData%AngPosHM,3) + DO i2 = LBOUND(OutData%AngPosHM,2), UBOUND(OutData%AngPosHM,2) + DO i1 = LBOUND(OutData%AngPosHM,1), UBOUND(OutData%AngPosHM,1) + OutData%AngPosHM(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF i1_l = LBOUND(OutData%AngPosXB,1) i1_u = UBOUND(OutData%AngPosXB,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%AngPosXB = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngPosXB))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngPosXB) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AngPosXB,1), UBOUND(OutData%AngPosXB,1) + OutData%AngPosXB(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%AngPosEX,1) i1_u = UBOUND(OutData%AngPosEX,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%AngPosEX = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngPosEX))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngPosEX) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AngPosEX,1), UBOUND(OutData%AngPosEX,1) + OutData%AngPosEX(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PAngVelEA not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -12776,15 +12778,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEA.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PAngVelEA)>0) OutData%PAngVelEA = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PAngVelEA))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PAngVelEA) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PAngVelEA,3), UBOUND(OutData%PAngVelEA,3) + DO i2 = LBOUND(OutData%PAngVelEA,2), UBOUND(OutData%PAngVelEA,2) + DO i1 = LBOUND(OutData%PAngVelEA,1), UBOUND(OutData%PAngVelEA,1) + OutData%PAngVelEA(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 ! PAngVelEF not allocated Int_Xferred = Int_Xferred + 1 @@ -12808,15 +12809,16 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%PAngVelEF)>0) OutData%PAngVelEF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PAngVelEF))-1 ), mask4, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PAngVelEF) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%PAngVelEF,4), UBOUND(OutData%PAngVelEF,4) + DO i3 = LBOUND(OutData%PAngVelEF,3), UBOUND(OutData%PAngVelEF,3) + DO i2 = LBOUND(OutData%PAngVelEF,2), UBOUND(OutData%PAngVelEF,2) + DO i1 = LBOUND(OutData%PAngVelEF,1), UBOUND(OutData%PAngVelEF,1) + OutData%PAngVelEF(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PAngVelEG not allocated Int_Xferred = Int_Xferred + 1 @@ -12837,15 +12839,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEG.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PAngVelEG)>0) OutData%PAngVelEG = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PAngVelEG))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PAngVelEG) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PAngVelEG,3), UBOUND(OutData%PAngVelEG,3) + DO i2 = LBOUND(OutData%PAngVelEG,2), UBOUND(OutData%PAngVelEG,2) + DO i1 = LBOUND(OutData%PAngVelEG,1), UBOUND(OutData%PAngVelEG,1) + OutData%PAngVelEG(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 ! PAngVelEH not allocated Int_Xferred = Int_Xferred + 1 @@ -12866,15 +12867,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEH.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PAngVelEH)>0) OutData%PAngVelEH = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PAngVelEH))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PAngVelEH) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PAngVelEH,3), UBOUND(OutData%PAngVelEH,3) + DO i2 = LBOUND(OutData%PAngVelEH,2), UBOUND(OutData%PAngVelEH,2) + DO i1 = LBOUND(OutData%PAngVelEH,1), UBOUND(OutData%PAngVelEH,1) + OutData%PAngVelEH(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 ! PAngVelEL not allocated Int_Xferred = Int_Xferred + 1 @@ -12895,15 +12895,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEL.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PAngVelEL)>0) OutData%PAngVelEL = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PAngVelEL))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PAngVelEL) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PAngVelEL,3), UBOUND(OutData%PAngVelEL,3) + DO i2 = LBOUND(OutData%PAngVelEL,2), UBOUND(OutData%PAngVelEL,2) + DO i1 = LBOUND(OutData%PAngVelEL,1), UBOUND(OutData%PAngVelEL,1) + OutData%PAngVelEL(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 ! PAngVelEM not allocated Int_Xferred = Int_Xferred + 1 @@ -12930,15 +12929,18 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEM.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask5(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask5.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask5 = .TRUE. - IF (SIZE(OutData%PAngVelEM)>0) OutData%PAngVelEM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PAngVelEM))-1 ), mask5, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PAngVelEM) - DEALLOCATE(mask5) + DO i5 = LBOUND(OutData%PAngVelEM,5), UBOUND(OutData%PAngVelEM,5) + DO i4 = LBOUND(OutData%PAngVelEM,4), UBOUND(OutData%PAngVelEM,4) + DO i3 = LBOUND(OutData%PAngVelEM,3), UBOUND(OutData%PAngVelEM,3) + DO i2 = LBOUND(OutData%PAngVelEM,2), UBOUND(OutData%PAngVelEM,2) + DO i1 = LBOUND(OutData%PAngVelEM,1), UBOUND(OutData%PAngVelEM,1) + OutData%PAngVelEM(i1,i2,i3,i4,i5) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PAngVelEN not allocated Int_Xferred = Int_Xferred + 1 @@ -12959,27 +12961,21 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEN.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PAngVelEN)>0) OutData%PAngVelEN = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PAngVelEN))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PAngVelEN) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PAngVelEN,3), UBOUND(OutData%PAngVelEN,3) + DO i2 = LBOUND(OutData%PAngVelEN,2), UBOUND(OutData%PAngVelEN,2) + DO i1 = LBOUND(OutData%PAngVelEN,1), UBOUND(OutData%PAngVelEN,1) + OutData%PAngVelEN(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF i1_l = LBOUND(OutData%AngVelEA,1) i1_u = UBOUND(OutData%AngVelEA,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%AngVelEA = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngVelEA))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngVelEA) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AngVelEA,1), UBOUND(OutData%AngVelEA,1) + OutData%AngVelEA(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PAngVelEB not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -12999,15 +12995,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEB.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PAngVelEB)>0) OutData%PAngVelEB = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PAngVelEB))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PAngVelEB) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PAngVelEB,3), UBOUND(OutData%PAngVelEB,3) + DO i2 = LBOUND(OutData%PAngVelEB,2), UBOUND(OutData%PAngVelEB,2) + DO i1 = LBOUND(OutData%PAngVelEB,1), UBOUND(OutData%PAngVelEB,1) + OutData%PAngVelEB(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 ! PAngVelER not allocated Int_Xferred = Int_Xferred + 1 @@ -13028,15 +13023,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelER.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PAngVelER)>0) OutData%PAngVelER = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PAngVelER))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PAngVelER) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PAngVelER,3), UBOUND(OutData%PAngVelER,3) + DO i2 = LBOUND(OutData%PAngVelER,2), UBOUND(OutData%PAngVelER,2) + DO i1 = LBOUND(OutData%PAngVelER,1), UBOUND(OutData%PAngVelER,1) + OutData%PAngVelER(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 ! PAngVelEX not allocated Int_Xferred = Int_Xferred + 1 @@ -13057,128 +13051,77 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEX.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PAngVelEX)>0) OutData%PAngVelEX = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PAngVelEX))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PAngVelEX) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PAngVelEX,3), UBOUND(OutData%PAngVelEX,3) + DO i2 = LBOUND(OutData%PAngVelEX,2), UBOUND(OutData%PAngVelEX,2) + DO i1 = LBOUND(OutData%PAngVelEX,1), UBOUND(OutData%PAngVelEX,1) + OutData%PAngVelEX(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF i1_l = LBOUND(OutData%AngVelEG,1) i1_u = UBOUND(OutData%AngVelEG,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%AngVelEG = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngVelEG))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngVelEG) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AngVelEG,1), UBOUND(OutData%AngVelEG,1) + OutData%AngVelEG(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%AngVelEH,1) i1_u = UBOUND(OutData%AngVelEH,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%AngVelEH = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngVelEH))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngVelEH) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AngVelEH,1), UBOUND(OutData%AngVelEH,1) + OutData%AngVelEH(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%AngVelEL,1) i1_u = UBOUND(OutData%AngVelEL,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%AngVelEL = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngVelEL))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngVelEL) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AngVelEL,1), UBOUND(OutData%AngVelEL,1) + OutData%AngVelEL(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%AngVelEN,1) i1_u = UBOUND(OutData%AngVelEN,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%AngVelEN = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngVelEN))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngVelEN) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AngVelEN,1), UBOUND(OutData%AngVelEN,1) + OutData%AngVelEN(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%AngVelEB,1) i1_u = UBOUND(OutData%AngVelEB,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%AngVelEB = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngVelEB))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngVelEB) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AngVelEB,1), UBOUND(OutData%AngVelEB,1) + OutData%AngVelEB(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%AngVelER,1) i1_u = UBOUND(OutData%AngVelER,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%AngVelER = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngVelER))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngVelER) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AngVelER,1), UBOUND(OutData%AngVelER,1) + OutData%AngVelER(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%AngVelEX,1) i1_u = UBOUND(OutData%AngVelEX,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%AngVelEX = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngVelEX))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngVelEX) - DEALLOCATE(mask1) - OutData%TeetAngVel = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(OutData%AngVelEX,1), UBOUND(OutData%AngVelEX,1) + OutData%AngVelEX(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%TeetAngVel = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 i1_l = LBOUND(OutData%AngAccEBt,1) i1_u = UBOUND(OutData%AngAccEBt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%AngAccEBt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngAccEBt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngAccEBt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AngAccEBt,1), UBOUND(OutData%AngAccEBt,1) + OutData%AngAccEBt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%AngAccERt,1) i1_u = UBOUND(OutData%AngAccERt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%AngAccERt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngAccERt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngAccERt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AngAccERt,1), UBOUND(OutData%AngAccERt,1) + OutData%AngAccERt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%AngAccEXt,1) i1_u = UBOUND(OutData%AngAccEXt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%AngAccEXt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngAccEXt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngAccEXt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AngAccEXt,1), UBOUND(OutData%AngAccEXt,1) + OutData%AngAccEXt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AngAccEFt not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -13195,15 +13138,12 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngAccEFt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%AngAccEFt)>0) OutData%AngAccEFt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngAccEFt))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngAccEFt) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AngAccEFt,2), UBOUND(OutData%AngAccEFt,2) + DO i1 = LBOUND(OutData%AngAccEFt,1), UBOUND(OutData%AngAccEFt,1) + OutData%AngAccEFt(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AngVelEF not allocated Int_Xferred = Int_Xferred + 1 @@ -13221,126 +13161,73 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngVelEF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%AngVelEF)>0) OutData%AngVelEF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngVelEF))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngVelEF) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AngVelEF,2), UBOUND(OutData%AngVelEF,2) + DO i1 = LBOUND(OutData%AngVelEF,1), UBOUND(OutData%AngVelEF,1) + OutData%AngVelEF(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF i1_l = LBOUND(OutData%AngAccEAt,1) i1_u = UBOUND(OutData%AngAccEAt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%AngAccEAt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngAccEAt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngAccEAt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AngAccEAt,1), UBOUND(OutData%AngAccEAt,1) + OutData%AngAccEAt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%AngAccEGt,1) i1_u = UBOUND(OutData%AngAccEGt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%AngAccEGt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngAccEGt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngAccEGt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AngAccEGt,1), UBOUND(OutData%AngAccEGt,1) + OutData%AngAccEGt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%AngAccEHt,1) i1_u = UBOUND(OutData%AngAccEHt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%AngAccEHt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngAccEHt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngAccEHt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AngAccEHt,1), UBOUND(OutData%AngAccEHt,1) + OutData%AngAccEHt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%AngAccENt,1) i1_u = UBOUND(OutData%AngAccENt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%AngAccENt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngAccENt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngAccENt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AngAccENt,1), UBOUND(OutData%AngAccENt,1) + OutData%AngAccENt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%LinAccECt,1) i1_u = UBOUND(OutData%LinAccECt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%LinAccECt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LinAccECt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LinAccECt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LinAccECt,1), UBOUND(OutData%LinAccECt,1) + OutData%LinAccECt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%LinAccEDt,1) i1_u = UBOUND(OutData%LinAccEDt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%LinAccEDt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LinAccEDt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LinAccEDt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LinAccEDt,1), UBOUND(OutData%LinAccEDt,1) + OutData%LinAccEDt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%LinAccEIt,1) i1_u = UBOUND(OutData%LinAccEIt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%LinAccEIt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LinAccEIt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LinAccEIt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LinAccEIt,1), UBOUND(OutData%LinAccEIt,1) + OutData%LinAccEIt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%LinAccEJt,1) i1_u = UBOUND(OutData%LinAccEJt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%LinAccEJt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LinAccEJt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LinAccEJt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LinAccEJt,1), UBOUND(OutData%LinAccEJt,1) + OutData%LinAccEJt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%LinAccEUt,1) i1_u = UBOUND(OutData%LinAccEUt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%LinAccEUt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LinAccEUt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LinAccEUt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LinAccEUt,1), UBOUND(OutData%LinAccEUt,1) + OutData%LinAccEUt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%LinAccEYt,1) i1_u = UBOUND(OutData%LinAccEYt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%LinAccEYt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LinAccEYt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LinAccEYt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LinAccEYt,1), UBOUND(OutData%LinAccEYt,1) + OutData%LinAccEYt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinVelES not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -13360,27 +13247,21 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinVelES.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%LinVelES)>0) OutData%LinVelES = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LinVelES))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LinVelES) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%LinVelES,3), UBOUND(OutData%LinVelES,3) + DO i2 = LBOUND(OutData%LinVelES,2), UBOUND(OutData%LinVelES,2) + DO i1 = LBOUND(OutData%LinVelES,1), UBOUND(OutData%LinVelES,1) + OutData%LinVelES(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF i1_l = LBOUND(OutData%LinVelEQ,1) i1_u = UBOUND(OutData%LinVelEQ,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%LinVelEQ = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LinVelEQ))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LinVelEQ) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LinVelEQ,1), UBOUND(OutData%LinVelEQ,1) + OutData%LinVelEQ(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinVelET not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -13397,15 +13278,12 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinVelET.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%LinVelET)>0) OutData%LinVelET = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LinVelET))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LinVelET) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%LinVelET,2), UBOUND(OutData%LinVelET,2) + DO i1 = LBOUND(OutData%LinVelET,1), UBOUND(OutData%LinVelET,1) + OutData%LinVelET(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinVelESm2 not allocated Int_Xferred = Int_Xferred + 1 @@ -13420,15 +13298,10 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinVelESm2.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LinVelESm2)>0) OutData%LinVelESm2 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LinVelESm2))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LinVelESm2) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LinVelESm2,1), UBOUND(OutData%LinVelESm2,1) + OutData%LinVelESm2(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelEIMU not allocated Int_Xferred = Int_Xferred + 1 @@ -13449,15 +13322,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEIMU.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PLinVelEIMU)>0) OutData%PLinVelEIMU = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PLinVelEIMU))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PLinVelEIMU) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PLinVelEIMU,3), UBOUND(OutData%PLinVelEIMU,3) + DO i2 = LBOUND(OutData%PLinVelEIMU,2), UBOUND(OutData%PLinVelEIMU,2) + DO i1 = LBOUND(OutData%PLinVelEIMU,1), UBOUND(OutData%PLinVelEIMU,1) + OutData%PLinVelEIMU(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 ! PLinVelEO not allocated Int_Xferred = Int_Xferred + 1 @@ -13478,15 +13350,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEO.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PLinVelEO)>0) OutData%PLinVelEO = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PLinVelEO))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PLinVelEO) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PLinVelEO,3), UBOUND(OutData%PLinVelEO,3) + DO i2 = LBOUND(OutData%PLinVelEO,2), UBOUND(OutData%PLinVelEO,2) + DO i1 = LBOUND(OutData%PLinVelEO,1), UBOUND(OutData%PLinVelEO,1) + OutData%PLinVelEO(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 ! PLinVelES not allocated Int_Xferred = Int_Xferred + 1 @@ -13513,15 +13384,18 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelES.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask5(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask5.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask5 = .TRUE. - IF (SIZE(OutData%PLinVelES)>0) OutData%PLinVelES = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PLinVelES))-1 ), mask5, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PLinVelES) - DEALLOCATE(mask5) + DO i5 = LBOUND(OutData%PLinVelES,5), UBOUND(OutData%PLinVelES,5) + DO i4 = LBOUND(OutData%PLinVelES,4), UBOUND(OutData%PLinVelES,4) + DO i3 = LBOUND(OutData%PLinVelES,3), UBOUND(OutData%PLinVelES,3) + DO i2 = LBOUND(OutData%PLinVelES,2), UBOUND(OutData%PLinVelES,2) + DO i1 = LBOUND(OutData%PLinVelES,1), UBOUND(OutData%PLinVelES,1) + OutData%PLinVelES(i1,i2,i3,i4,i5) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelET not allocated Int_Xferred = Int_Xferred + 1 @@ -13545,15 +13419,16 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelET.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%PLinVelET)>0) OutData%PLinVelET = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PLinVelET))-1 ), mask4, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PLinVelET) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%PLinVelET,4), UBOUND(OutData%PLinVelET,4) + DO i3 = LBOUND(OutData%PLinVelET,3), UBOUND(OutData%PLinVelET,3) + DO i2 = LBOUND(OutData%PLinVelET,2), UBOUND(OutData%PLinVelET,2) + DO i1 = LBOUND(OutData%PLinVelET,1), UBOUND(OutData%PLinVelET,1) + OutData%PLinVelET(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelEZ not allocated Int_Xferred = Int_Xferred + 1 @@ -13574,15 +13449,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEZ.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PLinVelEZ)>0) OutData%PLinVelEZ = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PLinVelEZ))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PLinVelEZ) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PLinVelEZ,3), UBOUND(OutData%PLinVelEZ,3) + DO i2 = LBOUND(OutData%PLinVelEZ,2), UBOUND(OutData%PLinVelEZ,2) + DO i1 = LBOUND(OutData%PLinVelEZ,1), UBOUND(OutData%PLinVelEZ,1) + OutData%PLinVelEZ(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 ! PLinVelEC not allocated Int_Xferred = Int_Xferred + 1 @@ -13603,15 +13477,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEC.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PLinVelEC)>0) OutData%PLinVelEC = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PLinVelEC))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PLinVelEC) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PLinVelEC,3), UBOUND(OutData%PLinVelEC,3) + DO i2 = LBOUND(OutData%PLinVelEC,2), UBOUND(OutData%PLinVelEC,2) + DO i1 = LBOUND(OutData%PLinVelEC,1), UBOUND(OutData%PLinVelEC,1) + OutData%PLinVelEC(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 ! PLinVelED not allocated Int_Xferred = Int_Xferred + 1 @@ -13632,15 +13505,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelED.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PLinVelED)>0) OutData%PLinVelED = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PLinVelED))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PLinVelED) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PLinVelED,3), UBOUND(OutData%PLinVelED,3) + DO i2 = LBOUND(OutData%PLinVelED,2), UBOUND(OutData%PLinVelED,2) + DO i1 = LBOUND(OutData%PLinVelED,1), UBOUND(OutData%PLinVelED,1) + OutData%PLinVelED(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 ! PLinVelEI not allocated Int_Xferred = Int_Xferred + 1 @@ -13661,15 +13533,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEI.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PLinVelEI)>0) OutData%PLinVelEI = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PLinVelEI))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PLinVelEI) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PLinVelEI,3), UBOUND(OutData%PLinVelEI,3) + DO i2 = LBOUND(OutData%PLinVelEI,2), UBOUND(OutData%PLinVelEI,2) + DO i1 = LBOUND(OutData%PLinVelEI,1), UBOUND(OutData%PLinVelEI,1) + OutData%PLinVelEI(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 ! PLinVelEJ not allocated Int_Xferred = Int_Xferred + 1 @@ -13690,15 +13561,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEJ.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PLinVelEJ)>0) OutData%PLinVelEJ = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PLinVelEJ))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PLinVelEJ) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PLinVelEJ,3), UBOUND(OutData%PLinVelEJ,3) + DO i2 = LBOUND(OutData%PLinVelEJ,2), UBOUND(OutData%PLinVelEJ,2) + DO i1 = LBOUND(OutData%PLinVelEJ,1), UBOUND(OutData%PLinVelEJ,1) + OutData%PLinVelEJ(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 ! PLinVelEK not allocated Int_Xferred = Int_Xferred + 1 @@ -13719,15 +13589,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEK.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PLinVelEK)>0) OutData%PLinVelEK = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PLinVelEK))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PLinVelEK) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PLinVelEK,3), UBOUND(OutData%PLinVelEK,3) + DO i2 = LBOUND(OutData%PLinVelEK,2), UBOUND(OutData%PLinVelEK,2) + DO i1 = LBOUND(OutData%PLinVelEK,1), UBOUND(OutData%PLinVelEK,1) + OutData%PLinVelEK(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 ! PLinVelEP not allocated Int_Xferred = Int_Xferred + 1 @@ -13748,15 +13617,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PLinVelEP)>0) OutData%PLinVelEP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PLinVelEP))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PLinVelEP) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PLinVelEP,3), UBOUND(OutData%PLinVelEP,3) + DO i2 = LBOUND(OutData%PLinVelEP,2), UBOUND(OutData%PLinVelEP,2) + DO i1 = LBOUND(OutData%PLinVelEP,1), UBOUND(OutData%PLinVelEP,1) + OutData%PLinVelEP(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 ! PLinVelEQ not allocated Int_Xferred = Int_Xferred + 1 @@ -13777,15 +13645,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEQ.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PLinVelEQ)>0) OutData%PLinVelEQ = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PLinVelEQ))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PLinVelEQ) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PLinVelEQ,3), UBOUND(OutData%PLinVelEQ,3) + DO i2 = LBOUND(OutData%PLinVelEQ,2), UBOUND(OutData%PLinVelEQ,2) + DO i1 = LBOUND(OutData%PLinVelEQ,1), UBOUND(OutData%PLinVelEQ,1) + OutData%PLinVelEQ(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 ! PLinVelEU not allocated Int_Xferred = Int_Xferred + 1 @@ -13806,15 +13673,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEU.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PLinVelEU)>0) OutData%PLinVelEU = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PLinVelEU))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PLinVelEU) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PLinVelEU,3), UBOUND(OutData%PLinVelEU,3) + DO i2 = LBOUND(OutData%PLinVelEU,2), UBOUND(OutData%PLinVelEU,2) + DO i1 = LBOUND(OutData%PLinVelEU,1), UBOUND(OutData%PLinVelEU,1) + OutData%PLinVelEU(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 ! PLinVelEV not allocated Int_Xferred = Int_Xferred + 1 @@ -13835,15 +13701,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEV.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PLinVelEV)>0) OutData%PLinVelEV = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PLinVelEV))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PLinVelEV) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PLinVelEV,3), UBOUND(OutData%PLinVelEV,3) + DO i2 = LBOUND(OutData%PLinVelEV,2), UBOUND(OutData%PLinVelEV,2) + DO i1 = LBOUND(OutData%PLinVelEV,1), UBOUND(OutData%PLinVelEV,1) + OutData%PLinVelEV(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 ! PLinVelEW not allocated Int_Xferred = Int_Xferred + 1 @@ -13864,15 +13729,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEW.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PLinVelEW)>0) OutData%PLinVelEW = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PLinVelEW))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PLinVelEW) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PLinVelEW,3), UBOUND(OutData%PLinVelEW,3) + DO i2 = LBOUND(OutData%PLinVelEW,2), UBOUND(OutData%PLinVelEW,2) + DO i1 = LBOUND(OutData%PLinVelEW,1), UBOUND(OutData%PLinVelEW,1) + OutData%PLinVelEW(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 ! PLinVelEY not allocated Int_Xferred = Int_Xferred + 1 @@ -13893,38 +13757,27 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEY.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PLinVelEY)>0) OutData%PLinVelEY = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PLinVelEY))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PLinVelEY) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PLinVelEY,3), UBOUND(OutData%PLinVelEY,3) + DO i2 = LBOUND(OutData%PLinVelEY,2), UBOUND(OutData%PLinVelEY,2) + DO i1 = LBOUND(OutData%PLinVelEY,1), UBOUND(OutData%PLinVelEY,1) + OutData%PLinVelEY(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF i1_l = LBOUND(OutData%LinAccEIMUt,1) i1_u = UBOUND(OutData%LinAccEIMUt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%LinAccEIMUt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LinAccEIMUt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LinAccEIMUt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LinAccEIMUt,1), UBOUND(OutData%LinAccEIMUt,1) + OutData%LinAccEIMUt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%LinAccEOt,1) i1_u = UBOUND(OutData%LinAccEOt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%LinAccEOt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LinAccEOt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LinAccEOt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LinAccEOt,1), UBOUND(OutData%LinAccEOt,1) + OutData%LinAccEOt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinAccESt not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -13944,15 +13797,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinAccESt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%LinAccESt)>0) OutData%LinAccESt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LinAccESt))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LinAccESt) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%LinAccESt,3), UBOUND(OutData%LinAccESt,3) + DO i2 = LBOUND(OutData%LinAccESt,2), UBOUND(OutData%LinAccESt,2) + DO i1 = LBOUND(OutData%LinAccESt,1), UBOUND(OutData%LinAccESt,1) + OutData%LinAccESt(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 ! LinAccETt not allocated Int_Xferred = Int_Xferred + 1 @@ -13970,82 +13822,49 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinAccETt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%LinAccETt)>0) OutData%LinAccETt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LinAccETt))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LinAccETt) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%LinAccETt,2), UBOUND(OutData%LinAccETt,2) + DO i1 = LBOUND(OutData%LinAccETt,1), UBOUND(OutData%LinAccETt,1) + OutData%LinAccETt(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF i1_l = LBOUND(OutData%LinAccEZt,1) i1_u = UBOUND(OutData%LinAccEZt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%LinAccEZt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LinAccEZt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LinAccEZt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LinAccEZt,1), UBOUND(OutData%LinAccEZt,1) + OutData%LinAccEZt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%LinVelEIMU,1) i1_u = UBOUND(OutData%LinVelEIMU,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%LinVelEIMU = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LinVelEIMU))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LinVelEIMU) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LinVelEIMU,1), UBOUND(OutData%LinVelEIMU,1) + OutData%LinVelEIMU(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%LinVelEZ,1) i1_u = UBOUND(OutData%LinVelEZ,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%LinVelEZ = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LinVelEZ))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LinVelEZ) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LinVelEZ,1), UBOUND(OutData%LinVelEZ,1) + OutData%LinVelEZ(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%LinVelEO,1) i1_u = UBOUND(OutData%LinVelEO,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%LinVelEO = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LinVelEO))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LinVelEO) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LinVelEO,1), UBOUND(OutData%LinVelEO,1) + OutData%LinVelEO(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%FrcONcRtt,1) i1_u = UBOUND(OutData%FrcONcRtt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%FrcONcRtt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FrcONcRtt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FrcONcRtt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FrcONcRtt,1), UBOUND(OutData%FrcONcRtt,1) + OutData%FrcONcRtt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%FrcPRott,1) i1_u = UBOUND(OutData%FrcPRott,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%FrcPRott = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FrcPRott))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FrcPRott) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FrcPRott,1), UBOUND(OutData%FrcPRott,1) + OutData%FrcPRott(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FrcS0Bt not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -14062,27 +13881,19 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FrcS0Bt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%FrcS0Bt)>0) OutData%FrcS0Bt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FrcS0Bt))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FrcS0Bt) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%FrcS0Bt,2), UBOUND(OutData%FrcS0Bt,2) + DO i1 = LBOUND(OutData%FrcS0Bt,1), UBOUND(OutData%FrcS0Bt,1) + OutData%FrcS0Bt(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF i1_l = LBOUND(OutData%FrcT0Trbt,1) i1_u = UBOUND(OutData%FrcT0Trbt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%FrcT0Trbt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FrcT0Trbt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FrcT0Trbt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FrcT0Trbt,1), UBOUND(OutData%FrcT0Trbt,1) + OutData%FrcT0Trbt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FSAero not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -14102,15 +13913,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FSAero.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%FSAero)>0) OutData%FSAero = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FSAero))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FSAero) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%FSAero,3), UBOUND(OutData%FSAero,3) + DO i2 = LBOUND(OutData%FSAero,2), UBOUND(OutData%FSAero,2) + DO i1 = LBOUND(OutData%FSAero,1), UBOUND(OutData%FSAero,1) + OutData%FSAero(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 ! FSTipDrag not allocated Int_Xferred = Int_Xferred + 1 @@ -14128,15 +13938,12 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FSTipDrag.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%FSTipDrag)>0) OutData%FSTipDrag = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FSTipDrag))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FSTipDrag) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%FSTipDrag,2), UBOUND(OutData%FSTipDrag,2) + DO i1 = LBOUND(OutData%FSTipDrag,1), UBOUND(OutData%FSTipDrag,1) + OutData%FSTipDrag(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FTHydrot not allocated Int_Xferred = Int_Xferred + 1 @@ -14154,27 +13961,19 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FTHydrot.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%FTHydrot)>0) OutData%FTHydrot = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FTHydrot))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FTHydrot) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%FTHydrot,2), UBOUND(OutData%FTHydrot,2) + DO i1 = LBOUND(OutData%FTHydrot,1), UBOUND(OutData%FTHydrot,1) + OutData%FTHydrot(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF i1_l = LBOUND(OutData%FZHydrot,1) i1_u = UBOUND(OutData%FZHydrot,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%FZHydrot = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FZHydrot))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FZHydrot) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FZHydrot,1), UBOUND(OutData%FZHydrot,1) + OutData%FZHydrot(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MFHydrot not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -14191,27 +13990,19 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MFHydrot.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%MFHydrot)>0) OutData%MFHydrot = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MFHydrot))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MFHydrot) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%MFHydrot,2), UBOUND(OutData%MFHydrot,2) + DO i1 = LBOUND(OutData%MFHydrot,1), UBOUND(OutData%MFHydrot,1) + OutData%MFHydrot(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF i1_l = LBOUND(OutData%MomBNcRtt,1) i1_u = UBOUND(OutData%MomBNcRtt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%MomBNcRtt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MomBNcRtt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MomBNcRtt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%MomBNcRtt,1), UBOUND(OutData%MomBNcRtt,1) + OutData%MomBNcRtt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MomH0Bt not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -14228,60 +14019,37 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MomH0Bt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%MomH0Bt)>0) OutData%MomH0Bt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MomH0Bt))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MomH0Bt) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%MomH0Bt,2), UBOUND(OutData%MomH0Bt,2) + DO i1 = LBOUND(OutData%MomH0Bt,1), UBOUND(OutData%MomH0Bt,1) + OutData%MomH0Bt(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF i1_l = LBOUND(OutData%MomLPRott,1) i1_u = UBOUND(OutData%MomLPRott,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%MomLPRott = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MomLPRott))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MomLPRott) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%MomLPRott,1), UBOUND(OutData%MomLPRott,1) + OutData%MomLPRott(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%MomNGnRtt,1) i1_u = UBOUND(OutData%MomNGnRtt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%MomNGnRtt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MomNGnRtt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MomNGnRtt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%MomNGnRtt,1), UBOUND(OutData%MomNGnRtt,1) + OutData%MomNGnRtt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%MomNTailt,1) i1_u = UBOUND(OutData%MomNTailt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%MomNTailt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MomNTailt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MomNTailt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%MomNTailt,1), UBOUND(OutData%MomNTailt,1) + OutData%MomNTailt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%MomX0Trbt,1) i1_u = UBOUND(OutData%MomX0Trbt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%MomX0Trbt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MomX0Trbt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MomX0Trbt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%MomX0Trbt,1), UBOUND(OutData%MomX0Trbt,1) + OutData%MomX0Trbt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MMAero not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -14301,27 +14069,21 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MMAero.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%MMAero)>0) OutData%MMAero = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MMAero))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MMAero) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%MMAero,3), UBOUND(OutData%MMAero,3) + DO i2 = LBOUND(OutData%MMAero,2), UBOUND(OutData%MMAero,2) + DO i1 = LBOUND(OutData%MMAero,1), UBOUND(OutData%MMAero,1) + OutData%MMAero(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF i1_l = LBOUND(OutData%MXHydrot,1) i1_u = UBOUND(OutData%MXHydrot,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%MXHydrot = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MXHydrot))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MXHydrot) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%MXHydrot,1), UBOUND(OutData%MXHydrot,1) + OutData%MXHydrot(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PFrcONcRt not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -14338,15 +14100,12 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFrcONcRt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PFrcONcRt)>0) OutData%PFrcONcRt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PFrcONcRt))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PFrcONcRt) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PFrcONcRt,2), UBOUND(OutData%PFrcONcRt,2) + DO i1 = LBOUND(OutData%PFrcONcRt,1), UBOUND(OutData%PFrcONcRt,1) + OutData%PFrcONcRt(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PFrcPRot not allocated Int_Xferred = Int_Xferred + 1 @@ -14364,15 +14123,12 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFrcPRot.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PFrcPRot)>0) OutData%PFrcPRot = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PFrcPRot))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PFrcPRot) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PFrcPRot,2), UBOUND(OutData%PFrcPRot,2) + DO i1 = LBOUND(OutData%PFrcPRot,1), UBOUND(OutData%PFrcPRot,1) + OutData%PFrcPRot(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PFrcS0B not allocated Int_Xferred = Int_Xferred + 1 @@ -14393,15 +14149,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFrcS0B.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PFrcS0B)>0) OutData%PFrcS0B = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PFrcS0B))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PFrcS0B) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PFrcS0B,3), UBOUND(OutData%PFrcS0B,3) + DO i2 = LBOUND(OutData%PFrcS0B,2), UBOUND(OutData%PFrcS0B,2) + DO i1 = LBOUND(OutData%PFrcS0B,1), UBOUND(OutData%PFrcS0B,1) + OutData%PFrcS0B(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 ! PFrcT0Trb not allocated Int_Xferred = Int_Xferred + 1 @@ -14419,15 +14174,12 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFrcT0Trb.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PFrcT0Trb)>0) OutData%PFrcT0Trb = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PFrcT0Trb))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PFrcT0Trb) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PFrcT0Trb,2), UBOUND(OutData%PFrcT0Trb,2) + DO i1 = LBOUND(OutData%PFrcT0Trb,1), UBOUND(OutData%PFrcT0Trb,1) + OutData%PFrcT0Trb(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PFTHydro not allocated Int_Xferred = Int_Xferred + 1 @@ -14448,29 +14200,25 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFTHydro.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PFTHydro)>0) OutData%PFTHydro = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PFTHydro))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PFTHydro) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PFTHydro,3), UBOUND(OutData%PFTHydro,3) + DO i2 = LBOUND(OutData%PFTHydro,2), UBOUND(OutData%PFTHydro,2) + DO i1 = LBOUND(OutData%PFTHydro,1), UBOUND(OutData%PFTHydro,1) + OutData%PFTHydro(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF i1_l = LBOUND(OutData%PFZHydro,1) i1_u = UBOUND(OutData%PFZHydro,1) i2_l = LBOUND(OutData%PFZHydro,2) i2_u = UBOUND(OutData%PFZHydro,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%PFZHydro = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PFZHydro))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PFZHydro) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PFZHydro,2), UBOUND(OutData%PFZHydro,2) + DO i1 = LBOUND(OutData%PFZHydro,1), UBOUND(OutData%PFZHydro,1) + OutData%PFZHydro(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PMFHydro not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -14490,15 +14238,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMFHydro.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PMFHydro)>0) OutData%PMFHydro = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PMFHydro))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PMFHydro) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PMFHydro,3), UBOUND(OutData%PMFHydro,3) + DO i2 = LBOUND(OutData%PMFHydro,2), UBOUND(OutData%PMFHydro,2) + DO i1 = LBOUND(OutData%PMFHydro,1), UBOUND(OutData%PMFHydro,1) + OutData%PMFHydro(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 ! PMomBNcRt not allocated Int_Xferred = Int_Xferred + 1 @@ -14516,15 +14263,12 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMomBNcRt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PMomBNcRt)>0) OutData%PMomBNcRt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PMomBNcRt))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PMomBNcRt) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PMomBNcRt,2), UBOUND(OutData%PMomBNcRt,2) + DO i1 = LBOUND(OutData%PMomBNcRt,1), UBOUND(OutData%PMomBNcRt,1) + OutData%PMomBNcRt(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PMomH0B not allocated Int_Xferred = Int_Xferred + 1 @@ -14545,15 +14289,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMomH0B.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PMomH0B)>0) OutData%PMomH0B = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PMomH0B))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PMomH0B) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PMomH0B,3), UBOUND(OutData%PMomH0B,3) + DO i2 = LBOUND(OutData%PMomH0B,2), UBOUND(OutData%PMomH0B,2) + DO i1 = LBOUND(OutData%PMomH0B,1), UBOUND(OutData%PMomH0B,1) + OutData%PMomH0B(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 ! PMomLPRot not allocated Int_Xferred = Int_Xferred + 1 @@ -14571,15 +14314,12 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMomLPRot.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PMomLPRot)>0) OutData%PMomLPRot = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PMomLPRot))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PMomLPRot) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PMomLPRot,2), UBOUND(OutData%PMomLPRot,2) + DO i1 = LBOUND(OutData%PMomLPRot,1), UBOUND(OutData%PMomLPRot,1) + OutData%PMomLPRot(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PMomNGnRt not allocated Int_Xferred = Int_Xferred + 1 @@ -14597,15 +14337,12 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMomNGnRt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PMomNGnRt)>0) OutData%PMomNGnRt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PMomNGnRt))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PMomNGnRt) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PMomNGnRt,2), UBOUND(OutData%PMomNGnRt,2) + DO i1 = LBOUND(OutData%PMomNGnRt,1), UBOUND(OutData%PMomNGnRt,1) + OutData%PMomNGnRt(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PMomNTail not allocated Int_Xferred = Int_Xferred + 1 @@ -14623,15 +14360,12 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMomNTail.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PMomNTail)>0) OutData%PMomNTail = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PMomNTail))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PMomNTail) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PMomNTail,2), UBOUND(OutData%PMomNTail,2) + DO i1 = LBOUND(OutData%PMomNTail,1), UBOUND(OutData%PMomNTail,1) + OutData%PMomNTail(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PMomX0Trb not allocated Int_Xferred = Int_Xferred + 1 @@ -14649,75 +14383,49 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMomX0Trb.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PMomX0Trb)>0) OutData%PMomX0Trb = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PMomX0Trb))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PMomX0Trb) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PMomX0Trb,2), UBOUND(OutData%PMomX0Trb,2) + DO i1 = LBOUND(OutData%PMomX0Trb,1), UBOUND(OutData%PMomX0Trb,1) + OutData%PMomX0Trb(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF i1_l = LBOUND(OutData%PMXHydro,1) i1_u = UBOUND(OutData%PMXHydro,1) i2_l = LBOUND(OutData%PMXHydro,2) i2_u = UBOUND(OutData%PMXHydro,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%PMXHydro = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PMXHydro))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PMXHydro) - DEALLOCATE(mask2) - OutData%TeetAng = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 + DO i2 = LBOUND(OutData%PMXHydro,2), UBOUND(OutData%PMXHydro,2) + DO i1 = LBOUND(OutData%PMXHydro,1), UBOUND(OutData%PMXHydro,1) + OutData%PMXHydro(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + OutData%TeetAng = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 i1_l = LBOUND(OutData%FrcVGnRtt,1) i1_u = UBOUND(OutData%FrcVGnRtt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%FrcVGnRtt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FrcVGnRtt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FrcVGnRtt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FrcVGnRtt,1), UBOUND(OutData%FrcVGnRtt,1) + OutData%FrcVGnRtt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%FrcWTailt,1) i1_u = UBOUND(OutData%FrcWTailt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%FrcWTailt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FrcWTailt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FrcWTailt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FrcWTailt,1), UBOUND(OutData%FrcWTailt,1) + OutData%FrcWTailt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%FrcZAllt,1) i1_u = UBOUND(OutData%FrcZAllt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%FrcZAllt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FrcZAllt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FrcZAllt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FrcZAllt,1), UBOUND(OutData%FrcZAllt,1) + OutData%FrcZAllt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%MomXAllt,1) i1_u = UBOUND(OutData%MomXAllt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%MomXAllt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MomXAllt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MomXAllt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%MomXAllt,1), UBOUND(OutData%MomXAllt,1) + OutData%MomXAllt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PFrcVGnRt not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -14734,15 +14442,12 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFrcVGnRt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PFrcVGnRt)>0) OutData%PFrcVGnRt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PFrcVGnRt))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PFrcVGnRt) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PFrcVGnRt,2), UBOUND(OutData%PFrcVGnRt,2) + DO i1 = LBOUND(OutData%PFrcVGnRt,1), UBOUND(OutData%PFrcVGnRt,1) + OutData%PFrcVGnRt(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PFrcWTail not allocated Int_Xferred = Int_Xferred + 1 @@ -14760,15 +14465,12 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFrcWTail.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PFrcWTail)>0) OutData%PFrcWTail = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PFrcWTail))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PFrcWTail) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PFrcWTail,2), UBOUND(OutData%PFrcWTail,2) + DO i1 = LBOUND(OutData%PFrcWTail,1), UBOUND(OutData%PFrcWTail,1) + OutData%PFrcWTail(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PFrcZAll not allocated Int_Xferred = Int_Xferred + 1 @@ -14786,15 +14488,12 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFrcZAll.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PFrcZAll)>0) OutData%PFrcZAll = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PFrcZAll))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PFrcZAll) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PFrcZAll,2), UBOUND(OutData%PFrcZAll,2) + DO i1 = LBOUND(OutData%PFrcZAll,1), UBOUND(OutData%PFrcZAll,1) + OutData%PFrcZAll(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PMomXAll not allocated Int_Xferred = Int_Xferred + 1 @@ -14812,24 +14511,21 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMomXAll.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PMomXAll)>0) OutData%PMomXAll = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PMomXAll))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PMomXAll) - DEALLOCATE(mask2) - END IF - OutData%TeetMom = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlMom = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlMom = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GBoxEffFac = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(OutData%PMomXAll,2), UBOUND(OutData%PMomXAll,2) + DO i1 = LBOUND(OutData%PMomXAll,1), UBOUND(OutData%PMomXAll,1) + OutData%PMomXAll(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%TeetMom = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlMom = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlMom = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GBoxEffFac = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rSAerCen not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -14849,15 +14545,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rSAerCen.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%rSAerCen)>0) OutData%rSAerCen = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%rSAerCen))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%rSAerCen) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%rSAerCen,3), UBOUND(OutData%rSAerCen,3) + DO i2 = LBOUND(OutData%rSAerCen,2), UBOUND(OutData%rSAerCen,2) + DO i1 = LBOUND(OutData%rSAerCen,1), UBOUND(OutData%rSAerCen,1) + OutData%rSAerCen(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF END SUBROUTINE ED_UnPackRtHndSide @@ -15001,8 +14696,10 @@ SUBROUTINE ED_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QT,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%QT)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%QT))-1 ) = PACK(InData%QT,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%QT) + DO i1 = LBOUND(InData%QT,1), UBOUND(InData%QT,1) + DbKiBuf(Db_Xferred) = InData%QT(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%QDT) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -15014,8 +14711,10 @@ SUBROUTINE ED_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QDT,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%QDT)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%QDT))-1 ) = PACK(InData%QDT,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%QDT) + DO i1 = LBOUND(InData%QDT,1), UBOUND(InData%QDT,1) + DbKiBuf(Db_Xferred) = InData%QDT(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF END SUBROUTINE ED_PackContState @@ -15032,12 +14731,6 @@ SUBROUTINE ED_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -15065,15 +14758,10 @@ SUBROUTINE ED_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QT.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%QT)>0) OutData%QT = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%QT))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%QT) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%QT,1), UBOUND(OutData%QT,1) + OutData%QT(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QDT not allocated Int_Xferred = Int_Xferred + 1 @@ -15088,15 +14776,10 @@ SUBROUTINE ED_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QDT.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%QDT)>0) OutData%QDT = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%QDT))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%QDT) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%QDT,1), UBOUND(OutData%QDT,1) + OutData%QDT(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO END IF END SUBROUTINE ED_UnPackContState @@ -15191,8 +14874,8 @@ SUBROUTINE ED_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyDiscState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE ED_PackDiscState SUBROUTINE ED_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -15208,12 +14891,6 @@ SUBROUTINE ED_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ED_UnPackDiscState' @@ -15227,8 +14904,8 @@ SUBROUTINE ED_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyDiscState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyDiscState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE ED_UnPackDiscState SUBROUTINE ED_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -15322,8 +14999,8 @@ SUBROUTINE ED_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyConstrState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE ED_PackConstrState SUBROUTINE ED_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -15339,12 +15016,6 @@ SUBROUTINE ED_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ED_UnPackConstrState' @@ -15358,8 +15029,8 @@ SUBROUTINE ED_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyConstrState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyConstrState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE ED_UnPackConstrState SUBROUTINE ED_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -15510,8 +15181,8 @@ SUBROUTINE ED_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%n - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%n + Int_Xferred = Int_Xferred + 1 DO i1 = LBOUND(InData%xdot,1), UBOUND(InData%xdot,1) CALL ED_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdot(i1), ErrStat2, ErrMsg2, OnlySize ) ! xdot CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -15552,17 +15223,21 @@ SUBROUTINE ED_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IC,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%IC)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%IC))-1 ) = PACK(InData%IC,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%IC) + DO i1 = LBOUND(InData%IC,1), UBOUND(InData%IC,1) + IntKiBuf(Int_Xferred) = InData%IC(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HSSBrTrq - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HSSBrTrqC - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%SgnPrvLSTQ - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%SgnLSTQ))-1 ) = PACK(InData%SgnLSTQ,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%SgnLSTQ) + ReKiBuf(Re_Xferred) = InData%HSSBrTrq + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HSSBrTrqC + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%SgnPrvLSTQ + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%SgnLSTQ,1), UBOUND(InData%SgnLSTQ,1) + IntKiBuf(Int_Xferred) = InData%SgnLSTQ(i1) + Int_Xferred = Int_Xferred + 1 + END DO END SUBROUTINE ED_PackOtherState SUBROUTINE ED_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -15578,12 +15253,6 @@ SUBROUTINE ED_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -15598,8 +15267,8 @@ SUBROUTINE ED_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%n = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%n = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%xdot,1) i1_u = UBOUND(OutData%xdot,1) DO i1 = LBOUND(OutData%xdot,1), UBOUND(OutData%xdot,1) @@ -15657,33 +15326,23 @@ SUBROUTINE ED_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IC.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%IC)>0) OutData%IC = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%IC))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%IC) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%IC,1), UBOUND(OutData%IC,1) + OutData%IC(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF - OutData%HSSBrTrq = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HSSBrTrqC = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SgnPrvLSTQ = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%HSSBrTrq = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HSSBrTrqC = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SgnPrvLSTQ = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%SgnLSTQ,1) i1_u = UBOUND(OutData%SgnLSTQ,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%SgnLSTQ = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%SgnLSTQ))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%SgnLSTQ) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%SgnLSTQ,1), UBOUND(OutData%SgnLSTQ,1) + OutData%SgnLSTQ(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END SUBROUTINE ED_UnPackOtherState SUBROUTINE ED_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -16032,8 +15691,10 @@ SUBROUTINE ED_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AllOuts,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AllOuts)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AllOuts))-1 ) = PACK(InData%AllOuts,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AllOuts) + DO i1 = LBOUND(InData%AllOuts,1), UBOUND(InData%AllOuts,1) + ReKiBuf(Re_Xferred) = InData%AllOuts(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%AugMat) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -16048,8 +15709,12 @@ SUBROUTINE ED_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AugMat,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AugMat)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%AugMat))-1 ) = PACK(InData%AugMat,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%AugMat) + DO i2 = LBOUND(InData%AugMat,2), UBOUND(InData%AugMat,2) + DO i1 = LBOUND(InData%AugMat,1), UBOUND(InData%AugMat,1) + DbKiBuf(Db_Xferred) = InData%AugMat(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%AugMat_factor) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -16064,8 +15729,12 @@ SUBROUTINE ED_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AugMat_factor,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AugMat_factor)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%AugMat_factor))-1 ) = PACK(InData%AugMat_factor,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%AugMat_factor) + DO i2 = LBOUND(InData%AugMat_factor,2), UBOUND(InData%AugMat_factor,2) + DO i1 = LBOUND(InData%AugMat_factor,1), UBOUND(InData%AugMat_factor,1) + DbKiBuf(Db_Xferred) = InData%AugMat_factor(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%SolnVec) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -16077,8 +15746,10 @@ SUBROUTINE ED_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SolnVec,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%SolnVec)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%SolnVec))-1 ) = PACK(InData%SolnVec,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%SolnVec) + DO i1 = LBOUND(InData%SolnVec,1), UBOUND(InData%SolnVec,1) + DbKiBuf(Db_Xferred) = InData%SolnVec(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%AugMat_pivot) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -16090,8 +15761,10 @@ SUBROUTINE ED_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AugMat_pivot,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AugMat_pivot)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%AugMat_pivot))-1 ) = PACK(InData%AugMat_pivot,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%AugMat_pivot) + DO i1 = LBOUND(InData%AugMat_pivot,1), UBOUND(InData%AugMat_pivot,1) + IntKiBuf(Int_Xferred) = InData%AugMat_pivot(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%OgnlGeAzRo) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -16103,8 +15776,10 @@ SUBROUTINE ED_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OgnlGeAzRo,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%OgnlGeAzRo)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%OgnlGeAzRo))-1 ) = PACK(InData%OgnlGeAzRo,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%OgnlGeAzRo) + DO i1 = LBOUND(InData%OgnlGeAzRo,1), UBOUND(InData%OgnlGeAzRo,1) + ReKiBuf(Re_Xferred) = InData%OgnlGeAzRo(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%QD2T) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -16116,11 +15791,13 @@ SUBROUTINE ED_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QD2T,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%QD2T)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%QD2T))-1 ) = PACK(InData%QD2T,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%QD2T) + DO i1 = LBOUND(InData%QD2T,1), UBOUND(InData%QD2T,1) + DbKiBuf(Db_Xferred) = InData%QD2T(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%IgnoreMod , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%IgnoreMod, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE ED_PackMisc SUBROUTINE ED_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -16136,12 +15813,6 @@ SUBROUTINE ED_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -16250,15 +15921,10 @@ SUBROUTINE ED_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOuts.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%AllOuts)>0) OutData%AllOuts = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AllOuts))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AllOuts) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AllOuts,1), UBOUND(OutData%AllOuts,1) + OutData%AllOuts(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AugMat not allocated Int_Xferred = Int_Xferred + 1 @@ -16276,15 +15942,12 @@ SUBROUTINE ED_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AugMat.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%AugMat)>0) OutData%AugMat = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%AugMat))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%AugMat) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AugMat,2), UBOUND(OutData%AugMat,2) + DO i1 = LBOUND(OutData%AugMat,1), UBOUND(OutData%AugMat,1) + OutData%AugMat(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AugMat_factor not allocated Int_Xferred = Int_Xferred + 1 @@ -16302,15 +15965,12 @@ SUBROUTINE ED_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AugMat_factor.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%AugMat_factor)>0) OutData%AugMat_factor = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%AugMat_factor))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%AugMat_factor) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AugMat_factor,2), UBOUND(OutData%AugMat_factor,2) + DO i1 = LBOUND(OutData%AugMat_factor,1), UBOUND(OutData%AugMat_factor,1) + OutData%AugMat_factor(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SolnVec not allocated Int_Xferred = Int_Xferred + 1 @@ -16325,15 +15985,10 @@ SUBROUTINE ED_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SolnVec.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%SolnVec)>0) OutData%SolnVec = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%SolnVec))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%SolnVec) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%SolnVec,1), UBOUND(OutData%SolnVec,1) + OutData%SolnVec(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AugMat_pivot not allocated Int_Xferred = Int_Xferred + 1 @@ -16348,15 +16003,10 @@ SUBROUTINE ED_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AugMat_pivot.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%AugMat_pivot)>0) OutData%AugMat_pivot = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%AugMat_pivot))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%AugMat_pivot) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AugMat_pivot,1), UBOUND(OutData%AugMat_pivot,1) + OutData%AugMat_pivot(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OgnlGeAzRo not allocated Int_Xferred = Int_Xferred + 1 @@ -16371,15 +16021,10 @@ SUBROUTINE ED_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OgnlGeAzRo.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%OgnlGeAzRo)>0) OutData%OgnlGeAzRo = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%OgnlGeAzRo))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%OgnlGeAzRo) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%OgnlGeAzRo,1), UBOUND(OutData%OgnlGeAzRo,1) + OutData%OgnlGeAzRo(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QD2T not allocated Int_Xferred = Int_Xferred + 1 @@ -16394,18 +16039,13 @@ SUBROUTINE ED_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QD2T.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%QD2T)>0) OutData%QD2T = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%QD2T))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%QD2T) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%QD2T,1), UBOUND(OutData%QD2T,1) + OutData%QD2T(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO END IF - OutData%IgnoreMod = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%IgnoreMod = TRANSFER(IntKiBuf(Int_Xferred), OutData%IgnoreMod) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE ED_UnPackMisc SUBROUTINE ED_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -18481,22 +18121,22 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT24 - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%BldNodes - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TipNode - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NDOF - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TwoPiNB - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NAug - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NPH - Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT24 + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%BldNodes + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TipNode + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NDOF + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%TwoPiNB + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NAug + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NPH + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%PH) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -18507,11 +18147,13 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PH,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PH)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%PH))-1 ) = PACK(InData%PH,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%PH) + DO i1 = LBOUND(InData%PH,1), UBOUND(InData%PH,1) + IntKiBuf(Int_Xferred) = InData%PH(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NPM - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NPM + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%PM) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -18525,8 +18167,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PM,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PM)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%PM))-1 ) = PACK(InData%PM,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%PM) + DO i2 = LBOUND(InData%PM,2), UBOUND(InData%PM,2) + DO i1 = LBOUND(InData%PM,1), UBOUND(InData%PM,1) + IntKiBuf(Int_Xferred) = InData%PM(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%DOF_Flag) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -18538,8 +18184,10 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DOF_Flag,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DOF_Flag)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%DOF_Flag)-1 ) = TRANSFER(PACK( InData%DOF_Flag ,.TRUE.), IntKiBuf(1), SIZE(InData%DOF_Flag)) - Int_Xferred = Int_Xferred + SIZE(InData%DOF_Flag) + DO i1 = LBOUND(InData%DOF_Flag,1), UBOUND(InData%DOF_Flag,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%DOF_Flag(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%DOF_Desc) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -18551,12 +18199,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DOF_Desc,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%DOF_Desc,1), UBOUND(InData%DOF_Desc,1) + DO i1 = LBOUND(InData%DOF_Desc,1), UBOUND(InData%DOF_Desc,1) DO I = 1, LEN(InData%DOF_Desc) IntKiBuf(Int_Xferred) = ICHAR(InData%DOF_Desc(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF CALL ED_Packactivedofs( Re_Buf, Db_Buf, Int_Buf, InData%DOFs, ErrStat2, ErrMsg2, OnlySize ) ! DOFs CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -18586,16 +18234,16 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NBlGages - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NTwGages - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%OutFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%NBlGages + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NTwGages + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -18637,16 +18285,16 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si ENDIF END DO END IF - DO I = 1, LEN(InData%Delim) - IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AvgNrmTpRd - Re_Xferred = Re_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%AzimB1Up - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%CosDel3 - Db_Xferred = Db_Xferred + 1 + DO I = 1, LEN(InData%Delim) + IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + ReKiBuf(Re_Xferred) = InData%AvgNrmTpRd + Re_Xferred = Re_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%AzimB1Up + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%CosDel3 + Db_Xferred = Db_Xferred + 1 IF ( .NOT. ALLOCATED(InData%CosPreC) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -18657,111 +18305,113 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CosPreC,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CosPreC)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%CosPreC))-1 ) = PACK(InData%CosPreC,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%CosPreC) - END IF - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%CRFrlSkew - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%CRFrlSkw2 - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%CRFrlTilt - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%CRFrlTlt2 - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%CShftSkew - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%CShftTilt - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%CSRFrlSkw - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%CSRFrlTlt - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%CSTFrlSkw - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%CSTFrlTlt - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%CTFinBank - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%CTFinSkew - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%CTFinTilt - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%CTFrlSkew - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%CTFrlSkw2 - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%CTFrlTilt - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%CTFrlTlt2 - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HubHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HubCM - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HubRad - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NacCMxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NacCMyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NacCMzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%OverHang - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ProjArea - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmRefzt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RefTwrHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlPntxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlPntyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlPntzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rVDxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rVDyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rVDzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rVIMUxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rVIMUyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rVIMUzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rVPxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rVPyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rVPzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rWIxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rWIyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rWIzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rWJxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rWJyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rWJzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rWKxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rWKyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rWKzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rZT0zt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rZYzt - Re_Xferred = Re_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%SinDel3 - Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(InData%CosPreC,1), UBOUND(InData%CosPreC,1) + DbKiBuf(Db_Xferred) = InData%CosPreC(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + DbKiBuf(Db_Xferred) = InData%CRFrlSkew + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%CRFrlSkw2 + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%CRFrlTilt + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%CRFrlTlt2 + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%CShftSkew + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%CShftTilt + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%CSRFrlSkw + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%CSRFrlTlt + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%CSTFrlSkw + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%CSTFrlTlt + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%CTFinBank + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%CTFinSkew + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%CTFinTilt + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%CTFrlSkew + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%CTFrlSkw2 + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%CTFrlTilt + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%CTFrlTlt2 + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HubHt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HubCM + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HubRad + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NacCMxn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NacCMyn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NacCMzn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%OverHang + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ProjArea + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmRefzt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RefTwrHt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlPntxn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlPntyn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlPntzn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rVDxn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rVDyn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rVDzn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rVIMUxn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rVIMUyn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rVIMUzn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rVPxn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rVPyn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rVPzn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rWIxn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rWIyn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rWIzn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rWJxn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rWJyn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rWJzn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rWKxn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rWKyn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rWKzn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rZT0zt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rZYzt + Re_Xferred = Re_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%SinDel3 + Db_Xferred = Db_Xferred + 1 IF ( .NOT. ALLOCATED(InData%SinPreC) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -18772,51 +18422,53 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SinPreC,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%SinPreC)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%SinPreC))-1 ) = PACK(InData%SinPreC,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%SinPreC) - END IF - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%SRFrlSkew - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%SRFrlSkw2 - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%SRFrlTilt - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%SRFrlTlt2 - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%SShftSkew - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%SShftTilt - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%STFinBank - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%STFinSkew - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%STFinTilt - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%STFrlSkew - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%STFrlSkw2 - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%STFrlTilt - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%STFrlTlt2 - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlPntxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlPntyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlPntzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TipRad - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TowerHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TowerBsHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%UndSling - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumBl - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%SinPreC,1), UBOUND(InData%SinPreC,1) + DbKiBuf(Db_Xferred) = InData%SinPreC(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + DbKiBuf(Db_Xferred) = InData%SRFrlSkew + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%SRFrlSkw2 + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%SRFrlTilt + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%SRFrlTlt2 + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%SShftSkew + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%SShftTilt + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%STFinBank + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%STFinSkew + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%STFinTilt + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%STFrlSkew + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%STFrlSkw2 + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%STFrlTilt + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%STFrlTlt2 + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlPntxn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlPntyn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlPntzn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TipRad + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TowerHt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TowerBsHt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%UndSling + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumBl + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%AxRedTFA) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -18833,8 +18485,14 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxRedTFA,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AxRedTFA)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AxRedTFA))-1 ) = PACK(InData%AxRedTFA,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AxRedTFA) + DO i3 = LBOUND(InData%AxRedTFA,3), UBOUND(InData%AxRedTFA,3) + DO i2 = LBOUND(InData%AxRedTFA,2), UBOUND(InData%AxRedTFA,2) + DO i1 = LBOUND(InData%AxRedTFA,1), UBOUND(InData%AxRedTFA,1) + ReKiBuf(Re_Xferred) = InData%AxRedTFA(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%AxRedTSS) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -18852,13 +18510,27 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxRedTSS,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AxRedTSS)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AxRedTSS))-1 ) = PACK(InData%AxRedTSS,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AxRedTSS) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CTFA))-1 ) = PACK(InData%CTFA,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CTFA) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CTSS))-1 ) = PACK(InData%CTSS,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CTSS) + DO i3 = LBOUND(InData%AxRedTSS,3), UBOUND(InData%AxRedTSS,3) + DO i2 = LBOUND(InData%AxRedTSS,2), UBOUND(InData%AxRedTSS,2) + DO i1 = LBOUND(InData%AxRedTSS,1), UBOUND(InData%AxRedTSS,1) + ReKiBuf(Re_Xferred) = InData%AxRedTSS(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + DO i2 = LBOUND(InData%CTFA,2), UBOUND(InData%CTFA,2) + DO i1 = LBOUND(InData%CTFA,1), UBOUND(InData%CTFA,1) + ReKiBuf(Re_Xferred) = InData%CTFA(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%CTSS,2), UBOUND(InData%CTSS,2) + DO i1 = LBOUND(InData%CTSS,1), UBOUND(InData%CTSS,1) + ReKiBuf(Re_Xferred) = InData%CTSS(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO IF ( .NOT. ALLOCATED(InData%DHNodes) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -18869,8 +18541,10 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DHNodes,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DHNodes)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DHNodes))-1 ) = PACK(InData%DHNodes,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DHNodes) + DO i1 = LBOUND(InData%DHNodes,1), UBOUND(InData%DHNodes,1) + ReKiBuf(Re_Xferred) = InData%DHNodes(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%HNodes) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -18882,8 +18556,10 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HNodes,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%HNodes)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%HNodes))-1 ) = PACK(InData%HNodes,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%HNodes) + DO i1 = LBOUND(InData%HNodes,1), UBOUND(InData%HNodes,1) + ReKiBuf(Re_Xferred) = InData%HNodes(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%HNodesNorm) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -18895,13 +18571,23 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HNodesNorm,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%HNodesNorm)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%HNodesNorm))-1 ) = PACK(InData%HNodesNorm,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%HNodesNorm) + DO i1 = LBOUND(InData%HNodesNorm,1), UBOUND(InData%HNodesNorm,1) + ReKiBuf(Re_Xferred) = InData%HNodesNorm(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%KTFA))-1 ) = PACK(InData%KTFA,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%KTFA) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%KTSS))-1 ) = PACK(InData%KTSS,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%KTSS) + DO i2 = LBOUND(InData%KTFA,2), UBOUND(InData%KTFA,2) + DO i1 = LBOUND(InData%KTFA,1), UBOUND(InData%KTFA,1) + ReKiBuf(Re_Xferred) = InData%KTFA(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%KTSS,2), UBOUND(InData%KTSS,2) + DO i1 = LBOUND(InData%KTSS,1), UBOUND(InData%KTSS,1) + ReKiBuf(Re_Xferred) = InData%KTSS(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO IF ( .NOT. ALLOCATED(InData%MassT) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -18912,8 +18598,10 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MassT,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%MassT)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MassT))-1 ) = PACK(InData%MassT,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MassT) + DO i1 = LBOUND(InData%MassT,1), UBOUND(InData%MassT,1) + ReKiBuf(Re_Xferred) = InData%MassT(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%StiffTSS) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -18925,8 +18613,10 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StiffTSS,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%StiffTSS)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%StiffTSS))-1 ) = PACK(InData%StiffTSS,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%StiffTSS) + DO i1 = LBOUND(InData%StiffTSS,1), UBOUND(InData%StiffTSS,1) + ReKiBuf(Re_Xferred) = InData%StiffTSS(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TwrFASF) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -18944,11 +18634,17 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrFASF,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwrFASF)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwrFASF))-1 ) = PACK(InData%TwrFASF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwrFASF) + DO i3 = LBOUND(InData%TwrFASF,3), UBOUND(InData%TwrFASF,3) + DO i2 = LBOUND(InData%TwrFASF,2), UBOUND(InData%TwrFASF,2) + DO i1 = LBOUND(InData%TwrFASF,1), UBOUND(InData%TwrFASF,1) + ReKiBuf(Re_Xferred) = InData%TwrFASF(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TwrFlexL - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TwrFlexL + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%TwrSSSF) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -18965,13 +18661,19 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrSSSF,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwrSSSF)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwrSSSF))-1 ) = PACK(InData%TwrSSSF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwrSSSF) + DO i3 = LBOUND(InData%TwrSSSF,3), UBOUND(InData%TwrSSSF,3) + DO i2 = LBOUND(InData%TwrSSSF,2), UBOUND(InData%TwrSSSF,2) + DO i1 = LBOUND(InData%TwrSSSF,1), UBOUND(InData%TwrSSSF,1) + ReKiBuf(Re_Xferred) = InData%TwrSSSF(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TTopNode - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TwrNodes - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TTopNode + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TwrNodes + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%InerTFA) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -18982,8 +18684,10 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InerTFA,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%InerTFA)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%InerTFA))-1 ) = PACK(InData%InerTFA,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%InerTFA) + DO i1 = LBOUND(InData%InerTFA,1), UBOUND(InData%InerTFA,1) + ReKiBuf(Re_Xferred) = InData%InerTFA(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%InerTSS) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -18995,8 +18699,10 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InerTSS,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%InerTSS)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%InerTSS))-1 ) = PACK(InData%InerTSS,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%InerTSS) + DO i1 = LBOUND(InData%InerTSS,1), UBOUND(InData%InerTSS,1) + ReKiBuf(Re_Xferred) = InData%InerTSS(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%StiffTGJ) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19008,8 +18714,10 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StiffTGJ,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%StiffTGJ)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%StiffTGJ))-1 ) = PACK(InData%StiffTGJ,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%StiffTGJ) + DO i1 = LBOUND(InData%StiffTGJ,1), UBOUND(InData%StiffTGJ,1) + ReKiBuf(Re_Xferred) = InData%StiffTGJ(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%StiffTEA) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19021,8 +18729,10 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StiffTEA,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%StiffTEA)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%StiffTEA))-1 ) = PACK(InData%StiffTEA,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%StiffTEA) + DO i1 = LBOUND(InData%StiffTEA,1), UBOUND(InData%StiffTEA,1) + ReKiBuf(Re_Xferred) = InData%StiffTEA(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%StiffTFA) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19034,8 +18744,10 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StiffTFA,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%StiffTFA)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%StiffTFA))-1 ) = PACK(InData%StiffTFA,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%StiffTFA) + DO i1 = LBOUND(InData%StiffTFA,1), UBOUND(InData%StiffTFA,1) + ReKiBuf(Re_Xferred) = InData%StiffTFA(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%cgOffTFA) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19047,8 +18759,10 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%cgOffTFA,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%cgOffTFA)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%cgOffTFA))-1 ) = PACK(InData%cgOffTFA,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%cgOffTFA) + DO i1 = LBOUND(InData%cgOffTFA,1), UBOUND(InData%cgOffTFA,1) + ReKiBuf(Re_Xferred) = InData%cgOffTFA(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%cgOffTSS) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19060,11 +18774,13 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%cgOffTSS,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%cgOffTSS)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%cgOffTSS))-1 ) = PACK(InData%cgOffTSS,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%cgOffTSS) + DO i1 = LBOUND(InData%cgOffTSS,1), UBOUND(InData%cgOffTSS,1) + ReKiBuf(Re_Xferred) = InData%cgOffTSS(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AtfaIner - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AtfaIner + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%BldCG) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -19075,8 +18791,10 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldCG,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BldCG)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BldCG))-1 ) = PACK(InData%BldCG,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BldCG) + DO i1 = LBOUND(InData%BldCG,1), UBOUND(InData%BldCG,1) + ReKiBuf(Re_Xferred) = InData%BldCG(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%BldMass) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19088,11 +18806,13 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldMass,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BldMass)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BldMass))-1 ) = PACK(InData%BldMass,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BldMass) + DO i1 = LBOUND(InData%BldMass,1), UBOUND(InData%BldMass,1) + ReKiBuf(Re_Xferred) = InData%BldMass(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%BoomMass - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%BoomMass + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%FirstMom) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -19103,37 +18823,39 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FirstMom,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FirstMom)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FirstMom))-1 ) = PACK(InData%FirstMom,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FirstMom) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GenIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Hubg1Iner - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Hubg2Iner - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HubMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Nacd2Iner - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NacMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmPIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmRIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmYIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RotIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RotMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RrfaIner - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%FirstMom,1), UBOUND(InData%FirstMom,1) + ReKiBuf(Re_Xferred) = InData%FirstMom(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%GenIner + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Hubg1Iner + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Hubg2Iner + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HubMass + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Nacd2Iner + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NacMass + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmMass + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmPIner + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmRIner + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmYIner + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlMass + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RotIner + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RotMass + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RrfaIner + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%SecondMom) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -19144,13 +18866,15 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SecondMom,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%SecondMom)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SecondMom))-1 ) = PACK(InData%SecondMom,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SecondMom) + DO i1 = LBOUND(InData%SecondMom,1), UBOUND(InData%SecondMom,1) + ReKiBuf(Re_Xferred) = InData%SecondMom(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFinMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlIner - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFinMass + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlIner + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%TipMass) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -19161,19 +18885,21 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TipMass,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TipMass)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TipMass))-1 ) = PACK(InData%TipMass,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TipMass) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TurbMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TwrMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TwrTpMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawBrMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Gravity - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%TipMass,1), UBOUND(InData%TipMass,1) + ReKiBuf(Re_Xferred) = InData%TipMass(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%TurbMass + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TwrMass + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TwrTpMass + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawBrMass + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Gravity + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%PitchAxis) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -19187,8 +18913,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PitchAxis,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PitchAxis)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PitchAxis))-1 ) = PACK(InData%PitchAxis,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PitchAxis) + DO i2 = LBOUND(InData%PitchAxis,2), UBOUND(InData%PitchAxis,2) + DO i1 = LBOUND(InData%PitchAxis,1), UBOUND(InData%PitchAxis,1) + ReKiBuf(Re_Xferred) = InData%PitchAxis(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%AeroTwst) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19200,8 +18930,10 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AeroTwst,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AeroTwst)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AeroTwst))-1 ) = PACK(InData%AeroTwst,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AeroTwst) + DO i1 = LBOUND(InData%AeroTwst,1), UBOUND(InData%AeroTwst,1) + ReKiBuf(Re_Xferred) = InData%AeroTwst(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%AxRedBld) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19222,8 +18954,16 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxRedBld,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AxRedBld)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AxRedBld))-1 ) = PACK(InData%AxRedBld,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AxRedBld) + DO i4 = LBOUND(InData%AxRedBld,4), UBOUND(InData%AxRedBld,4) + DO i3 = LBOUND(InData%AxRedBld,3), UBOUND(InData%AxRedBld,3) + DO i2 = LBOUND(InData%AxRedBld,2), UBOUND(InData%AxRedBld,2) + DO i1 = LBOUND(InData%AxRedBld,1), UBOUND(InData%AxRedBld,1) + ReKiBuf(Re_Xferred) = InData%AxRedBld(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%BAlpha) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19238,8 +18978,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BAlpha,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BAlpha)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BAlpha))-1 ) = PACK(InData%BAlpha,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BAlpha) + DO i2 = LBOUND(InData%BAlpha,2), UBOUND(InData%BAlpha,2) + DO i1 = LBOUND(InData%BAlpha,1), UBOUND(InData%BAlpha,1) + ReKiBuf(Re_Xferred) = InData%BAlpha(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%BldEDamp) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19254,8 +18998,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldEDamp,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BldEDamp)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BldEDamp))-1 ) = PACK(InData%BldEDamp,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BldEDamp) + DO i2 = LBOUND(InData%BldEDamp,2), UBOUND(InData%BldEDamp,2) + DO i1 = LBOUND(InData%BldEDamp,1), UBOUND(InData%BldEDamp,1) + ReKiBuf(Re_Xferred) = InData%BldEDamp(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%BldFDamp) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19270,11 +19018,15 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldFDamp,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BldFDamp)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BldFDamp))-1 ) = PACK(InData%BldFDamp,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BldFDamp) + DO i2 = LBOUND(InData%BldFDamp,2), UBOUND(InData%BldFDamp,2) + DO i1 = LBOUND(InData%BldFDamp,1), UBOUND(InData%BldFDamp,1) + ReKiBuf(Re_Xferred) = InData%BldFDamp(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%BldFlexL - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%BldFlexL + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%CAeroTwst) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -19285,8 +19037,10 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CAeroTwst,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CAeroTwst)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CAeroTwst))-1 ) = PACK(InData%CAeroTwst,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CAeroTwst) + DO i1 = LBOUND(InData%CAeroTwst,1), UBOUND(InData%CAeroTwst,1) + ReKiBuf(Re_Xferred) = InData%CAeroTwst(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%CBE) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19304,8 +19058,14 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CBE,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CBE)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CBE))-1 ) = PACK(InData%CBE,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CBE) + DO i3 = LBOUND(InData%CBE,3), UBOUND(InData%CBE,3) + DO i2 = LBOUND(InData%CBE,2), UBOUND(InData%CBE,2) + DO i1 = LBOUND(InData%CBE,1), UBOUND(InData%CBE,1) + ReKiBuf(Re_Xferred) = InData%CBE(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%CBF) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19323,8 +19083,14 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CBF,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CBF)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CBF))-1 ) = PACK(InData%CBF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CBF) + DO i3 = LBOUND(InData%CBF,3), UBOUND(InData%CBF,3) + DO i2 = LBOUND(InData%CBF,2), UBOUND(InData%CBF,2) + DO i1 = LBOUND(InData%CBF,1), UBOUND(InData%CBF,1) + ReKiBuf(Re_Xferred) = InData%CBF(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%cgOffBEdg) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19339,8 +19105,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%cgOffBEdg,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%cgOffBEdg)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%cgOffBEdg))-1 ) = PACK(InData%cgOffBEdg,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%cgOffBEdg) + DO i2 = LBOUND(InData%cgOffBEdg,2), UBOUND(InData%cgOffBEdg,2) + DO i1 = LBOUND(InData%cgOffBEdg,1), UBOUND(InData%cgOffBEdg,1) + ReKiBuf(Re_Xferred) = InData%cgOffBEdg(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%cgOffBFlp) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19355,8 +19125,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%cgOffBFlp,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%cgOffBFlp)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%cgOffBFlp))-1 ) = PACK(InData%cgOffBFlp,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%cgOffBFlp) + DO i2 = LBOUND(InData%cgOffBFlp,2), UBOUND(InData%cgOffBFlp,2) + DO i1 = LBOUND(InData%cgOffBFlp,1), UBOUND(InData%cgOffBFlp,1) + ReKiBuf(Re_Xferred) = InData%cgOffBFlp(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Chord) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19368,8 +19142,10 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Chord,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Chord)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Chord))-1 ) = PACK(InData%Chord,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Chord) + DO i1 = LBOUND(InData%Chord,1), UBOUND(InData%Chord,1) + ReKiBuf(Re_Xferred) = InData%Chord(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%CThetaS) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19384,8 +19160,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CThetaS,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CThetaS)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%CThetaS))-1 ) = PACK(InData%CThetaS,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%CThetaS) + DO i2 = LBOUND(InData%CThetaS,2), UBOUND(InData%CThetaS,2) + DO i1 = LBOUND(InData%CThetaS,1), UBOUND(InData%CThetaS,1) + DbKiBuf(Db_Xferred) = InData%CThetaS(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%DRNodes) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19397,8 +19177,10 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DRNodes,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DRNodes)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DRNodes))-1 ) = PACK(InData%DRNodes,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DRNodes) + DO i1 = LBOUND(InData%DRNodes,1), UBOUND(InData%DRNodes,1) + ReKiBuf(Re_Xferred) = InData%DRNodes(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%EAOffBEdg) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19413,8 +19195,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EAOffBEdg,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%EAOffBEdg)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%EAOffBEdg))-1 ) = PACK(InData%EAOffBEdg,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%EAOffBEdg) + DO i2 = LBOUND(InData%EAOffBEdg,2), UBOUND(InData%EAOffBEdg,2) + DO i1 = LBOUND(InData%EAOffBEdg,1), UBOUND(InData%EAOffBEdg,1) + ReKiBuf(Re_Xferred) = InData%EAOffBEdg(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%EAOffBFlp) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19429,8 +19215,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EAOffBFlp,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%EAOffBFlp)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%EAOffBFlp))-1 ) = PACK(InData%EAOffBFlp,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%EAOffBFlp) + DO i2 = LBOUND(InData%EAOffBFlp,2), UBOUND(InData%EAOffBFlp,2) + DO i1 = LBOUND(InData%EAOffBFlp,1), UBOUND(InData%EAOffBFlp,1) + ReKiBuf(Re_Xferred) = InData%EAOffBFlp(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FStTunr) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19445,8 +19235,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FStTunr,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FStTunr)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FStTunr))-1 ) = PACK(InData%FStTunr,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FStTunr) + DO i2 = LBOUND(InData%FStTunr,2), UBOUND(InData%FStTunr,2) + DO i1 = LBOUND(InData%FStTunr,1), UBOUND(InData%FStTunr,1) + ReKiBuf(Re_Xferred) = InData%FStTunr(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%InerBEdg) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19461,8 +19255,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InerBEdg,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%InerBEdg)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%InerBEdg))-1 ) = PACK(InData%InerBEdg,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%InerBEdg) + DO i2 = LBOUND(InData%InerBEdg,2), UBOUND(InData%InerBEdg,2) + DO i1 = LBOUND(InData%InerBEdg,1), UBOUND(InData%InerBEdg,1) + ReKiBuf(Re_Xferred) = InData%InerBEdg(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%InerBFlp) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19477,8 +19275,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InerBFlp,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%InerBFlp)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%InerBFlp))-1 ) = PACK(InData%InerBFlp,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%InerBFlp) + DO i2 = LBOUND(InData%InerBFlp,2), UBOUND(InData%InerBFlp,2) + DO i1 = LBOUND(InData%InerBFlp,1), UBOUND(InData%InerBFlp,1) + ReKiBuf(Re_Xferred) = InData%InerBFlp(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%KBE) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19496,8 +19298,14 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KBE,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%KBE)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%KBE))-1 ) = PACK(InData%KBE,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%KBE) + DO i3 = LBOUND(InData%KBE,3), UBOUND(InData%KBE,3) + DO i2 = LBOUND(InData%KBE,2), UBOUND(InData%KBE,2) + DO i1 = LBOUND(InData%KBE,1), UBOUND(InData%KBE,1) + ReKiBuf(Re_Xferred) = InData%KBE(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%KBF) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19515,8 +19323,14 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KBF,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%KBF)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%KBF))-1 ) = PACK(InData%KBF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%KBF) + DO i3 = LBOUND(InData%KBF,3), UBOUND(InData%KBF,3) + DO i2 = LBOUND(InData%KBF,2), UBOUND(InData%KBF,2) + DO i1 = LBOUND(InData%KBF,1), UBOUND(InData%KBF,1) + ReKiBuf(Re_Xferred) = InData%KBF(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%MassB) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19531,8 +19345,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MassB,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%MassB)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MassB))-1 ) = PACK(InData%MassB,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MassB) + DO i2 = LBOUND(InData%MassB,2), UBOUND(InData%MassB,2) + DO i1 = LBOUND(InData%MassB,1), UBOUND(InData%MassB,1) + ReKiBuf(Re_Xferred) = InData%MassB(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%RefAxisxb) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19547,8 +19365,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RefAxisxb,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RefAxisxb)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RefAxisxb))-1 ) = PACK(InData%RefAxisxb,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RefAxisxb) + DO i2 = LBOUND(InData%RefAxisxb,2), UBOUND(InData%RefAxisxb,2) + DO i1 = LBOUND(InData%RefAxisxb,1), UBOUND(InData%RefAxisxb,1) + ReKiBuf(Re_Xferred) = InData%RefAxisxb(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%RefAxisyb) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19563,8 +19385,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RefAxisyb,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RefAxisyb)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RefAxisyb))-1 ) = PACK(InData%RefAxisyb,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RefAxisyb) + DO i2 = LBOUND(InData%RefAxisyb,2), UBOUND(InData%RefAxisyb,2) + DO i1 = LBOUND(InData%RefAxisyb,1), UBOUND(InData%RefAxisyb,1) + ReKiBuf(Re_Xferred) = InData%RefAxisyb(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%RNodes) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19576,8 +19402,10 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RNodes,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RNodes)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RNodes))-1 ) = PACK(InData%RNodes,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RNodes) + DO i1 = LBOUND(InData%RNodes,1), UBOUND(InData%RNodes,1) + ReKiBuf(Re_Xferred) = InData%RNodes(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%RNodesNorm) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19589,8 +19417,10 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RNodesNorm,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RNodesNorm)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RNodesNorm))-1 ) = PACK(InData%RNodesNorm,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RNodesNorm) + DO i1 = LBOUND(InData%RNodesNorm,1), UBOUND(InData%RNodesNorm,1) + ReKiBuf(Re_Xferred) = InData%RNodesNorm(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%rSAerCenn1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19605,8 +19435,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rSAerCenn1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rSAerCenn1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%rSAerCenn1))-1 ) = PACK(InData%rSAerCenn1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%rSAerCenn1) + DO i2 = LBOUND(InData%rSAerCenn1,2), UBOUND(InData%rSAerCenn1,2) + DO i1 = LBOUND(InData%rSAerCenn1,1), UBOUND(InData%rSAerCenn1,1) + ReKiBuf(Re_Xferred) = InData%rSAerCenn1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%rSAerCenn2) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19621,8 +19455,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rSAerCenn2,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rSAerCenn2)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%rSAerCenn2))-1 ) = PACK(InData%rSAerCenn2,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%rSAerCenn2) + DO i2 = LBOUND(InData%rSAerCenn2,2), UBOUND(InData%rSAerCenn2,2) + DO i1 = LBOUND(InData%rSAerCenn2,1), UBOUND(InData%rSAerCenn2,1) + ReKiBuf(Re_Xferred) = InData%rSAerCenn2(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%SAeroTwst) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19634,8 +19472,10 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SAeroTwst,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%SAeroTwst)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SAeroTwst))-1 ) = PACK(InData%SAeroTwst,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SAeroTwst) + DO i1 = LBOUND(InData%SAeroTwst,1), UBOUND(InData%SAeroTwst,1) + ReKiBuf(Re_Xferred) = InData%SAeroTwst(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%StiffBE) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19650,8 +19490,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StiffBE,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%StiffBE)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%StiffBE))-1 ) = PACK(InData%StiffBE,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%StiffBE) + DO i2 = LBOUND(InData%StiffBE,2), UBOUND(InData%StiffBE,2) + DO i1 = LBOUND(InData%StiffBE,1), UBOUND(InData%StiffBE,1) + ReKiBuf(Re_Xferred) = InData%StiffBE(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%StiffBEA) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19666,8 +19510,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StiffBEA,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%StiffBEA)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%StiffBEA))-1 ) = PACK(InData%StiffBEA,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%StiffBEA) + DO i2 = LBOUND(InData%StiffBEA,2), UBOUND(InData%StiffBEA,2) + DO i1 = LBOUND(InData%StiffBEA,1), UBOUND(InData%StiffBEA,1) + ReKiBuf(Re_Xferred) = InData%StiffBEA(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%StiffBF) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19682,8 +19530,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StiffBF,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%StiffBF)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%StiffBF))-1 ) = PACK(InData%StiffBF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%StiffBF) + DO i2 = LBOUND(InData%StiffBF,2), UBOUND(InData%StiffBF,2) + DO i1 = LBOUND(InData%StiffBF,1), UBOUND(InData%StiffBF,1) + ReKiBuf(Re_Xferred) = InData%StiffBF(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%StiffBGJ) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19698,8 +19550,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StiffBGJ,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%StiffBGJ)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%StiffBGJ))-1 ) = PACK(InData%StiffBGJ,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%StiffBGJ) + DO i2 = LBOUND(InData%StiffBGJ,2), UBOUND(InData%StiffBGJ,2) + DO i1 = LBOUND(InData%StiffBGJ,1), UBOUND(InData%StiffBGJ,1) + ReKiBuf(Re_Xferred) = InData%StiffBGJ(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%SThetaS) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19714,8 +19570,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SThetaS,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%SThetaS)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%SThetaS))-1 ) = PACK(InData%SThetaS,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%SThetaS) + DO i2 = LBOUND(InData%SThetaS,2), UBOUND(InData%SThetaS,2) + DO i1 = LBOUND(InData%SThetaS,1), UBOUND(InData%SThetaS,1) + DbKiBuf(Db_Xferred) = InData%SThetaS(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%ThetaS) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19730,8 +19590,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ThetaS,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ThetaS)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%ThetaS))-1 ) = PACK(InData%ThetaS,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%ThetaS) + DO i2 = LBOUND(InData%ThetaS,2), UBOUND(InData%ThetaS,2) + DO i1 = LBOUND(InData%ThetaS,1), UBOUND(InData%ThetaS,1) + ReKiBuf(Re_Xferred) = InData%ThetaS(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%TwistedSF) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19755,8 +19619,18 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwistedSF,5) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwistedSF)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwistedSF))-1 ) = PACK(InData%TwistedSF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwistedSF) + DO i5 = LBOUND(InData%TwistedSF,5), UBOUND(InData%TwistedSF,5) + DO i4 = LBOUND(InData%TwistedSF,4), UBOUND(InData%TwistedSF,4) + DO i3 = LBOUND(InData%TwistedSF,3), UBOUND(InData%TwistedSF,3) + DO i2 = LBOUND(InData%TwistedSF,2), UBOUND(InData%TwistedSF,2) + DO i1 = LBOUND(InData%TwistedSF,1), UBOUND(InData%TwistedSF,1) + ReKiBuf(Re_Xferred) = InData%TwistedSF(i1,i2,i3,i4,i5) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%BldFl1Sh) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19771,8 +19645,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldFl1Sh,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BldFl1Sh)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BldFl1Sh))-1 ) = PACK(InData%BldFl1Sh,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BldFl1Sh) + DO i2 = LBOUND(InData%BldFl1Sh,2), UBOUND(InData%BldFl1Sh,2) + DO i1 = LBOUND(InData%BldFl1Sh,1), UBOUND(InData%BldFl1Sh,1) + ReKiBuf(Re_Xferred) = InData%BldFl1Sh(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%BldFl2Sh) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19787,8 +19665,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldFl2Sh,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BldFl2Sh)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BldFl2Sh))-1 ) = PACK(InData%BldFl2Sh,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BldFl2Sh) + DO i2 = LBOUND(InData%BldFl2Sh,2), UBOUND(InData%BldFl2Sh,2) + DO i1 = LBOUND(InData%BldFl2Sh,1), UBOUND(InData%BldFl2Sh,1) + ReKiBuf(Re_Xferred) = InData%BldFl2Sh(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%BldEdgSh) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19803,8 +19685,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldEdgSh,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BldEdgSh)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BldEdgSh))-1 ) = PACK(InData%BldEdgSh,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BldEdgSh) + DO i2 = LBOUND(InData%BldEdgSh,2), UBOUND(InData%BldEdgSh,2) + DO i1 = LBOUND(InData%BldEdgSh,1), UBOUND(InData%BldEdgSh,1) + ReKiBuf(Re_Xferred) = InData%BldEdgSh(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FreqBE) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19822,8 +19708,14 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FreqBE,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FreqBE)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FreqBE))-1 ) = PACK(InData%FreqBE,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FreqBE) + DO i3 = LBOUND(InData%FreqBE,3), UBOUND(InData%FreqBE,3) + DO i2 = LBOUND(InData%FreqBE,2), UBOUND(InData%FreqBE,2) + DO i1 = LBOUND(InData%FreqBE,1), UBOUND(InData%FreqBE,1) + ReKiBuf(Re_Xferred) = InData%FreqBE(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FreqBF) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19841,99 +19733,117 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FreqBF,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FreqBF)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FreqBF))-1 ) = PACK(InData%FreqBF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FreqBF) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FreqTFA))-1 ) = PACK(InData%FreqTFA,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FreqTFA) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FreqTSS))-1 ) = PACK(InData%FreqTSS,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FreqTSS) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TeetCDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TeetDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TeetDmpP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TeetHSSp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TeetHStP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TeetSSSp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TeetSStP - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TeetMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlCDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlDSDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlDSDP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlDSSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlDSSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlUSDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlUSDP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlUSSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlUSSpr - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TFrlMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlCDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlDSDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlDSDP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlDSSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlDSSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlUSDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlUSDP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlUSSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlUSSpr - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%RFrlMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ShftGagL - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%BldGagNd))-1 ) = PACK(InData%BldGagNd,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%BldGagNd) - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%TwrGagNd))-1 ) = PACK(InData%TwrGagNd,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%TwrGagNd) - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TStart - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DTTorDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DTTorSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GBRatio - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GBoxEff - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RotSpeed - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO i3 = LBOUND(InData%FreqBF,3), UBOUND(InData%FreqBF,3) + DO i2 = LBOUND(InData%FreqBF,2), UBOUND(InData%FreqBF,2) + DO i1 = LBOUND(InData%FreqBF,1), UBOUND(InData%FreqBF,1) + ReKiBuf(Re_Xferred) = InData%FreqBF(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + DO i2 = LBOUND(InData%FreqTFA,2), UBOUND(InData%FreqTFA,2) + DO i1 = LBOUND(InData%FreqTFA,1), UBOUND(InData%FreqTFA,1) + ReKiBuf(Re_Xferred) = InData%FreqTFA(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%FreqTSS,2), UBOUND(InData%FreqTSS,2) + DO i1 = LBOUND(InData%FreqTSS,1), UBOUND(InData%FreqTSS,1) + ReKiBuf(Re_Xferred) = InData%FreqTSS(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + ReKiBuf(Re_Xferred) = InData%TeetCDmp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TeetDmp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TeetDmpP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TeetHSSp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TeetHStP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TeetSSSp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TeetSStP + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TeetMod + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlCDmp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlDmp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlDSDmp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlDSDP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlDSSP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlDSSpr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlSpr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlUSDmp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlUSDP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlUSSP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlUSSpr + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TFrlMod + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlCDmp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlDmp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlDSDmp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlDSDP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlDSSP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlDSSpr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlSpr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlUSDmp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlUSDP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlUSSP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlUSSpr + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%RFrlMod + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ShftGagL + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%BldGagNd,1), UBOUND(InData%BldGagNd,1) + IntKiBuf(Int_Xferred) = InData%BldGagNd(i1) + Int_Xferred = Int_Xferred + 1 + END DO + DO i1 = LBOUND(InData%TwrGagNd,1), UBOUND(InData%TwrGagNd,1) + IntKiBuf(Int_Xferred) = InData%TwrGagNd(i1) + Int_Xferred = Int_Xferred + 1 + END DO + DbKiBuf(Db_Xferred) = InData%TStart + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DTTorDmp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DTTorSpr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GBRatio + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GBoxEff + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RotSpeed + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( .NOT. ALLOCATED(InData%BElmntMass) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -19947,8 +19857,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BElmntMass,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BElmntMass)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BElmntMass))-1 ) = PACK(InData%BElmntMass,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BElmntMass) + DO i2 = LBOUND(InData%BElmntMass,2), UBOUND(InData%BElmntMass,2) + DO i1 = LBOUND(InData%BElmntMass,1), UBOUND(InData%BElmntMass,1) + ReKiBuf(Re_Xferred) = InData%BElmntMass(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%TElmntMass) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19960,19 +19874,21 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TElmntMass,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TElmntMass)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TElmntMass))-1 ) = PACK(InData%TElmntMass,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TElmntMass) + DO i1 = LBOUND(InData%TElmntMass,1), UBOUND(InData%TElmntMass,1) + ReKiBuf(Re_Xferred) = InData%TElmntMass(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%method - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmCMxt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmCMyt - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%BD4Blades , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%UseAD14 , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%method + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmCMxt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmCMyt + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%BD4Blades, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%UseAD14, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%Jac_u_indx) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -19986,8 +19902,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Jac_u_indx)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%Jac_u_indx))-1 ) = PACK(InData%Jac_u_indx,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%Jac_u_indx) + DO i2 = LBOUND(InData%Jac_u_indx,2), UBOUND(InData%Jac_u_indx,2) + DO i1 = LBOUND(InData%Jac_u_indx,1), UBOUND(InData%Jac_u_indx,1) + IntKiBuf(Int_Xferred) = InData%Jac_u_indx(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%du) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19999,8 +19919,10 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%du,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%du)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%du))-1 ) = PACK(InData%du,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%du) + DO i1 = LBOUND(InData%du,1), UBOUND(InData%du,1) + DbKiBuf(Db_Xferred) = InData%du(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%dx) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -20012,11 +19934,13 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dx,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%dx)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%dx))-1 ) = PACK(InData%dx,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%dx) + DO i1 = LBOUND(InData%dx,1), UBOUND(InData%dx,1) + DbKiBuf(Db_Xferred) = InData%dx(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Jac_ny - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Jac_ny + Int_Xferred = Int_Xferred + 1 END SUBROUTINE ED_PackParam SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -20032,12 +19956,6 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -20056,22 +19974,22 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%DT24 = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%BldNodes = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TipNode = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NDOF = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TwoPiNB = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%NAug = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NPH = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%DT24 = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%BldNodes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TipNode = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NDOF = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TwoPiNB = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%NAug = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NPH = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PH not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -20085,18 +20003,13 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PH.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%PH)>0) OutData%PH = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%PH))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%PH) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%PH,1), UBOUND(OutData%PH,1) + OutData%PH(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF - OutData%NPM = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NPM = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PM not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -20113,15 +20026,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PM.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PM)>0) OutData%PM = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%PM))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%PM) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PM,2), UBOUND(OutData%PM,2) + DO i1 = LBOUND(OutData%PM,1), UBOUND(OutData%PM,1) + OutData%PM(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DOF_Flag not allocated Int_Xferred = Int_Xferred + 1 @@ -20136,15 +20046,10 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DOF_Flag.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%DOF_Flag)>0) OutData%DOF_Flag = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%DOF_Flag))-1 ), OutData%DOF_Flag), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%DOF_Flag) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%DOF_Flag,1), UBOUND(OutData%DOF_Flag,1) + OutData%DOF_Flag(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%DOF_Flag(i1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DOF_Desc not allocated Int_Xferred = Int_Xferred + 1 @@ -20159,19 +20064,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DOF_Desc.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%DOF_Desc,1), UBOUND(OutData%DOF_Desc,1) + DO i1 = LBOUND(OutData%DOF_Desc,1), UBOUND(OutData%DOF_Desc,1) DO I = 1, LEN(OutData%DOF_Desc) OutData%DOF_Desc(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -20213,16 +20111,16 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%NBlGages = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NTwGages = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%OutFmt) + OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%NBlGages = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NTwGages = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -20279,16 +20177,16 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%AvgNrmTpRd = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%AzimB1Up = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CosDel3 = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 + DO I = 1, LEN(OutData%Delim) + OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%AvgNrmTpRd = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AzimB1Up = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%CosDel3 = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CosPreC not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -20302,118 +20200,113 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CosPreC.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%CosPreC)>0) OutData%CosPreC = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%CosPreC))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%CosPreC) - DEALLOCATE(mask1) - END IF - OutData%CRFrlSkew = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CRFrlSkw2 = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CRFrlTilt = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CRFrlTlt2 = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CShftSkew = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CShftTilt = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CSRFrlSkw = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CSRFrlTlt = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CSTFrlSkw = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CSTFrlTlt = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CTFinBank = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CTFinSkew = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CTFinTilt = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CTFrlSkew = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CTFrlSkw2 = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CTFrlTilt = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CTFrlTlt2 = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%HubHt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HubCM = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HubRad = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NacCMxn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NacCMyn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NacCMzn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%OverHang = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%ProjArea = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmRefzt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RefTwrHt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlPntxn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlPntyn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlPntzn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rVDxn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rVDyn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rVDzn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rVIMUxn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rVIMUyn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rVIMUzn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rVPxn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rVPyn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rVPzn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rWIxn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rWIyn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rWIzn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rWJxn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rWJyn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rWJzn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rWKxn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rWKyn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rWKzn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rZT0zt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rZYzt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SinDel3 = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(OutData%CosPreC,1), UBOUND(OutData%CosPreC,1) + OutData%CosPreC(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + OutData%CRFrlSkew = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%CRFrlSkw2 = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%CRFrlTilt = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%CRFrlTlt2 = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%CShftSkew = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%CShftTilt = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%CSRFrlSkw = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%CSRFrlTlt = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%CSTFrlSkw = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%CSTFrlTlt = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%CTFinBank = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%CTFinSkew = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%CTFinTilt = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%CTFrlSkew = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%CTFrlSkw2 = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%CTFrlTilt = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%CTFrlTlt2 = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%HubHt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HubCM = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HubRad = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NacCMxn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NacCMyn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NacCMzn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%OverHang = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%ProjArea = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmRefzt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RefTwrHt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlPntxn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlPntyn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlPntzn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rVDxn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rVDyn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rVDzn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rVIMUxn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rVIMUyn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rVIMUzn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rVPxn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rVPyn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rVPzn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rWIxn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rWIyn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rWIzn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rWJxn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rWJyn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rWJzn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rWKxn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rWKyn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rWKzn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rZT0zt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rZYzt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SinDel3 = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SinPreC not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -20427,58 +20320,53 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SinPreC.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%SinPreC)>0) OutData%SinPreC = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%SinPreC))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%SinPreC) - DEALLOCATE(mask1) - END IF - OutData%SRFrlSkew = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%SRFrlSkw2 = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%SRFrlTilt = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%SRFrlTlt2 = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%SShftSkew = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%SShftTilt = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%STFinBank = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%STFinSkew = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%STFinTilt = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%STFrlSkew = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%STFrlSkw2 = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%STFrlTilt = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%STFrlTlt2 = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%TFrlPntxn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlPntyn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlPntzn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TipRad = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TowerHt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TowerBsHt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%UndSling = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NumBl = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%SinPreC,1), UBOUND(OutData%SinPreC,1) + OutData%SinPreC(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + OutData%SRFrlSkew = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%SRFrlSkw2 = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%SRFrlTilt = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%SRFrlTlt2 = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%SShftSkew = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%SShftTilt = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%STFinBank = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%STFinSkew = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%STFinTilt = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%STFrlSkew = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%STFrlSkw2 = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%STFrlTilt = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%STFrlTlt2 = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%TFrlPntxn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlPntyn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlPntzn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TipRad = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TowerHt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TowerBsHt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%UndSling = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NumBl = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AxRedTFA not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -20498,15 +20386,14 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxRedTFA.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%AxRedTFA)>0) OutData%AxRedTFA = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AxRedTFA))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AxRedTFA) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%AxRedTFA,3), UBOUND(OutData%AxRedTFA,3) + DO i2 = LBOUND(OutData%AxRedTFA,2), UBOUND(OutData%AxRedTFA,2) + DO i1 = LBOUND(OutData%AxRedTFA,1), UBOUND(OutData%AxRedTFA,1) + OutData%AxRedTFA(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 ! AxRedTSS not allocated Int_Xferred = Int_Xferred + 1 @@ -20527,42 +20414,35 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxRedTSS.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%AxRedTSS)>0) OutData%AxRedTSS = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AxRedTSS))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AxRedTSS) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%AxRedTSS,3), UBOUND(OutData%AxRedTSS,3) + DO i2 = LBOUND(OutData%AxRedTSS,2), UBOUND(OutData%AxRedTSS,2) + DO i1 = LBOUND(OutData%AxRedTSS,1), UBOUND(OutData%AxRedTSS,1) + OutData%AxRedTSS(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF i1_l = LBOUND(OutData%CTFA,1) i1_u = UBOUND(OutData%CTFA,1) i2_l = LBOUND(OutData%CTFA,2) i2_u = UBOUND(OutData%CTFA,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%CTFA = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CTFA))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CTFA) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%CTFA,2), UBOUND(OutData%CTFA,2) + DO i1 = LBOUND(OutData%CTFA,1), UBOUND(OutData%CTFA,1) + OutData%CTFA(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%CTSS,1) i1_u = UBOUND(OutData%CTSS,1) i2_l = LBOUND(OutData%CTSS,2) - i2_u = UBOUND(OutData%CTSS,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%CTSS = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CTSS))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CTSS) - DEALLOCATE(mask2) + i2_u = UBOUND(OutData%CTSS,2) + DO i2 = LBOUND(OutData%CTSS,2), UBOUND(OutData%CTSS,2) + DO i1 = LBOUND(OutData%CTSS,1), UBOUND(OutData%CTSS,1) + OutData%CTSS(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DHNodes not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -20576,15 +20456,10 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DHNodes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%DHNodes)>0) OutData%DHNodes = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DHNodes))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DHNodes) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%DHNodes,1), UBOUND(OutData%DHNodes,1) + OutData%DHNodes(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! HNodes not allocated Int_Xferred = Int_Xferred + 1 @@ -20599,15 +20474,10 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%HNodes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%HNodes)>0) OutData%HNodes = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%HNodes))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%HNodes) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%HNodes,1), UBOUND(OutData%HNodes,1) + OutData%HNodes(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! HNodesNorm not allocated Int_Xferred = Int_Xferred + 1 @@ -20622,42 +20492,31 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%HNodesNorm.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%HNodesNorm)>0) OutData%HNodesNorm = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%HNodesNorm))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%HNodesNorm) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%HNodesNorm,1), UBOUND(OutData%HNodesNorm,1) + OutData%HNodesNorm(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF i1_l = LBOUND(OutData%KTFA,1) i1_u = UBOUND(OutData%KTFA,1) i2_l = LBOUND(OutData%KTFA,2) i2_u = UBOUND(OutData%KTFA,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%KTFA = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%KTFA))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%KTFA) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%KTFA,2), UBOUND(OutData%KTFA,2) + DO i1 = LBOUND(OutData%KTFA,1), UBOUND(OutData%KTFA,1) + OutData%KTFA(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%KTSS,1) i1_u = UBOUND(OutData%KTSS,1) i2_l = LBOUND(OutData%KTSS,2) i2_u = UBOUND(OutData%KTSS,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%KTSS = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%KTSS))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%KTSS) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%KTSS,2), UBOUND(OutData%KTSS,2) + DO i1 = LBOUND(OutData%KTSS,1), UBOUND(OutData%KTSS,1) + OutData%KTSS(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MassT not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -20671,15 +20530,10 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MassT.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%MassT)>0) OutData%MassT = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MassT))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MassT) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%MassT,1), UBOUND(OutData%MassT,1) + OutData%MassT(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StiffTSS not allocated Int_Xferred = Int_Xferred + 1 @@ -20694,15 +20548,10 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StiffTSS.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%StiffTSS)>0) OutData%StiffTSS = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%StiffTSS))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%StiffTSS) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%StiffTSS,1), UBOUND(OutData%StiffTSS,1) + OutData%StiffTSS(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrFASF not allocated Int_Xferred = Int_Xferred + 1 @@ -20723,18 +20572,17 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrFASF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%TwrFASF)>0) OutData%TwrFASF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwrFASF))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwrFASF) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%TwrFASF,3), UBOUND(OutData%TwrFASF,3) + DO i2 = LBOUND(OutData%TwrFASF,2), UBOUND(OutData%TwrFASF,2) + DO i1 = LBOUND(OutData%TwrFASF,1), UBOUND(OutData%TwrFASF,1) + OutData%TwrFASF(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - OutData%TwrFlexL = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%TwrFlexL = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrSSSF not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -20754,20 +20602,19 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrSSSF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%TwrSSSF)>0) OutData%TwrSSSF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwrSSSF))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwrSSSF) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%TwrSSSF,3), UBOUND(OutData%TwrSSSF,3) + DO i2 = LBOUND(OutData%TwrSSSF,2), UBOUND(OutData%TwrSSSF,2) + DO i1 = LBOUND(OutData%TwrSSSF,1), UBOUND(OutData%TwrSSSF,1) + OutData%TwrSSSF(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - OutData%TTopNode = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TwrNodes = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%TTopNode = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TwrNodes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InerTFA not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -20781,15 +20628,10 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InerTFA.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%InerTFA)>0) OutData%InerTFA = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%InerTFA))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%InerTFA) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%InerTFA,1), UBOUND(OutData%InerTFA,1) + OutData%InerTFA(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InerTSS not allocated Int_Xferred = Int_Xferred + 1 @@ -20804,15 +20646,10 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InerTSS.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%InerTSS)>0) OutData%InerTSS = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%InerTSS))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%InerTSS) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%InerTSS,1), UBOUND(OutData%InerTSS,1) + OutData%InerTSS(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StiffTGJ not allocated Int_Xferred = Int_Xferred + 1 @@ -20827,15 +20664,10 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StiffTGJ.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%StiffTGJ)>0) OutData%StiffTGJ = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%StiffTGJ))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%StiffTGJ) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%StiffTGJ,1), UBOUND(OutData%StiffTGJ,1) + OutData%StiffTGJ(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StiffTEA not allocated Int_Xferred = Int_Xferred + 1 @@ -20850,15 +20682,10 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StiffTEA.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%StiffTEA)>0) OutData%StiffTEA = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%StiffTEA))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%StiffTEA) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%StiffTEA,1), UBOUND(OutData%StiffTEA,1) + OutData%StiffTEA(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StiffTFA not allocated Int_Xferred = Int_Xferred + 1 @@ -20873,15 +20700,10 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StiffTFA.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%StiffTFA)>0) OutData%StiffTFA = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%StiffTFA))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%StiffTFA) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%StiffTFA,1), UBOUND(OutData%StiffTFA,1) + OutData%StiffTFA(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! cgOffTFA not allocated Int_Xferred = Int_Xferred + 1 @@ -20896,15 +20718,10 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%cgOffTFA.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%cgOffTFA)>0) OutData%cgOffTFA = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%cgOffTFA))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%cgOffTFA) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%cgOffTFA,1), UBOUND(OutData%cgOffTFA,1) + OutData%cgOffTFA(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! cgOffTSS not allocated Int_Xferred = Int_Xferred + 1 @@ -20919,18 +20736,13 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%cgOffTSS.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%cgOffTSS)>0) OutData%cgOffTSS = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%cgOffTSS))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%cgOffTSS) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%cgOffTSS,1), UBOUND(OutData%cgOffTSS,1) + OutData%cgOffTSS(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%AtfaIner = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%AtfaIner = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldCG not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -20944,15 +20756,10 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldCG.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BldCG)>0) OutData%BldCG = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BldCG))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BldCG) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BldCG,1), UBOUND(OutData%BldCG,1) + OutData%BldCG(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldMass not allocated Int_Xferred = Int_Xferred + 1 @@ -20967,18 +20774,13 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldMass.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BldMass)>0) OutData%BldMass = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BldMass))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BldMass) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BldMass,1), UBOUND(OutData%BldMass,1) + OutData%BldMass(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%BoomMass = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%BoomMass = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FirstMom not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -20992,44 +20794,39 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FirstMom.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%FirstMom)>0) OutData%FirstMom = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FirstMom))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FirstMom) - DEALLOCATE(mask1) - END IF - OutData%GenIner = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Hubg1Iner = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Hubg2Iner = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HubMass = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Nacd2Iner = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NacMass = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmMass = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmPIner = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmRIner = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmYIner = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlMass = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RotIner = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RotMass = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RrfaIner = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%FirstMom,1), UBOUND(OutData%FirstMom,1) + OutData%FirstMom(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%GenIner = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Hubg1Iner = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Hubg2Iner = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HubMass = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Nacd2Iner = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NacMass = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmMass = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmPIner = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmRIner = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmYIner = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlMass = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RotIner = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RotMass = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RrfaIner = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SecondMom not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -21043,20 +20840,15 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SecondMom.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%SecondMom)>0) OutData%SecondMom = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SecondMom))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SecondMom) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%SecondMom,1), UBOUND(OutData%SecondMom,1) + OutData%SecondMom(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%TFinMass = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlIner = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%TFinMass = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlIner = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TipMass not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -21070,26 +20862,21 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TipMass.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TipMass)>0) OutData%TipMass = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TipMass))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TipMass) - DEALLOCATE(mask1) - END IF - OutData%TurbMass = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TwrMass = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TwrTpMass = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawBrMass = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Gravity = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%TipMass,1), UBOUND(OutData%TipMass,1) + OutData%TipMass(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%TurbMass = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TwrMass = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TwrTpMass = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawBrMass = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Gravity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PitchAxis not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -21106,15 +20893,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PitchAxis.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PitchAxis)>0) OutData%PitchAxis = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PitchAxis))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PitchAxis) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PitchAxis,2), UBOUND(OutData%PitchAxis,2) + DO i1 = LBOUND(OutData%PitchAxis,1), UBOUND(OutData%PitchAxis,1) + OutData%PitchAxis(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AeroTwst not allocated Int_Xferred = Int_Xferred + 1 @@ -21129,15 +20913,10 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AeroTwst.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%AeroTwst)>0) OutData%AeroTwst = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AeroTwst))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AeroTwst) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AeroTwst,1), UBOUND(OutData%AeroTwst,1) + OutData%AeroTwst(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AxRedBld not allocated Int_Xferred = Int_Xferred + 1 @@ -21161,15 +20940,16 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxRedBld.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%AxRedBld)>0) OutData%AxRedBld = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AxRedBld))-1 ), mask4, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AxRedBld) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%AxRedBld,4), UBOUND(OutData%AxRedBld,4) + DO i3 = LBOUND(OutData%AxRedBld,3), UBOUND(OutData%AxRedBld,3) + DO i2 = LBOUND(OutData%AxRedBld,2), UBOUND(OutData%AxRedBld,2) + DO i1 = LBOUND(OutData%AxRedBld,1), UBOUND(OutData%AxRedBld,1) + OutData%AxRedBld(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BAlpha not allocated Int_Xferred = Int_Xferred + 1 @@ -21187,15 +20967,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BAlpha.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%BAlpha)>0) OutData%BAlpha = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BAlpha))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BAlpha) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%BAlpha,2), UBOUND(OutData%BAlpha,2) + DO i1 = LBOUND(OutData%BAlpha,1), UBOUND(OutData%BAlpha,1) + OutData%BAlpha(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldEDamp not allocated Int_Xferred = Int_Xferred + 1 @@ -21213,15 +20990,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldEDamp.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%BldEDamp)>0) OutData%BldEDamp = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BldEDamp))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BldEDamp) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%BldEDamp,2), UBOUND(OutData%BldEDamp,2) + DO i1 = LBOUND(OutData%BldEDamp,1), UBOUND(OutData%BldEDamp,1) + OutData%BldEDamp(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldFDamp not allocated Int_Xferred = Int_Xferred + 1 @@ -21239,18 +21013,15 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldFDamp.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%BldFDamp)>0) OutData%BldFDamp = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BldFDamp))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BldFDamp) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%BldFDamp,2), UBOUND(OutData%BldFDamp,2) + DO i1 = LBOUND(OutData%BldFDamp,1), UBOUND(OutData%BldFDamp,1) + OutData%BldFDamp(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%BldFlexL = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%BldFlexL = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CAeroTwst not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -21264,15 +21035,10 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CAeroTwst.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%CAeroTwst)>0) OutData%CAeroTwst = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CAeroTwst))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CAeroTwst) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%CAeroTwst,1), UBOUND(OutData%CAeroTwst,1) + OutData%CAeroTwst(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CBE not allocated Int_Xferred = Int_Xferred + 1 @@ -21293,15 +21059,14 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CBE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%CBE)>0) OutData%CBE = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CBE))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CBE) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%CBE,3), UBOUND(OutData%CBE,3) + DO i2 = LBOUND(OutData%CBE,2), UBOUND(OutData%CBE,2) + DO i1 = LBOUND(OutData%CBE,1), UBOUND(OutData%CBE,1) + OutData%CBE(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 ! CBF not allocated Int_Xferred = Int_Xferred + 1 @@ -21322,15 +21087,14 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CBF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%CBF)>0) OutData%CBF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CBF))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CBF) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%CBF,3), UBOUND(OutData%CBF,3) + DO i2 = LBOUND(OutData%CBF,2), UBOUND(OutData%CBF,2) + DO i1 = LBOUND(OutData%CBF,1), UBOUND(OutData%CBF,1) + OutData%CBF(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 ! cgOffBEdg not allocated Int_Xferred = Int_Xferred + 1 @@ -21348,15 +21112,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%cgOffBEdg.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%cgOffBEdg)>0) OutData%cgOffBEdg = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%cgOffBEdg))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%cgOffBEdg) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%cgOffBEdg,2), UBOUND(OutData%cgOffBEdg,2) + DO i1 = LBOUND(OutData%cgOffBEdg,1), UBOUND(OutData%cgOffBEdg,1) + OutData%cgOffBEdg(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! cgOffBFlp not allocated Int_Xferred = Int_Xferred + 1 @@ -21374,15 +21135,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%cgOffBFlp.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%cgOffBFlp)>0) OutData%cgOffBFlp = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%cgOffBFlp))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%cgOffBFlp) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%cgOffBFlp,2), UBOUND(OutData%cgOffBFlp,2) + DO i1 = LBOUND(OutData%cgOffBFlp,1), UBOUND(OutData%cgOffBFlp,1) + OutData%cgOffBFlp(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Chord not allocated Int_Xferred = Int_Xferred + 1 @@ -21397,15 +21155,10 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Chord.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Chord)>0) OutData%Chord = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Chord))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Chord) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Chord,1), UBOUND(OutData%Chord,1) + OutData%Chord(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CThetaS not allocated Int_Xferred = Int_Xferred + 1 @@ -21423,15 +21176,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CThetaS.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%CThetaS)>0) OutData%CThetaS = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%CThetaS))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%CThetaS) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%CThetaS,2), UBOUND(OutData%CThetaS,2) + DO i1 = LBOUND(OutData%CThetaS,1), UBOUND(OutData%CThetaS,1) + OutData%CThetaS(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DRNodes not allocated Int_Xferred = Int_Xferred + 1 @@ -21446,15 +21196,10 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DRNodes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%DRNodes)>0) OutData%DRNodes = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DRNodes))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DRNodes) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%DRNodes,1), UBOUND(OutData%DRNodes,1) + OutData%DRNodes(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! EAOffBEdg not allocated Int_Xferred = Int_Xferred + 1 @@ -21472,15 +21217,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%EAOffBEdg.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%EAOffBEdg)>0) OutData%EAOffBEdg = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%EAOffBEdg))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%EAOffBEdg) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%EAOffBEdg,2), UBOUND(OutData%EAOffBEdg,2) + DO i1 = LBOUND(OutData%EAOffBEdg,1), UBOUND(OutData%EAOffBEdg,1) + OutData%EAOffBEdg(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! EAOffBFlp not allocated Int_Xferred = Int_Xferred + 1 @@ -21498,15 +21240,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%EAOffBFlp.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%EAOffBFlp)>0) OutData%EAOffBFlp = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%EAOffBFlp))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%EAOffBFlp) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%EAOffBFlp,2), UBOUND(OutData%EAOffBFlp,2) + DO i1 = LBOUND(OutData%EAOffBFlp,1), UBOUND(OutData%EAOffBFlp,1) + OutData%EAOffBFlp(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FStTunr not allocated Int_Xferred = Int_Xferred + 1 @@ -21524,15 +21263,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FStTunr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%FStTunr)>0) OutData%FStTunr = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FStTunr))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FStTunr) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%FStTunr,2), UBOUND(OutData%FStTunr,2) + DO i1 = LBOUND(OutData%FStTunr,1), UBOUND(OutData%FStTunr,1) + OutData%FStTunr(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InerBEdg not allocated Int_Xferred = Int_Xferred + 1 @@ -21550,15 +21286,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InerBEdg.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%InerBEdg)>0) OutData%InerBEdg = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%InerBEdg))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%InerBEdg) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%InerBEdg,2), UBOUND(OutData%InerBEdg,2) + DO i1 = LBOUND(OutData%InerBEdg,1), UBOUND(OutData%InerBEdg,1) + OutData%InerBEdg(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InerBFlp not allocated Int_Xferred = Int_Xferred + 1 @@ -21576,15 +21309,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InerBFlp.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%InerBFlp)>0) OutData%InerBFlp = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%InerBFlp))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%InerBFlp) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%InerBFlp,2), UBOUND(OutData%InerBFlp,2) + DO i1 = LBOUND(OutData%InerBFlp,1), UBOUND(OutData%InerBFlp,1) + OutData%InerBFlp(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! KBE not allocated Int_Xferred = Int_Xferred + 1 @@ -21605,15 +21335,14 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%KBE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%KBE)>0) OutData%KBE = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%KBE))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%KBE) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%KBE,3), UBOUND(OutData%KBE,3) + DO i2 = LBOUND(OutData%KBE,2), UBOUND(OutData%KBE,2) + DO i1 = LBOUND(OutData%KBE,1), UBOUND(OutData%KBE,1) + OutData%KBE(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 ! KBF not allocated Int_Xferred = Int_Xferred + 1 @@ -21634,15 +21363,14 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%KBF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%KBF)>0) OutData%KBF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%KBF))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%KBF) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%KBF,3), UBOUND(OutData%KBF,3) + DO i2 = LBOUND(OutData%KBF,2), UBOUND(OutData%KBF,2) + DO i1 = LBOUND(OutData%KBF,1), UBOUND(OutData%KBF,1) + OutData%KBF(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 ! MassB not allocated Int_Xferred = Int_Xferred + 1 @@ -21660,15 +21388,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MassB.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%MassB)>0) OutData%MassB = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MassB))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MassB) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%MassB,2), UBOUND(OutData%MassB,2) + DO i1 = LBOUND(OutData%MassB,1), UBOUND(OutData%MassB,1) + OutData%MassB(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RefAxisxb not allocated Int_Xferred = Int_Xferred + 1 @@ -21686,15 +21411,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RefAxisxb.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%RefAxisxb)>0) OutData%RefAxisxb = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RefAxisxb))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RefAxisxb) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%RefAxisxb,2), UBOUND(OutData%RefAxisxb,2) + DO i1 = LBOUND(OutData%RefAxisxb,1), UBOUND(OutData%RefAxisxb,1) + OutData%RefAxisxb(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RefAxisyb not allocated Int_Xferred = Int_Xferred + 1 @@ -21712,15 +21434,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RefAxisyb.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%RefAxisyb)>0) OutData%RefAxisyb = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RefAxisyb))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RefAxisyb) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%RefAxisyb,2), UBOUND(OutData%RefAxisyb,2) + DO i1 = LBOUND(OutData%RefAxisyb,1), UBOUND(OutData%RefAxisyb,1) + OutData%RefAxisyb(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RNodes not allocated Int_Xferred = Int_Xferred + 1 @@ -21735,15 +21454,10 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RNodes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RNodes)>0) OutData%RNodes = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RNodes))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RNodes) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%RNodes,1), UBOUND(OutData%RNodes,1) + OutData%RNodes(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RNodesNorm not allocated Int_Xferred = Int_Xferred + 1 @@ -21758,15 +21472,10 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RNodesNorm.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RNodesNorm)>0) OutData%RNodesNorm = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RNodesNorm))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RNodesNorm) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%RNodesNorm,1), UBOUND(OutData%RNodesNorm,1) + OutData%RNodesNorm(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rSAerCenn1 not allocated Int_Xferred = Int_Xferred + 1 @@ -21784,15 +21493,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rSAerCenn1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%rSAerCenn1)>0) OutData%rSAerCenn1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%rSAerCenn1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%rSAerCenn1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%rSAerCenn1,2), UBOUND(OutData%rSAerCenn1,2) + DO i1 = LBOUND(OutData%rSAerCenn1,1), UBOUND(OutData%rSAerCenn1,1) + OutData%rSAerCenn1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rSAerCenn2 not allocated Int_Xferred = Int_Xferred + 1 @@ -21810,15 +21516,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rSAerCenn2.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%rSAerCenn2)>0) OutData%rSAerCenn2 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%rSAerCenn2))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%rSAerCenn2) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%rSAerCenn2,2), UBOUND(OutData%rSAerCenn2,2) + DO i1 = LBOUND(OutData%rSAerCenn2,1), UBOUND(OutData%rSAerCenn2,1) + OutData%rSAerCenn2(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SAeroTwst not allocated Int_Xferred = Int_Xferred + 1 @@ -21833,15 +21536,10 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SAeroTwst.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%SAeroTwst)>0) OutData%SAeroTwst = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SAeroTwst))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SAeroTwst) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%SAeroTwst,1), UBOUND(OutData%SAeroTwst,1) + OutData%SAeroTwst(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StiffBE not allocated Int_Xferred = Int_Xferred + 1 @@ -21859,15 +21557,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StiffBE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%StiffBE)>0) OutData%StiffBE = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%StiffBE))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%StiffBE) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%StiffBE,2), UBOUND(OutData%StiffBE,2) + DO i1 = LBOUND(OutData%StiffBE,1), UBOUND(OutData%StiffBE,1) + OutData%StiffBE(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StiffBEA not allocated Int_Xferred = Int_Xferred + 1 @@ -21885,15 +21580,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StiffBEA.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%StiffBEA)>0) OutData%StiffBEA = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%StiffBEA))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%StiffBEA) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%StiffBEA,2), UBOUND(OutData%StiffBEA,2) + DO i1 = LBOUND(OutData%StiffBEA,1), UBOUND(OutData%StiffBEA,1) + OutData%StiffBEA(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StiffBF not allocated Int_Xferred = Int_Xferred + 1 @@ -21911,15 +21603,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StiffBF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%StiffBF)>0) OutData%StiffBF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%StiffBF))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%StiffBF) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%StiffBF,2), UBOUND(OutData%StiffBF,2) + DO i1 = LBOUND(OutData%StiffBF,1), UBOUND(OutData%StiffBF,1) + OutData%StiffBF(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StiffBGJ not allocated Int_Xferred = Int_Xferred + 1 @@ -21937,15 +21626,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StiffBGJ.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%StiffBGJ)>0) OutData%StiffBGJ = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%StiffBGJ))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%StiffBGJ) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%StiffBGJ,2), UBOUND(OutData%StiffBGJ,2) + DO i1 = LBOUND(OutData%StiffBGJ,1), UBOUND(OutData%StiffBGJ,1) + OutData%StiffBGJ(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SThetaS not allocated Int_Xferred = Int_Xferred + 1 @@ -21963,15 +21649,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SThetaS.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%SThetaS)>0) OutData%SThetaS = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%SThetaS))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%SThetaS) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%SThetaS,2), UBOUND(OutData%SThetaS,2) + DO i1 = LBOUND(OutData%SThetaS,1), UBOUND(OutData%SThetaS,1) + OutData%SThetaS(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ThetaS not allocated Int_Xferred = Int_Xferred + 1 @@ -21989,15 +21672,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ThetaS.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%ThetaS)>0) OutData%ThetaS = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%ThetaS))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%ThetaS) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%ThetaS,2), UBOUND(OutData%ThetaS,2) + DO i1 = LBOUND(OutData%ThetaS,1), UBOUND(OutData%ThetaS,1) + OutData%ThetaS(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwistedSF not allocated Int_Xferred = Int_Xferred + 1 @@ -22024,15 +21704,18 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwistedSF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask5(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask5.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask5 = .TRUE. - IF (SIZE(OutData%TwistedSF)>0) OutData%TwistedSF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwistedSF))-1 ), mask5, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwistedSF) - DEALLOCATE(mask5) + DO i5 = LBOUND(OutData%TwistedSF,5), UBOUND(OutData%TwistedSF,5) + DO i4 = LBOUND(OutData%TwistedSF,4), UBOUND(OutData%TwistedSF,4) + DO i3 = LBOUND(OutData%TwistedSF,3), UBOUND(OutData%TwistedSF,3) + DO i2 = LBOUND(OutData%TwistedSF,2), UBOUND(OutData%TwistedSF,2) + DO i1 = LBOUND(OutData%TwistedSF,1), UBOUND(OutData%TwistedSF,1) + OutData%TwistedSF(i1,i2,i3,i4,i5) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldFl1Sh not allocated Int_Xferred = Int_Xferred + 1 @@ -22050,15 +21733,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldFl1Sh.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%BldFl1Sh)>0) OutData%BldFl1Sh = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BldFl1Sh))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BldFl1Sh) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%BldFl1Sh,2), UBOUND(OutData%BldFl1Sh,2) + DO i1 = LBOUND(OutData%BldFl1Sh,1), UBOUND(OutData%BldFl1Sh,1) + OutData%BldFl1Sh(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldFl2Sh not allocated Int_Xferred = Int_Xferred + 1 @@ -22076,15 +21756,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldFl2Sh.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%BldFl2Sh)>0) OutData%BldFl2Sh = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BldFl2Sh))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BldFl2Sh) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%BldFl2Sh,2), UBOUND(OutData%BldFl2Sh,2) + DO i1 = LBOUND(OutData%BldFl2Sh,1), UBOUND(OutData%BldFl2Sh,1) + OutData%BldFl2Sh(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldEdgSh not allocated Int_Xferred = Int_Xferred + 1 @@ -22102,15 +21779,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldEdgSh.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%BldEdgSh)>0) OutData%BldEdgSh = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BldEdgSh))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BldEdgSh) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%BldEdgSh,2), UBOUND(OutData%BldEdgSh,2) + DO i1 = LBOUND(OutData%BldEdgSh,1), UBOUND(OutData%BldEdgSh,1) + OutData%BldEdgSh(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FreqBE not allocated Int_Xferred = Int_Xferred + 1 @@ -22131,15 +21805,14 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FreqBE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%FreqBE)>0) OutData%FreqBE = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FreqBE))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FreqBE) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%FreqBE,3), UBOUND(OutData%FreqBE,3) + DO i2 = LBOUND(OutData%FreqBE,2), UBOUND(OutData%FreqBE,2) + DO i1 = LBOUND(OutData%FreqBE,1), UBOUND(OutData%FreqBE,1) + OutData%FreqBE(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 ! FreqBF not allocated Int_Xferred = Int_Xferred + 1 @@ -22160,146 +21833,129 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FreqBF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%FreqBF)>0) OutData%FreqBF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FreqBF))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FreqBF) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%FreqBF,3), UBOUND(OutData%FreqBF,3) + DO i2 = LBOUND(OutData%FreqBF,2), UBOUND(OutData%FreqBF,2) + DO i1 = LBOUND(OutData%FreqBF,1), UBOUND(OutData%FreqBF,1) + OutData%FreqBF(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF i1_l = LBOUND(OutData%FreqTFA,1) i1_u = UBOUND(OutData%FreqTFA,1) i2_l = LBOUND(OutData%FreqTFA,2) i2_u = UBOUND(OutData%FreqTFA,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%FreqTFA = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FreqTFA))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FreqTFA) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%FreqTFA,2), UBOUND(OutData%FreqTFA,2) + DO i1 = LBOUND(OutData%FreqTFA,1), UBOUND(OutData%FreqTFA,1) + OutData%FreqTFA(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%FreqTSS,1) i1_u = UBOUND(OutData%FreqTSS,1) i2_l = LBOUND(OutData%FreqTSS,2) i2_u = UBOUND(OutData%FreqTSS,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%FreqTSS = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FreqTSS))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FreqTSS) - DEALLOCATE(mask2) - OutData%TeetCDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TeetDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TeetDmpP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TeetHSSp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TeetHStP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TeetSSSp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TeetSStP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TeetMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TFrlCDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlDSDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlDSDP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlDSSP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlDSSpr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlSpr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlUSDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlUSDP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlUSSP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlUSSpr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%RFrlCDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlDSDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlDSDP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlDSSP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlDSSpr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlSpr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlUSDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlUSDP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlUSSP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlUSSpr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ShftGagL = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(OutData%FreqTSS,2), UBOUND(OutData%FreqTSS,2) + DO i1 = LBOUND(OutData%FreqTSS,1), UBOUND(OutData%FreqTSS,1) + OutData%FreqTSS(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + OutData%TeetCDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TeetDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TeetDmpP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TeetHSSp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TeetHStP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TeetSSSp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TeetSStP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TeetMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TFrlCDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlDSDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlDSDP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlDSSP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlDSSpr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlSpr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlUSDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlUSDP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlUSSP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlUSSpr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%RFrlCDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlDSDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlDSDP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlDSSP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlDSSpr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlSpr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlUSDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlUSDP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlUSSP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlUSSpr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ShftGagL = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%BldGagNd,1) i1_u = UBOUND(OutData%BldGagNd,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%BldGagNd = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%BldGagNd))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%BldGagNd) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BldGagNd,1), UBOUND(OutData%BldGagNd,1) + OutData%BldGagNd(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO i1_l = LBOUND(OutData%TwrGagNd,1) i1_u = UBOUND(OutData%TwrGagNd,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%TwrGagNd = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%TwrGagNd))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%TwrGagNd) - DEALLOCATE(mask1) - OutData%TStart = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%DTTorDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%DTTorSpr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GBRatio = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GBoxEff = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RotSpeed = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO i1 = LBOUND(OutData%TwrGagNd,1), UBOUND(OutData%TwrGagNd,1) + OutData%TwrGagNd(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + OutData%TStart = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%DTTorDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%DTTorSpr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GBRatio = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GBoxEff = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RotSpeed = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BElmntMass not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -22316,15 +21972,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BElmntMass.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%BElmntMass)>0) OutData%BElmntMass = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BElmntMass))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BElmntMass) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%BElmntMass,2), UBOUND(OutData%BElmntMass,2) + DO i1 = LBOUND(OutData%BElmntMass,1), UBOUND(OutData%BElmntMass,1) + OutData%BElmntMass(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TElmntMass not allocated Int_Xferred = Int_Xferred + 1 @@ -22339,26 +21992,21 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TElmntMass.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TElmntMass)>0) OutData%TElmntMass = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TElmntMass))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TElmntMass) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TElmntMass,1), UBOUND(OutData%TElmntMass,1) + OutData%TElmntMass(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%method = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmCMxt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmCMyt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%BD4Blades = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%UseAD14 = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%method = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%PtfmCMxt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmCMyt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%BD4Blades = TRANSFER(IntKiBuf(Int_Xferred), OutData%BD4Blades) + Int_Xferred = Int_Xferred + 1 + OutData%UseAD14 = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseAD14) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_u_indx not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -22375,15 +22023,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Jac_u_indx)>0) OutData%Jac_u_indx = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%Jac_u_indx))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%Jac_u_indx) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Jac_u_indx,2), UBOUND(OutData%Jac_u_indx,2) + DO i1 = LBOUND(OutData%Jac_u_indx,1), UBOUND(OutData%Jac_u_indx,1) + OutData%Jac_u_indx(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! du not allocated Int_Xferred = Int_Xferred + 1 @@ -22398,15 +22043,10 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%du.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%du)>0) OutData%du = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%du))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%du) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%du,1), UBOUND(OutData%du,1) + OutData%du(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dx not allocated Int_Xferred = Int_Xferred + 1 @@ -22421,18 +22061,13 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%dx)>0) OutData%dx = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%dx))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%dx) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%dx,1), UBOUND(OutData%dx,1) + OutData%dx(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO END IF - OutData%Jac_ny = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%Jac_ny = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE ED_UnPackParam SUBROUTINE ED_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -22878,11 +22513,21 @@ SUBROUTINE ED_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrAddedMass,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwrAddedMass)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwrAddedMass))-1 ) = PACK(InData%TwrAddedMass,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwrAddedMass) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PtfmAddedMass))-1 ) = PACK(InData%PtfmAddedMass,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PtfmAddedMass) + DO i3 = LBOUND(InData%TwrAddedMass,3), UBOUND(InData%TwrAddedMass,3) + DO i2 = LBOUND(InData%TwrAddedMass,2), UBOUND(InData%TwrAddedMass,2) + DO i1 = LBOUND(InData%TwrAddedMass,1), UBOUND(InData%TwrAddedMass,1) + ReKiBuf(Re_Xferred) = InData%TwrAddedMass(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + DO i2 = LBOUND(InData%PtfmAddedMass,2), UBOUND(InData%PtfmAddedMass,2) + DO i1 = LBOUND(InData%PtfmAddedMass,1), UBOUND(InData%PtfmAddedMass,1) + ReKiBuf(Re_Xferred) = InData%PtfmAddedMass(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO IF ( .NOT. ALLOCATED(InData%BlPitchCom) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -22893,15 +22538,17 @@ SUBROUTINE ED_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlPitchCom,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BlPitchCom)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlPitchCom))-1 ) = PACK(InData%BlPitchCom,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlPitchCom) + DO i1 = LBOUND(InData%BlPitchCom,1), UBOUND(InData%BlPitchCom,1) + ReKiBuf(Re_Xferred) = InData%BlPitchCom(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawMom - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GenTrq - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HSSBrTrqC - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawMom + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GenTrq + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HSSBrTrqC + Re_Xferred = Re_Xferred + 1 END SUBROUTINE ED_PackInput SUBROUTINE ED_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -22917,12 +22564,6 @@ SUBROUTINE ED_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -23174,29 +22815,25 @@ SUBROUTINE ED_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrAddedMass.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%TwrAddedMass)>0) OutData%TwrAddedMass = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwrAddedMass))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwrAddedMass) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%TwrAddedMass,3), UBOUND(OutData%TwrAddedMass,3) + DO i2 = LBOUND(OutData%TwrAddedMass,2), UBOUND(OutData%TwrAddedMass,2) + DO i1 = LBOUND(OutData%TwrAddedMass,1), UBOUND(OutData%TwrAddedMass,1) + OutData%TwrAddedMass(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF i1_l = LBOUND(OutData%PtfmAddedMass,1) i1_u = UBOUND(OutData%PtfmAddedMass,1) i2_l = LBOUND(OutData%PtfmAddedMass,2) i2_u = UBOUND(OutData%PtfmAddedMass,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%PtfmAddedMass = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PtfmAddedMass))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PtfmAddedMass) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PtfmAddedMass,2), UBOUND(OutData%PtfmAddedMass,2) + DO i1 = LBOUND(OutData%PtfmAddedMass,1), UBOUND(OutData%PtfmAddedMass,1) + OutData%PtfmAddedMass(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlPitchCom not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -23210,22 +22847,17 @@ SUBROUTINE ED_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitchCom.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BlPitchCom)>0) OutData%BlPitchCom = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlPitchCom))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlPitchCom) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BlPitchCom,1), UBOUND(OutData%BlPitchCom,1) + OutData%BlPitchCom(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%YawMom = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GenTrq = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HSSBrTrqC = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%YawMom = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GenTrq = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HSSBrTrqC = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE ED_UnPackInput SUBROUTINE ED_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -23979,8 +23611,10 @@ SUBROUTINE ED_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WriteOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%BlPitch) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -23992,55 +23626,61 @@ SUBROUTINE ED_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlPitch,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BlPitch)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlPitch))-1 ) = PACK(InData%BlPitch,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlPitch) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Yaw - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawRate - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%LSS_Spd - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HSS_Spd - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RotSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TwrAccel - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawAngle - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RootMyc))-1 ) = PACK(InData%RootMyc,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RootMyc) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawBrTAxp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawBrTAyp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%LSSTipPxa - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RootMxc))-1 ) = PACK(InData%RootMxc,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RootMxc) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%LSSTipMxa - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%LSSTipMya - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%LSSTipMza - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%LSSTipMys - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%LSSTipMzs - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawBrMyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawBrMzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NcIMURAxs - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NcIMURAys - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NcIMURAzs - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RotPwr - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%BlPitch,1), UBOUND(InData%BlPitch,1) + ReKiBuf(Re_Xferred) = InData%BlPitch(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%Yaw + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawRate + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%LSS_Spd + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HSS_Spd + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RotSpeed + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TwrAccel + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawAngle + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%RootMyc,1), UBOUND(InData%RootMyc,1) + ReKiBuf(Re_Xferred) = InData%RootMyc(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%YawBrTAxp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawBrTAyp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%LSSTipPxa + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%RootMxc,1), UBOUND(InData%RootMxc,1) + ReKiBuf(Re_Xferred) = InData%RootMxc(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%LSSTipMxa + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%LSSTipMya + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%LSSTipMza + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%LSSTipMys + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%LSSTipMzs + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawBrMyn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawBrMzn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NcIMURAxs + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NcIMURAys + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NcIMURAzs + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RotPwr + Re_Xferred = Re_Xferred + 1 END SUBROUTINE ED_PackOutput SUBROUTINE ED_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -24056,12 +23696,6 @@ SUBROUTINE ED_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -24521,15 +24155,10 @@ SUBROUTINE ED_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WriteOutput)>0) OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlPitch not allocated Int_Xferred = Int_Xferred + 1 @@ -24544,80 +24173,65 @@ SUBROUTINE ED_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitch.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BlPitch)>0) OutData%BlPitch = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlPitch))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlPitch) - DEALLOCATE(mask1) - END IF - OutData%Yaw = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawRate = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%LSS_Spd = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HSS_Spd = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RotSpeed = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TwrAccel = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawAngle = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%BlPitch,1), UBOUND(OutData%BlPitch,1) + OutData%BlPitch(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%Yaw = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawRate = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LSS_Spd = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HSS_Spd = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RotSpeed = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TwrAccel = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawAngle = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%RootMyc,1) i1_u = UBOUND(OutData%RootMyc,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%RootMyc = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RootMyc))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RootMyc) - DEALLOCATE(mask1) - OutData%YawBrTAxp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawBrTAyp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipPxa = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%RootMyc,1), UBOUND(OutData%RootMyc,1) + OutData%RootMyc(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%YawBrTAxp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawBrTAyp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LSSTipPxa = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%RootMxc,1) i1_u = UBOUND(OutData%RootMxc,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%RootMxc = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RootMxc))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RootMxc) - DEALLOCATE(mask1) - OutData%LSSTipMxa = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipMya = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipMza = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipMys = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipMzs = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawBrMyn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawBrMzn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NcIMURAxs = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NcIMURAys = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NcIMURAzs = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RotPwr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%RootMxc,1), UBOUND(OutData%RootMxc,1) + OutData%RootMxc(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%LSSTipMxa = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LSSTipMya = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LSSTipMza = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LSSTipMys = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LSSTipMzs = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawBrMyn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawBrMzn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NcIMURAxs = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NcIMURAys = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NcIMURAzs = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RotPwr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE ED_UnPackOutput @@ -24695,17 +24309,16 @@ SUBROUTINE ED_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'ED_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: b3 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: c3 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! 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 :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + INTEGER :: i3 ! dim3 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -24718,9 +24331,11 @@ SUBROUTINE ED_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ALLOCATED(u_out%BladePtLoads) .AND. ALLOCATED(u1%BladePtLoads)) THEN - DO i01 = LBOUND(u_out%BladePtLoads,1),UBOUND(u_out%BladePtLoads,1) - CALL MeshExtrapInterp1(u1%BladePtLoads(i01), u2%BladePtLoads(i01), tin, u_out%BladePtLoads(i01), tin_out, ErrStat2, ErrMsg2 ) + 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) ENDDO END IF ! check if allocated @@ -24733,35 +24348,33 @@ SUBROUTINE ED_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) CALL MeshExtrapInterp1(u1%NacelleLoads, u2%NacelleLoads, tin, u_out%NacelleLoads, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(u_out%TwrAddedMass) .AND. ALLOCATED(u1%TwrAddedMass)) THEN - ALLOCATE(b3(SIZE(u_out%TwrAddedMass,1),SIZE(u_out%TwrAddedMass,2), & - SIZE(u_out%TwrAddedMass,3) )) - ALLOCATE(c3(SIZE(u_out%TwrAddedMass,1),SIZE(u_out%TwrAddedMass,2), & - SIZE(u_out%TwrAddedMass,3) )) - b3 = -(u1%TwrAddedMass - u2%TwrAddedMass)/t(2) - u_out%TwrAddedMass = u1%TwrAddedMass + b3 * t_out - DEALLOCATE(b3) - DEALLOCATE(c3) + DO i3 = LBOUND(u_out%TwrAddedMass,3),UBOUND(u_out%TwrAddedMass,3) + DO i2 = LBOUND(u_out%TwrAddedMass,2),UBOUND(u_out%TwrAddedMass,2) + DO i1 = LBOUND(u_out%TwrAddedMass,1),UBOUND(u_out%TwrAddedMass,1) + b = -(u1%TwrAddedMass(i1,i2,i3) - u2%TwrAddedMass(i1,i2,i3)) + u_out%TwrAddedMass(i1,i2,i3) = u1%TwrAddedMass(i1,i2,i3) + b * ScaleFactor + END DO + END DO + END DO END IF ! check if allocated - ALLOCATE(b2(SIZE(u_out%PtfmAddedMass,1),SIZE(u_out%PtfmAddedMass,2) )) - ALLOCATE(c2(SIZE(u_out%PtfmAddedMass,1),SIZE(u_out%PtfmAddedMass,2) )) - b2 = -(u1%PtfmAddedMass - u2%PtfmAddedMass)/t(2) - u_out%PtfmAddedMass = u1%PtfmAddedMass + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%PtfmAddedMass,2),UBOUND(u_out%PtfmAddedMass,2) + DO i1 = LBOUND(u_out%PtfmAddedMass,1),UBOUND(u_out%PtfmAddedMass,1) + b = -(u1%PtfmAddedMass(i1,i2) - u2%PtfmAddedMass(i1,i2)) + u_out%PtfmAddedMass(i1,i2) = u1%PtfmAddedMass(i1,i2) + b * ScaleFactor + END DO + END DO IF (ALLOCATED(u_out%BlPitchCom) .AND. ALLOCATED(u1%BlPitchCom)) THEN - ALLOCATE(b1(SIZE(u_out%BlPitchCom,1))) - ALLOCATE(c1(SIZE(u_out%BlPitchCom,1))) - b1 = -(u1%BlPitchCom - u2%BlPitchCom)/t(2) - u_out%BlPitchCom = u1%BlPitchCom + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%BlPitchCom,1),UBOUND(u_out%BlPitchCom,1) + b = -(u1%BlPitchCom(i1) - u2%BlPitchCom(i1)) + u_out%BlPitchCom(i1) = u1%BlPitchCom(i1) + b * ScaleFactor + END DO END IF ! check if allocated - b0 = -(u1%YawMom - u2%YawMom)/t(2) - u_out%YawMom = u1%YawMom + b0 * t_out - b0 = -(u1%GenTrq - u2%GenTrq)/t(2) - u_out%GenTrq = u1%GenTrq + b0 * t_out - b0 = -(u1%HSSBrTrqC - u2%HSSBrTrqC)/t(2) - u_out%HSSBrTrqC = u1%HSSBrTrqC + b0 * t_out + b = -(u1%YawMom - u2%YawMom) + u_out%YawMom = u1%YawMom + b * ScaleFactor + b = -(u1%GenTrq - u2%GenTrq) + u_out%GenTrq = u1%GenTrq + b * ScaleFactor + b = -(u1%HSSBrTrqC - u2%HSSBrTrqC) + u_out%HSSBrTrqC = u1%HSSBrTrqC + b * ScaleFactor END SUBROUTINE ED_Input_ExtrapInterp1 @@ -24791,18 +24404,18 @@ SUBROUTINE ED_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: b3 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: c3 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'ED_Input_ExtrapInterp2' INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + INTEGER :: i3 ! dim3 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -24821,9 +24434,11 @@ SUBROUTINE ED_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ALLOCATED(u_out%BladePtLoads) .AND. ALLOCATED(u1%BladePtLoads)) THEN - DO i01 = LBOUND(u_out%BladePtLoads,1),UBOUND(u_out%BladePtLoads,1) - CALL MeshExtrapInterp2(u1%BladePtLoads(i01), u2%BladePtLoads(i01), u3%BladePtLoads(i01), tin, u_out%BladePtLoads(i01), tin_out, ErrStat2, ErrMsg2 ) + 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) ENDDO END IF ! check if allocated @@ -24836,41 +24451,39 @@ SUBROUTINE ED_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM CALL MeshExtrapInterp2(u1%NacelleLoads, u2%NacelleLoads, u3%NacelleLoads, tin, u_out%NacelleLoads, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(u_out%TwrAddedMass) .AND. ALLOCATED(u1%TwrAddedMass)) THEN - ALLOCATE(b3(SIZE(u_out%TwrAddedMass,1),SIZE(u_out%TwrAddedMass,2), & - SIZE(u_out%TwrAddedMass,3) )) - ALLOCATE(c3(SIZE(u_out%TwrAddedMass,1),SIZE(u_out%TwrAddedMass,2), & - SIZE(u_out%TwrAddedMass,3) )) - b3 = (t(3)**2*(u1%TwrAddedMass - u2%TwrAddedMass) + t(2)**2*(-u1%TwrAddedMass + u3%TwrAddedMass))/(t(2)*t(3)*(t(2) - t(3))) - c3 = ( (t(2)-t(3))*u1%TwrAddedMass + t(3)*u2%TwrAddedMass - t(2)*u3%TwrAddedMass ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TwrAddedMass = u1%TwrAddedMass + b3 * t_out + c3 * t_out**2 - DEALLOCATE(b3) - DEALLOCATE(c3) + DO i3 = LBOUND(u_out%TwrAddedMass,3),UBOUND(u_out%TwrAddedMass,3) + DO i2 = LBOUND(u_out%TwrAddedMass,2),UBOUND(u_out%TwrAddedMass,2) + DO i1 = LBOUND(u_out%TwrAddedMass,1),UBOUND(u_out%TwrAddedMass,1) + b = (t(3)**2*(u1%TwrAddedMass(i1,i2,i3) - u2%TwrAddedMass(i1,i2,i3)) + t(2)**2*(-u1%TwrAddedMass(i1,i2,i3) + u3%TwrAddedMass(i1,i2,i3)))* scaleFactor + c = ( (t(2)-t(3))*u1%TwrAddedMass(i1,i2,i3) + t(3)*u2%TwrAddedMass(i1,i2,i3) - t(2)*u3%TwrAddedMass(i1,i2,i3) ) * scaleFactor + u_out%TwrAddedMass(i1,i2,i3) = u1%TwrAddedMass(i1,i2,i3) + b + c * t_out + END DO + END DO + END DO END IF ! check if allocated - ALLOCATE(b2(SIZE(u_out%PtfmAddedMass,1),SIZE(u_out%PtfmAddedMass,2) )) - ALLOCATE(c2(SIZE(u_out%PtfmAddedMass,1),SIZE(u_out%PtfmAddedMass,2) )) - b2 = (t(3)**2*(u1%PtfmAddedMass - u2%PtfmAddedMass) + t(2)**2*(-u1%PtfmAddedMass + u3%PtfmAddedMass))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%PtfmAddedMass + t(3)*u2%PtfmAddedMass - t(2)*u3%PtfmAddedMass ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%PtfmAddedMass = u1%PtfmAddedMass + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%PtfmAddedMass,2),UBOUND(u_out%PtfmAddedMass,2) + DO i1 = LBOUND(u_out%PtfmAddedMass,1),UBOUND(u_out%PtfmAddedMass,1) + b = (t(3)**2*(u1%PtfmAddedMass(i1,i2) - u2%PtfmAddedMass(i1,i2)) + t(2)**2*(-u1%PtfmAddedMass(i1,i2) + u3%PtfmAddedMass(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%PtfmAddedMass(i1,i2) + t(3)*u2%PtfmAddedMass(i1,i2) - t(2)*u3%PtfmAddedMass(i1,i2) ) * scaleFactor + u_out%PtfmAddedMass(i1,i2) = u1%PtfmAddedMass(i1,i2) + b + c * t_out + END DO + END DO IF (ALLOCATED(u_out%BlPitchCom) .AND. ALLOCATED(u1%BlPitchCom)) THEN - ALLOCATE(b1(SIZE(u_out%BlPitchCom,1))) - ALLOCATE(c1(SIZE(u_out%BlPitchCom,1))) - b1 = (t(3)**2*(u1%BlPitchCom - u2%BlPitchCom) + t(2)**2*(-u1%BlPitchCom + u3%BlPitchCom))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%BlPitchCom + t(3)*u2%BlPitchCom - t(2)*u3%BlPitchCom ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%BlPitchCom = u1%BlPitchCom + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%BlPitchCom,1),UBOUND(u_out%BlPitchCom,1) + b = (t(3)**2*(u1%BlPitchCom(i1) - u2%BlPitchCom(i1)) + t(2)**2*(-u1%BlPitchCom(i1) + u3%BlPitchCom(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%BlPitchCom(i1) + t(3)*u2%BlPitchCom(i1) - t(2)*u3%BlPitchCom(i1) ) * scaleFactor + u_out%BlPitchCom(i1) = u1%BlPitchCom(i1) + b + c * t_out + END DO END IF ! check if allocated - b0 = (t(3)**2*(u1%YawMom - u2%YawMom) + t(2)**2*(-u1%YawMom + u3%YawMom))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%YawMom + t(3)*u2%YawMom - t(2)*u3%YawMom ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%YawMom = u1%YawMom + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%GenTrq - u2%GenTrq) + t(2)**2*(-u1%GenTrq + u3%GenTrq))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%GenTrq + t(3)*u2%GenTrq - t(2)*u3%GenTrq ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%GenTrq = u1%GenTrq + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%HSSBrTrqC - u2%HSSBrTrqC) + t(2)**2*(-u1%HSSBrTrqC + u3%HSSBrTrqC))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%HSSBrTrqC + t(3)*u2%HSSBrTrqC - t(2)*u3%HSSBrTrqC ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%HSSBrTrqC = u1%HSSBrTrqC + b0 * t_out + c0 * t_out**2 + b = (t(3)**2*(u1%YawMom - u2%YawMom) + t(2)**2*(-u1%YawMom + u3%YawMom))* scaleFactor + c = ( (t(2)-t(3))*u1%YawMom + t(3)*u2%YawMom - t(2)*u3%YawMom ) * scaleFactor + u_out%YawMom = u1%YawMom + b + c * t_out + b = (t(3)**2*(u1%GenTrq - u2%GenTrq) + t(2)**2*(-u1%GenTrq + u3%GenTrq))* scaleFactor + c = ( (t(2)-t(3))*u1%GenTrq + t(3)*u2%GenTrq - t(2)*u3%GenTrq ) * scaleFactor + u_out%GenTrq = u1%GenTrq + b + c * t_out + b = (t(3)**2*(u1%HSSBrTrqC - u2%HSSBrTrqC) + t(2)**2*(-u1%HSSBrTrqC + u3%HSSBrTrqC))* scaleFactor + c = ( (t(2)-t(3))*u1%HSSBrTrqC + t(3)*u2%HSSBrTrqC - t(2)*u3%HSSBrTrqC ) * scaleFactor + u_out%HSSBrTrqC = u1%HSSBrTrqC + b + c * t_out END SUBROUTINE ED_Input_ExtrapInterp2 @@ -24948,13 +24561,12 @@ SUBROUTINE ED_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'ED_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! 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 :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -24967,9 +24579,11 @@ SUBROUTINE ED_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ALLOCATED(y_out%BladeLn2Mesh) .AND. ALLOCATED(y1%BladeLn2Mesh)) THEN - DO i01 = LBOUND(y_out%BladeLn2Mesh,1),UBOUND(y_out%BladeLn2Mesh,1) - CALL MeshExtrapInterp1(y1%BladeLn2Mesh(i01), y2%BladeLn2Mesh(i01), tin, y_out%BladeLn2Mesh(i01), tin_out, ErrStat2, ErrMsg2 ) + 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) ENDDO END IF ! check if allocated @@ -24984,8 +24598,8 @@ SUBROUTINE ED_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg CALL MeshExtrapInterp1(y1%BladeRootMotion14, y2%BladeRootMotion14, tin, y_out%BladeRootMotion14, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%BladeRootMotion) .AND. ALLOCATED(y1%BladeRootMotion)) THEN - DO i01 = LBOUND(y_out%BladeRootMotion,1),UBOUND(y_out%BladeRootMotion,1) - CALL MeshExtrapInterp1(y1%BladeRootMotion(i01), y2%BladeRootMotion(i01), tin, y_out%BladeRootMotion(i01), tin_out, ErrStat2, ErrMsg2 ) + 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) ENDDO END IF ! check if allocated @@ -24996,75 +24610,67 @@ SUBROUTINE ED_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg CALL MeshExtrapInterp1(y1%TowerBaseMotion14, y2%TowerBaseMotion14, tin, y_out%TowerBaseMotion14, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ALLOCATED(y_out%BlPitch) .AND. ALLOCATED(y1%BlPitch)) THEN - ALLOCATE(b1(SIZE(y_out%BlPitch,1))) - ALLOCATE(c1(SIZE(y_out%BlPitch,1))) - b1 = -(y1%BlPitch - y2%BlPitch)/t(2) - y_out%BlPitch = y1%BlPitch + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%BlPitch,1),UBOUND(y_out%BlPitch,1) + b = -(y1%BlPitch(i1) - y2%BlPitch(i1)) + y_out%BlPitch(i1) = y1%BlPitch(i1) + b * ScaleFactor + END DO END IF ! check if allocated - b0 = -(y1%Yaw - y2%Yaw)/t(2) - y_out%Yaw = y1%Yaw + b0 * t_out - b0 = -(y1%YawRate - y2%YawRate)/t(2) - y_out%YawRate = y1%YawRate + b0 * t_out - b0 = -(y1%LSS_Spd - y2%LSS_Spd)/t(2) - y_out%LSS_Spd = y1%LSS_Spd + b0 * t_out - b0 = -(y1%HSS_Spd - y2%HSS_Spd)/t(2) - y_out%HSS_Spd = y1%HSS_Spd + b0 * t_out - b0 = -(y1%RotSpeed - y2%RotSpeed)/t(2) - y_out%RotSpeed = y1%RotSpeed + b0 * t_out - b0 = -(y1%TwrAccel - y2%TwrAccel)/t(2) - y_out%TwrAccel = y1%TwrAccel + b0 * t_out - b0 = -(y1%YawAngle - y2%YawAngle)/t(2) - y_out%YawAngle = y1%YawAngle + b0 * t_out - ALLOCATE(b1(SIZE(y_out%RootMyc,1))) - ALLOCATE(c1(SIZE(y_out%RootMyc,1))) - b1 = -(y1%RootMyc - y2%RootMyc)/t(2) - y_out%RootMyc = y1%RootMyc + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - b0 = -(y1%YawBrTAxp - y2%YawBrTAxp)/t(2) - y_out%YawBrTAxp = y1%YawBrTAxp + b0 * t_out - b0 = -(y1%YawBrTAyp - y2%YawBrTAyp)/t(2) - y_out%YawBrTAyp = y1%YawBrTAyp + b0 * t_out - b0 = -(y1%LSSTipPxa - y2%LSSTipPxa)/t(2) - y_out%LSSTipPxa = y1%LSSTipPxa + b0 * t_out - ALLOCATE(b1(SIZE(y_out%RootMxc,1))) - ALLOCATE(c1(SIZE(y_out%RootMxc,1))) - b1 = -(y1%RootMxc - y2%RootMxc)/t(2) - y_out%RootMxc = y1%RootMxc + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - b0 = -(y1%LSSTipMxa - y2%LSSTipMxa)/t(2) - y_out%LSSTipMxa = y1%LSSTipMxa + b0 * t_out - b0 = -(y1%LSSTipMya - y2%LSSTipMya)/t(2) - y_out%LSSTipMya = y1%LSSTipMya + b0 * t_out - b0 = -(y1%LSSTipMza - y2%LSSTipMza)/t(2) - y_out%LSSTipMza = y1%LSSTipMza + b0 * t_out - b0 = -(y1%LSSTipMys - y2%LSSTipMys)/t(2) - y_out%LSSTipMys = y1%LSSTipMys + b0 * t_out - b0 = -(y1%LSSTipMzs - y2%LSSTipMzs)/t(2) - y_out%LSSTipMzs = y1%LSSTipMzs + b0 * t_out - b0 = -(y1%YawBrMyn - y2%YawBrMyn)/t(2) - y_out%YawBrMyn = y1%YawBrMyn + b0 * t_out - b0 = -(y1%YawBrMzn - y2%YawBrMzn)/t(2) - y_out%YawBrMzn = y1%YawBrMzn + b0 * t_out - b0 = -(y1%NcIMURAxs - y2%NcIMURAxs)/t(2) - y_out%NcIMURAxs = y1%NcIMURAxs + b0 * t_out - b0 = -(y1%NcIMURAys - y2%NcIMURAys)/t(2) - y_out%NcIMURAys = y1%NcIMURAys + b0 * t_out - b0 = -(y1%NcIMURAzs - y2%NcIMURAzs)/t(2) - y_out%NcIMURAzs = y1%NcIMURAzs + b0 * t_out - b0 = -(y1%RotPwr - y2%RotPwr)/t(2) - y_out%RotPwr = y1%RotPwr + b0 * t_out + b = -(y1%Yaw - y2%Yaw) + y_out%Yaw = y1%Yaw + b * ScaleFactor + b = -(y1%YawRate - y2%YawRate) + y_out%YawRate = y1%YawRate + b * ScaleFactor + b = -(y1%LSS_Spd - y2%LSS_Spd) + y_out%LSS_Spd = y1%LSS_Spd + b * ScaleFactor + b = -(y1%HSS_Spd - y2%HSS_Spd) + y_out%HSS_Spd = y1%HSS_Spd + b * ScaleFactor + b = -(y1%RotSpeed - y2%RotSpeed) + y_out%RotSpeed = y1%RotSpeed + b * ScaleFactor + b = -(y1%TwrAccel - y2%TwrAccel) + y_out%TwrAccel = y1%TwrAccel + b * ScaleFactor + b = -(y1%YawAngle - y2%YawAngle) + y_out%YawAngle = y1%YawAngle + b * ScaleFactor + DO i1 = LBOUND(y_out%RootMyc,1),UBOUND(y_out%RootMyc,1) + b = -(y1%RootMyc(i1) - y2%RootMyc(i1)) + y_out%RootMyc(i1) = y1%RootMyc(i1) + b * ScaleFactor + END DO + b = -(y1%YawBrTAxp - y2%YawBrTAxp) + y_out%YawBrTAxp = y1%YawBrTAxp + b * ScaleFactor + b = -(y1%YawBrTAyp - y2%YawBrTAyp) + y_out%YawBrTAyp = y1%YawBrTAyp + b * ScaleFactor + b = -(y1%LSSTipPxa - y2%LSSTipPxa) + y_out%LSSTipPxa = y1%LSSTipPxa + b * ScaleFactor + DO i1 = LBOUND(y_out%RootMxc,1),UBOUND(y_out%RootMxc,1) + b = -(y1%RootMxc(i1) - y2%RootMxc(i1)) + y_out%RootMxc(i1) = y1%RootMxc(i1) + b * ScaleFactor + END DO + b = -(y1%LSSTipMxa - y2%LSSTipMxa) + y_out%LSSTipMxa = y1%LSSTipMxa + b * ScaleFactor + b = -(y1%LSSTipMya - y2%LSSTipMya) + y_out%LSSTipMya = y1%LSSTipMya + b * ScaleFactor + b = -(y1%LSSTipMza - y2%LSSTipMza) + y_out%LSSTipMza = y1%LSSTipMza + b * ScaleFactor + b = -(y1%LSSTipMys - y2%LSSTipMys) + y_out%LSSTipMys = y1%LSSTipMys + b * ScaleFactor + b = -(y1%LSSTipMzs - y2%LSSTipMzs) + y_out%LSSTipMzs = y1%LSSTipMzs + b * ScaleFactor + b = -(y1%YawBrMyn - y2%YawBrMyn) + y_out%YawBrMyn = y1%YawBrMyn + b * ScaleFactor + b = -(y1%YawBrMzn - y2%YawBrMzn) + y_out%YawBrMzn = y1%YawBrMzn + b * ScaleFactor + b = -(y1%NcIMURAxs - y2%NcIMURAxs) + y_out%NcIMURAxs = y1%NcIMURAxs + b * ScaleFactor + b = -(y1%NcIMURAys - y2%NcIMURAys) + y_out%NcIMURAys = y1%NcIMURAys + b * ScaleFactor + b = -(y1%NcIMURAzs - y2%NcIMURAzs) + y_out%NcIMURAzs = y1%NcIMURAzs + b * ScaleFactor + b = -(y1%RotPwr - y2%RotPwr) + y_out%RotPwr = y1%RotPwr + b * ScaleFactor END SUBROUTINE ED_Output_ExtrapInterp1 @@ -25094,14 +24700,14 @@ SUBROUTINE ED_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'ED_Output_ExtrapInterp2' INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -25120,9 +24726,11 @@ SUBROUTINE ED_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ALLOCATED(y_out%BladeLn2Mesh) .AND. ALLOCATED(y1%BladeLn2Mesh)) THEN - DO i01 = LBOUND(y_out%BladeLn2Mesh,1),UBOUND(y_out%BladeLn2Mesh,1) - CALL MeshExtrapInterp2(y1%BladeLn2Mesh(i01), y2%BladeLn2Mesh(i01), y3%BladeLn2Mesh(i01), tin, y_out%BladeLn2Mesh(i01), tin_out, ErrStat2, ErrMsg2 ) + 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) ENDDO END IF ! check if allocated @@ -25137,8 +24745,8 @@ SUBROUTINE ED_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err CALL MeshExtrapInterp2(y1%BladeRootMotion14, y2%BladeRootMotion14, y3%BladeRootMotion14, tin, y_out%BladeRootMotion14, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%BladeRootMotion) .AND. ALLOCATED(y1%BladeRootMotion)) THEN - DO i01 = LBOUND(y_out%BladeRootMotion,1),UBOUND(y_out%BladeRootMotion,1) - CALL MeshExtrapInterp2(y1%BladeRootMotion(i01), y2%BladeRootMotion(i01), y3%BladeRootMotion(i01), tin, y_out%BladeRootMotion(i01), tin_out, ErrStat2, ErrMsg2 ) + 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) ENDDO END IF ! check if allocated @@ -25149,100 +24757,92 @@ SUBROUTINE ED_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err CALL MeshExtrapInterp2(y1%TowerBaseMotion14, y2%TowerBaseMotion14, y3%TowerBaseMotion14, tin, y_out%TowerBaseMotion14, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ALLOCATED(y_out%BlPitch) .AND. ALLOCATED(y1%BlPitch)) THEN - ALLOCATE(b1(SIZE(y_out%BlPitch,1))) - ALLOCATE(c1(SIZE(y_out%BlPitch,1))) - b1 = (t(3)**2*(y1%BlPitch - y2%BlPitch) + t(2)**2*(-y1%BlPitch + y3%BlPitch))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%BlPitch + t(3)*y2%BlPitch - t(2)*y3%BlPitch ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%BlPitch = y1%BlPitch + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%BlPitch,1),UBOUND(y_out%BlPitch,1) + b = (t(3)**2*(y1%BlPitch(i1) - y2%BlPitch(i1)) + t(2)**2*(-y1%BlPitch(i1) + y3%BlPitch(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%BlPitch(i1) + t(3)*y2%BlPitch(i1) - t(2)*y3%BlPitch(i1) ) * scaleFactor + y_out%BlPitch(i1) = y1%BlPitch(i1) + b + c * t_out + END DO END IF ! check if allocated - b0 = (t(3)**2*(y1%Yaw - y2%Yaw) + t(2)**2*(-y1%Yaw + y3%Yaw))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%Yaw + t(3)*y2%Yaw - t(2)*y3%Yaw ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Yaw = y1%Yaw + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%YawRate - y2%YawRate) + t(2)**2*(-y1%YawRate + y3%YawRate))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%YawRate + t(3)*y2%YawRate - t(2)*y3%YawRate ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%YawRate = y1%YawRate + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%LSS_Spd - y2%LSS_Spd) + t(2)**2*(-y1%LSS_Spd + y3%LSS_Spd))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%LSS_Spd + t(3)*y2%LSS_Spd - t(2)*y3%LSS_Spd ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%LSS_Spd = y1%LSS_Spd + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%HSS_Spd - y2%HSS_Spd) + t(2)**2*(-y1%HSS_Spd + y3%HSS_Spd))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%HSS_Spd + t(3)*y2%HSS_Spd - t(2)*y3%HSS_Spd ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%HSS_Spd = y1%HSS_Spd + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%RotSpeed - y2%RotSpeed) + t(2)**2*(-y1%RotSpeed + y3%RotSpeed))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%RotSpeed + t(3)*y2%RotSpeed - t(2)*y3%RotSpeed ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%RotSpeed = y1%RotSpeed + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%TwrAccel - y2%TwrAccel) + t(2)**2*(-y1%TwrAccel + y3%TwrAccel))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%TwrAccel + t(3)*y2%TwrAccel - t(2)*y3%TwrAccel ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%TwrAccel = y1%TwrAccel + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%YawAngle - y2%YawAngle) + t(2)**2*(-y1%YawAngle + y3%YawAngle))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%YawAngle + t(3)*y2%YawAngle - t(2)*y3%YawAngle ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%YawAngle = y1%YawAngle + b0 * t_out + c0 * t_out**2 - ALLOCATE(b1(SIZE(y_out%RootMyc,1))) - ALLOCATE(c1(SIZE(y_out%RootMyc,1))) - b1 = (t(3)**2*(y1%RootMyc - y2%RootMyc) + t(2)**2*(-y1%RootMyc + y3%RootMyc))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%RootMyc + t(3)*y2%RootMyc - t(2)*y3%RootMyc ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%RootMyc = y1%RootMyc + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - b0 = (t(3)**2*(y1%YawBrTAxp - y2%YawBrTAxp) + t(2)**2*(-y1%YawBrTAxp + y3%YawBrTAxp))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%YawBrTAxp + t(3)*y2%YawBrTAxp - t(2)*y3%YawBrTAxp ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%YawBrTAxp = y1%YawBrTAxp + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%YawBrTAyp - y2%YawBrTAyp) + t(2)**2*(-y1%YawBrTAyp + y3%YawBrTAyp))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%YawBrTAyp + t(3)*y2%YawBrTAyp - t(2)*y3%YawBrTAyp ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%YawBrTAyp = y1%YawBrTAyp + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%LSSTipPxa - y2%LSSTipPxa) + t(2)**2*(-y1%LSSTipPxa + y3%LSSTipPxa))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%LSSTipPxa + t(3)*y2%LSSTipPxa - t(2)*y3%LSSTipPxa ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%LSSTipPxa = y1%LSSTipPxa + b0 * t_out + c0 * t_out**2 - ALLOCATE(b1(SIZE(y_out%RootMxc,1))) - ALLOCATE(c1(SIZE(y_out%RootMxc,1))) - b1 = (t(3)**2*(y1%RootMxc - y2%RootMxc) + t(2)**2*(-y1%RootMxc + y3%RootMxc))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%RootMxc + t(3)*y2%RootMxc - t(2)*y3%RootMxc ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%RootMxc = y1%RootMxc + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - b0 = (t(3)**2*(y1%LSSTipMxa - y2%LSSTipMxa) + t(2)**2*(-y1%LSSTipMxa + y3%LSSTipMxa))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%LSSTipMxa + t(3)*y2%LSSTipMxa - t(2)*y3%LSSTipMxa ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%LSSTipMxa = y1%LSSTipMxa + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%LSSTipMya - y2%LSSTipMya) + t(2)**2*(-y1%LSSTipMya + y3%LSSTipMya))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%LSSTipMya + t(3)*y2%LSSTipMya - t(2)*y3%LSSTipMya ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%LSSTipMya = y1%LSSTipMya + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%LSSTipMza - y2%LSSTipMza) + t(2)**2*(-y1%LSSTipMza + y3%LSSTipMza))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%LSSTipMza + t(3)*y2%LSSTipMza - t(2)*y3%LSSTipMza ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%LSSTipMza = y1%LSSTipMza + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%LSSTipMys - y2%LSSTipMys) + t(2)**2*(-y1%LSSTipMys + y3%LSSTipMys))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%LSSTipMys + t(3)*y2%LSSTipMys - t(2)*y3%LSSTipMys ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%LSSTipMys = y1%LSSTipMys + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%LSSTipMzs - y2%LSSTipMzs) + t(2)**2*(-y1%LSSTipMzs + y3%LSSTipMzs))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%LSSTipMzs + t(3)*y2%LSSTipMzs - t(2)*y3%LSSTipMzs ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%LSSTipMzs = y1%LSSTipMzs + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%YawBrMyn - y2%YawBrMyn) + t(2)**2*(-y1%YawBrMyn + y3%YawBrMyn))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%YawBrMyn + t(3)*y2%YawBrMyn - t(2)*y3%YawBrMyn ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%YawBrMyn = y1%YawBrMyn + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%YawBrMzn - y2%YawBrMzn) + t(2)**2*(-y1%YawBrMzn + y3%YawBrMzn))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%YawBrMzn + t(3)*y2%YawBrMzn - t(2)*y3%YawBrMzn ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%YawBrMzn = y1%YawBrMzn + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%NcIMURAxs - y2%NcIMURAxs) + t(2)**2*(-y1%NcIMURAxs + y3%NcIMURAxs))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%NcIMURAxs + t(3)*y2%NcIMURAxs - t(2)*y3%NcIMURAxs ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%NcIMURAxs = y1%NcIMURAxs + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%NcIMURAys - y2%NcIMURAys) + t(2)**2*(-y1%NcIMURAys + y3%NcIMURAys))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%NcIMURAys + t(3)*y2%NcIMURAys - t(2)*y3%NcIMURAys ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%NcIMURAys = y1%NcIMURAys + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%NcIMURAzs - y2%NcIMURAzs) + t(2)**2*(-y1%NcIMURAzs + y3%NcIMURAzs))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%NcIMURAzs + t(3)*y2%NcIMURAzs - t(2)*y3%NcIMURAzs ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%NcIMURAzs = y1%NcIMURAzs + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%RotPwr - y2%RotPwr) + t(2)**2*(-y1%RotPwr + y3%RotPwr))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%RotPwr + t(3)*y2%RotPwr - t(2)*y3%RotPwr ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%RotPwr = y1%RotPwr + b0 * t_out + c0 * t_out**2 + b = (t(3)**2*(y1%Yaw - y2%Yaw) + t(2)**2*(-y1%Yaw + y3%Yaw))* scaleFactor + c = ( (t(2)-t(3))*y1%Yaw + t(3)*y2%Yaw - t(2)*y3%Yaw ) * scaleFactor + y_out%Yaw = y1%Yaw + b + c * t_out + b = (t(3)**2*(y1%YawRate - y2%YawRate) + t(2)**2*(-y1%YawRate + y3%YawRate))* scaleFactor + c = ( (t(2)-t(3))*y1%YawRate + t(3)*y2%YawRate - t(2)*y3%YawRate ) * scaleFactor + y_out%YawRate = y1%YawRate + b + c * t_out + b = (t(3)**2*(y1%LSS_Spd - y2%LSS_Spd) + t(2)**2*(-y1%LSS_Spd + y3%LSS_Spd))* scaleFactor + c = ( (t(2)-t(3))*y1%LSS_Spd + t(3)*y2%LSS_Spd - t(2)*y3%LSS_Spd ) * scaleFactor + y_out%LSS_Spd = y1%LSS_Spd + b + c * t_out + b = (t(3)**2*(y1%HSS_Spd - y2%HSS_Spd) + t(2)**2*(-y1%HSS_Spd + y3%HSS_Spd))* scaleFactor + c = ( (t(2)-t(3))*y1%HSS_Spd + t(3)*y2%HSS_Spd - t(2)*y3%HSS_Spd ) * scaleFactor + y_out%HSS_Spd = y1%HSS_Spd + b + c * t_out + b = (t(3)**2*(y1%RotSpeed - y2%RotSpeed) + t(2)**2*(-y1%RotSpeed + y3%RotSpeed))* scaleFactor + c = ( (t(2)-t(3))*y1%RotSpeed + t(3)*y2%RotSpeed - t(2)*y3%RotSpeed ) * scaleFactor + y_out%RotSpeed = y1%RotSpeed + b + c * t_out + b = (t(3)**2*(y1%TwrAccel - y2%TwrAccel) + t(2)**2*(-y1%TwrAccel + y3%TwrAccel))* scaleFactor + c = ( (t(2)-t(3))*y1%TwrAccel + t(3)*y2%TwrAccel - t(2)*y3%TwrAccel ) * scaleFactor + y_out%TwrAccel = y1%TwrAccel + b + c * t_out + b = (t(3)**2*(y1%YawAngle - y2%YawAngle) + t(2)**2*(-y1%YawAngle + y3%YawAngle))* scaleFactor + c = ( (t(2)-t(3))*y1%YawAngle + t(3)*y2%YawAngle - t(2)*y3%YawAngle ) * scaleFactor + y_out%YawAngle = y1%YawAngle + b + c * t_out + DO i1 = LBOUND(y_out%RootMyc,1),UBOUND(y_out%RootMyc,1) + b = (t(3)**2*(y1%RootMyc(i1) - y2%RootMyc(i1)) + t(2)**2*(-y1%RootMyc(i1) + y3%RootMyc(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%RootMyc(i1) + t(3)*y2%RootMyc(i1) - t(2)*y3%RootMyc(i1) ) * scaleFactor + y_out%RootMyc(i1) = y1%RootMyc(i1) + b + c * t_out + END DO + b = (t(3)**2*(y1%YawBrTAxp - y2%YawBrTAxp) + t(2)**2*(-y1%YawBrTAxp + y3%YawBrTAxp))* scaleFactor + c = ( (t(2)-t(3))*y1%YawBrTAxp + t(3)*y2%YawBrTAxp - t(2)*y3%YawBrTAxp ) * scaleFactor + y_out%YawBrTAxp = y1%YawBrTAxp + b + c * t_out + b = (t(3)**2*(y1%YawBrTAyp - y2%YawBrTAyp) + t(2)**2*(-y1%YawBrTAyp + y3%YawBrTAyp))* scaleFactor + c = ( (t(2)-t(3))*y1%YawBrTAyp + t(3)*y2%YawBrTAyp - t(2)*y3%YawBrTAyp ) * scaleFactor + y_out%YawBrTAyp = y1%YawBrTAyp + b + c * t_out + b = (t(3)**2*(y1%LSSTipPxa - y2%LSSTipPxa) + t(2)**2*(-y1%LSSTipPxa + y3%LSSTipPxa))* scaleFactor + c = ( (t(2)-t(3))*y1%LSSTipPxa + t(3)*y2%LSSTipPxa - t(2)*y3%LSSTipPxa ) * scaleFactor + y_out%LSSTipPxa = y1%LSSTipPxa + b + c * t_out + DO i1 = LBOUND(y_out%RootMxc,1),UBOUND(y_out%RootMxc,1) + b = (t(3)**2*(y1%RootMxc(i1) - y2%RootMxc(i1)) + t(2)**2*(-y1%RootMxc(i1) + y3%RootMxc(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%RootMxc(i1) + t(3)*y2%RootMxc(i1) - t(2)*y3%RootMxc(i1) ) * scaleFactor + y_out%RootMxc(i1) = y1%RootMxc(i1) + b + c * t_out + END DO + b = (t(3)**2*(y1%LSSTipMxa - y2%LSSTipMxa) + t(2)**2*(-y1%LSSTipMxa + y3%LSSTipMxa))* scaleFactor + c = ( (t(2)-t(3))*y1%LSSTipMxa + t(3)*y2%LSSTipMxa - t(2)*y3%LSSTipMxa ) * scaleFactor + y_out%LSSTipMxa = y1%LSSTipMxa + b + c * t_out + b = (t(3)**2*(y1%LSSTipMya - y2%LSSTipMya) + t(2)**2*(-y1%LSSTipMya + y3%LSSTipMya))* scaleFactor + c = ( (t(2)-t(3))*y1%LSSTipMya + t(3)*y2%LSSTipMya - t(2)*y3%LSSTipMya ) * scaleFactor + y_out%LSSTipMya = y1%LSSTipMya + b + c * t_out + b = (t(3)**2*(y1%LSSTipMza - y2%LSSTipMza) + t(2)**2*(-y1%LSSTipMza + y3%LSSTipMza))* scaleFactor + c = ( (t(2)-t(3))*y1%LSSTipMza + t(3)*y2%LSSTipMza - t(2)*y3%LSSTipMza ) * scaleFactor + y_out%LSSTipMza = y1%LSSTipMza + b + c * t_out + b = (t(3)**2*(y1%LSSTipMys - y2%LSSTipMys) + t(2)**2*(-y1%LSSTipMys + y3%LSSTipMys))* scaleFactor + c = ( (t(2)-t(3))*y1%LSSTipMys + t(3)*y2%LSSTipMys - t(2)*y3%LSSTipMys ) * scaleFactor + y_out%LSSTipMys = y1%LSSTipMys + b + c * t_out + b = (t(3)**2*(y1%LSSTipMzs - y2%LSSTipMzs) + t(2)**2*(-y1%LSSTipMzs + y3%LSSTipMzs))* scaleFactor + c = ( (t(2)-t(3))*y1%LSSTipMzs + t(3)*y2%LSSTipMzs - t(2)*y3%LSSTipMzs ) * scaleFactor + y_out%LSSTipMzs = y1%LSSTipMzs + b + c * t_out + b = (t(3)**2*(y1%YawBrMyn - y2%YawBrMyn) + t(2)**2*(-y1%YawBrMyn + y3%YawBrMyn))* scaleFactor + c = ( (t(2)-t(3))*y1%YawBrMyn + t(3)*y2%YawBrMyn - t(2)*y3%YawBrMyn ) * scaleFactor + y_out%YawBrMyn = y1%YawBrMyn + b + c * t_out + b = (t(3)**2*(y1%YawBrMzn - y2%YawBrMzn) + t(2)**2*(-y1%YawBrMzn + y3%YawBrMzn))* scaleFactor + c = ( (t(2)-t(3))*y1%YawBrMzn + t(3)*y2%YawBrMzn - t(2)*y3%YawBrMzn ) * scaleFactor + y_out%YawBrMzn = y1%YawBrMzn + b + c * t_out + b = (t(3)**2*(y1%NcIMURAxs - y2%NcIMURAxs) + t(2)**2*(-y1%NcIMURAxs + y3%NcIMURAxs))* scaleFactor + c = ( (t(2)-t(3))*y1%NcIMURAxs + t(3)*y2%NcIMURAxs - t(2)*y3%NcIMURAxs ) * scaleFactor + y_out%NcIMURAxs = y1%NcIMURAxs + b + c * t_out + b = (t(3)**2*(y1%NcIMURAys - y2%NcIMURAys) + t(2)**2*(-y1%NcIMURAys + y3%NcIMURAys))* scaleFactor + c = ( (t(2)-t(3))*y1%NcIMURAys + t(3)*y2%NcIMURAys - t(2)*y3%NcIMURAys ) * scaleFactor + y_out%NcIMURAys = y1%NcIMURAys + b + c * t_out + b = (t(3)**2*(y1%NcIMURAzs - y2%NcIMURAzs) + t(2)**2*(-y1%NcIMURAzs + y3%NcIMURAzs))* scaleFactor + c = ( (t(2)-t(3))*y1%NcIMURAzs + t(3)*y2%NcIMURAzs - t(2)*y3%NcIMURAzs ) * scaleFactor + y_out%NcIMURAzs = y1%NcIMURAzs + b + c * t_out + b = (t(3)**2*(y1%RotPwr - y2%RotPwr) + t(2)**2*(-y1%RotPwr + y3%RotPwr))* scaleFactor + c = ( (t(2)-t(3))*y1%RotPwr + t(3)*y2%RotPwr - t(2)*y3%RotPwr ) * scaleFactor + y_out%RotPwr = y1%RotPwr + b + c * t_out END SUBROUTINE ED_Output_ExtrapInterp2 END MODULE ElastoDyn_Types diff --git a/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 b/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 index d9e7df3e51..fc011055c1 100644 --- a/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 +++ b/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 @@ -194,12 +194,12 @@ SUBROUTINE ExtPtfm_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Linearize , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%InputFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%Linearize, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE ExtPtfm_PackInitInput SUBROUTINE ExtPtfm_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -215,12 +215,6 @@ SUBROUTINE ExtPtfm_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -236,12 +230,12 @@ SUBROUTINE ExtPtfm_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%Linearize = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%InputFile) + OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%Linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%Linearize) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE ExtPtfm_UnPackInitInput SUBROUTINE ExtPtfm_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -434,12 +428,12 @@ SUBROUTINE ExtPtfm_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) + DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) DO I = 1, LEN(InData%WriteOutputHdr) IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdr(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -451,12 +445,12 @@ SUBROUTINE ExtPtfm_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) + DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) DO I = 1, LEN(InData%WriteOutputUnt) IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUnt(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF END SUBROUTINE ExtPtfm_PackInitOutput @@ -473,12 +467,6 @@ SUBROUTINE ExtPtfm_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -546,19 +534,12 @@ SUBROUTINE ExtPtfm_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) DO I = 1, LEN(OutData%WriteOutputHdr) OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated Int_Xferred = Int_Xferred + 1 @@ -573,19 +554,12 @@ SUBROUTINE ExtPtfm_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) DO I = 1, LEN(OutData%WriteOutputUnt) OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF END SUBROUTINE ExtPtfm_UnPackInitOutput @@ -680,8 +654,8 @@ SUBROUTINE ExtPtfm_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyContState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyContState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE ExtPtfm_PackContState SUBROUTINE ExtPtfm_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -697,12 +671,6 @@ SUBROUTINE ExtPtfm_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_UnPackContState' @@ -716,8 +684,8 @@ SUBROUTINE ExtPtfm_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyContState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyContState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE ExtPtfm_UnPackContState SUBROUTINE ExtPtfm_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) @@ -811,8 +779,8 @@ SUBROUTINE ExtPtfm_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyDiscState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE ExtPtfm_PackDiscState SUBROUTINE ExtPtfm_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -828,12 +796,6 @@ SUBROUTINE ExtPtfm_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_UnPackDiscState' @@ -847,8 +809,8 @@ SUBROUTINE ExtPtfm_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyDiscState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyDiscState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE ExtPtfm_UnPackDiscState SUBROUTINE ExtPtfm_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -942,8 +904,8 @@ SUBROUTINE ExtPtfm_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyConstrState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE ExtPtfm_PackConstrState SUBROUTINE ExtPtfm_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -959,12 +921,6 @@ SUBROUTINE ExtPtfm_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_UnPackConstrState' @@ -978,8 +934,8 @@ SUBROUTINE ExtPtfm_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyConstrState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyConstrState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE ExtPtfm_UnPackConstrState SUBROUTINE ExtPtfm_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -1073,8 +1029,8 @@ SUBROUTINE ExtPtfm_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DummyOtherState - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DummyOtherState + Int_Xferred = Int_Xferred + 1 END SUBROUTINE ExtPtfm_PackOtherState SUBROUTINE ExtPtfm_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1090,12 +1046,6 @@ SUBROUTINE ExtPtfm_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_UnPackOtherState' @@ -1109,8 +1059,8 @@ SUBROUTINE ExtPtfm_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyOtherState = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%DummyOtherState = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE ExtPtfm_UnPackOtherState SUBROUTINE ExtPtfm_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -1215,18 +1165,28 @@ SUBROUTINE ExtPtfm_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%q))-1 ) = PACK(InData%q,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%q) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%qdot))-1 ) = PACK(InData%qdot,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%qdot) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%qdotdot))-1 ) = PACK(InData%qdotdot,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%qdotdot) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PtfmFt))-1 ) = PACK(InData%PtfmFt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PtfmFt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_PtfmAM))-1 ) = PACK(InData%F_PtfmAM,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_PtfmAM) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Indx - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%q,1), UBOUND(InData%q,1) + ReKiBuf(Re_Xferred) = InData%q(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%qdot,1), UBOUND(InData%qdot,1) + ReKiBuf(Re_Xferred) = InData%qdot(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%qdotdot,1), UBOUND(InData%qdotdot,1) + ReKiBuf(Re_Xferred) = InData%qdotdot(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%PtfmFt,1), UBOUND(InData%PtfmFt,1) + ReKiBuf(Re_Xferred) = InData%PtfmFt(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%F_PtfmAM,1), UBOUND(InData%F_PtfmAM,1) + ReKiBuf(Re_Xferred) = InData%F_PtfmAM(i1) + Re_Xferred = Re_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%Indx + Int_Xferred = Int_Xferred + 1 END SUBROUTINE ExtPtfm_PackMisc SUBROUTINE ExtPtfm_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1242,12 +1202,6 @@ SUBROUTINE ExtPtfm_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1264,61 +1218,36 @@ SUBROUTINE ExtPtfm_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Int_Xferred = 1 i1_l = LBOUND(OutData%q,1) i1_u = UBOUND(OutData%q,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%q = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%q))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%q) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%q,1), UBOUND(OutData%q,1) + OutData%q(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%qdot,1) i1_u = UBOUND(OutData%qdot,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%qdot = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%qdot))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%qdot) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%qdot,1), UBOUND(OutData%qdot,1) + OutData%qdot(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%qdotdot,1) i1_u = UBOUND(OutData%qdotdot,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%qdotdot = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%qdotdot))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%qdotdot) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%qdotdot,1), UBOUND(OutData%qdotdot,1) + OutData%qdotdot(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%PtfmFt,1) i1_u = UBOUND(OutData%PtfmFt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%PtfmFt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PtfmFt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PtfmFt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%PtfmFt,1), UBOUND(OutData%PtfmFt,1) + OutData%PtfmFt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%F_PtfmAM,1) i1_u = UBOUND(OutData%F_PtfmAM,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%F_PtfmAM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_PtfmAM))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_PtfmAM) - DEALLOCATE(mask1) - OutData%Indx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%F_PtfmAM,1), UBOUND(OutData%F_PtfmAM,1) + OutData%F_PtfmAM(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%Indx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE ExtPtfm_UnPackMisc SUBROUTINE ExtPtfm_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -1464,12 +1393,24 @@ SUBROUTINE ExtPtfm_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PtfmAM))-1 ) = PACK(InData%PtfmAM,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PtfmAM) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Damp))-1 ) = PACK(InData%Damp,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Damp) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Stff))-1 ) = PACK(InData%Stff,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Stff) + DO i2 = LBOUND(InData%PtfmAM,2), UBOUND(InData%PtfmAM,2) + DO i1 = LBOUND(InData%PtfmAM,1), UBOUND(InData%PtfmAM,1) + ReKiBuf(Re_Xferred) = InData%PtfmAM(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%Damp,2), UBOUND(InData%Damp,2) + DO i1 = LBOUND(InData%Damp,1), UBOUND(InData%Damp,1) + ReKiBuf(Re_Xferred) = InData%Damp(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%Stff,2), UBOUND(InData%Stff,2) + DO i1 = LBOUND(InData%Stff,1), UBOUND(InData%Stff,1) + ReKiBuf(Re_Xferred) = InData%Stff(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO IF ( .NOT. ALLOCATED(InData%PtfmFt) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1483,8 +1424,12 @@ SUBROUTINE ExtPtfm_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmFt,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PtfmFt)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PtfmFt))-1 ) = PACK(InData%PtfmFt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PtfmFt) + DO i2 = LBOUND(InData%PtfmFt,2), UBOUND(InData%PtfmFt,2) + DO i1 = LBOUND(InData%PtfmFt,1), UBOUND(InData%PtfmFt,1) + ReKiBuf(Re_Xferred) = InData%PtfmFt(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PtfmFt_t) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1496,13 +1441,15 @@ SUBROUTINE ExtPtfm_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmFt_t,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PtfmFt_t)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PtfmFt_t))-1 ) = PACK(InData%PtfmFt_t,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PtfmFt_t) + DO i1 = LBOUND(InData%PtfmFt_t,1), UBOUND(InData%PtfmFt_t,1) + ReKiBuf(Re_Xferred) = InData%PtfmFt_t(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%nPtfmFt - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nPtfmFt + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 END SUBROUTINE ExtPtfm_PackParam SUBROUTINE ExtPtfm_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1518,12 +1465,6 @@ SUBROUTINE ExtPtfm_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -1543,41 +1484,32 @@ SUBROUTINE ExtPtfm_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er i1_u = UBOUND(OutData%PtfmAM,1) i2_l = LBOUND(OutData%PtfmAM,2) i2_u = UBOUND(OutData%PtfmAM,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%PtfmAM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PtfmAM))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PtfmAM) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PtfmAM,2), UBOUND(OutData%PtfmAM,2) + DO i1 = LBOUND(OutData%PtfmAM,1), UBOUND(OutData%PtfmAM,1) + OutData%PtfmAM(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%Damp,1) i1_u = UBOUND(OutData%Damp,1) i2_l = LBOUND(OutData%Damp,2) i2_u = UBOUND(OutData%Damp,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%Damp = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Damp))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Damp) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Damp,2), UBOUND(OutData%Damp,2) + DO i1 = LBOUND(OutData%Damp,1), UBOUND(OutData%Damp,1) + OutData%Damp(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%Stff,1) i1_u = UBOUND(OutData%Stff,1) i2_l = LBOUND(OutData%Stff,2) i2_u = UBOUND(OutData%Stff,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%Stff = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Stff))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Stff) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Stff,2), UBOUND(OutData%Stff,2) + DO i1 = LBOUND(OutData%Stff,1), UBOUND(OutData%Stff,1) + OutData%Stff(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmFt not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1594,15 +1526,12 @@ SUBROUTINE ExtPtfm_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmFt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PtfmFt)>0) OutData%PtfmFt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PtfmFt))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PtfmFt) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PtfmFt,2), UBOUND(OutData%PtfmFt,2) + DO i1 = LBOUND(OutData%PtfmFt,1), UBOUND(OutData%PtfmFt,1) + OutData%PtfmFt(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmFt_t not allocated Int_Xferred = Int_Xferred + 1 @@ -1617,20 +1546,15 @@ SUBROUTINE ExtPtfm_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmFt_t.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%PtfmFt_t)>0) OutData%PtfmFt_t = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PtfmFt_t))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PtfmFt_t) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%PtfmFt_t,1), UBOUND(OutData%PtfmFt_t,1) + OutData%PtfmFt_t(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%nPtfmFt = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%nPtfmFt = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE ExtPtfm_UnPackParam SUBROUTINE ExtPtfm_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -1787,12 +1711,6 @@ SUBROUTINE ExtPtfm_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_UnPackInput' @@ -2018,8 +1936,10 @@ SUBROUTINE ExtPtfm_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WriteOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE ExtPtfm_PackOutput @@ -2036,12 +1956,6 @@ SUBROUTINE ExtPtfm_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -2109,15 +2023,10 @@ SUBROUTINE ExtPtfm_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WriteOutput)>0) OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE ExtPtfm_UnPackOutput @@ -2196,8 +2105,8 @@ SUBROUTINE ExtPtfm_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, Err REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -2212,6 +2121,8 @@ SUBROUTINE ExtPtfm_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(u1%PtfmMesh, u2%PtfmMesh, tin, u_out%PtfmMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE ExtPtfm_Input_ExtrapInterp1 @@ -2243,8 +2154,9 @@ SUBROUTINE ExtPtfm_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_Input_ExtrapInterp2' @@ -2266,6 +2178,8 @@ SUBROUTINE ExtPtfm_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(u1%PtfmMesh, u2%PtfmMesh, u3%PtfmMesh, tin, u_out%PtfmMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE ExtPtfm_Input_ExtrapInterp2 @@ -2345,12 +2259,12 @@ SUBROUTINE ExtPtfm_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Er REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! 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 :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -2363,15 +2277,15 @@ SUBROUTINE ExtPtfm_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(y1%PtfmMesh, y2%PtfmMesh, tin, y_out%PtfmMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END IF ! check if allocated END SUBROUTINE ExtPtfm_Output_ExtrapInterp1 @@ -2402,13 +2316,14 @@ SUBROUTINE ExtPtfm_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -2427,16 +2342,16 @@ SUBROUTINE ExtPtfm_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(y1%PtfmMesh, y2%PtfmMesh, y3%PtfmMesh, tin, y_out%PtfmMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END IF ! check if allocated END SUBROUTINE ExtPtfm_Output_ExtrapInterp2 diff --git a/modules/feamooring/src/FEAMooring_Types.f90 b/modules/feamooring/src/FEAMooring_Types.f90 index bb2571c873..ffed532365 100644 --- a/modules/feamooring/src/FEAMooring_Types.f90 +++ b/modules/feamooring/src/FEAMooring_Types.f90 @@ -713,8 +713,8 @@ SUBROUTINE FEAM_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 IF ( .NOT. ALLOCATED(InData%LineCI) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -725,8 +725,10 @@ SUBROUTINE FEAM_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LineCI,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LineCI)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LineCI))-1 ) = PACK(InData%LineCI,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LineCI) + DO i1 = LBOUND(InData%LineCI,1), UBOUND(InData%LineCI,1) + ReKiBuf(Re_Xferred) = InData%LineCI(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LineCD) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -738,8 +740,10 @@ SUBROUTINE FEAM_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LineCD,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LineCD)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LineCD))-1 ) = PACK(InData%LineCD,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LineCD) + DO i1 = LBOUND(InData%LineCD,1), UBOUND(InData%LineCD,1) + ReKiBuf(Re_Xferred) = InData%LineCD(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LEAStiff) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -751,8 +755,10 @@ SUBROUTINE FEAM_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LEAStiff,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LEAStiff)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LEAStiff))-1 ) = PACK(InData%LEAStiff,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LEAStiff) + DO i1 = LBOUND(InData%LEAStiff,1), UBOUND(InData%LEAStiff,1) + ReKiBuf(Re_Xferred) = InData%LEAStiff(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LMassDen) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -764,8 +770,10 @@ SUBROUTINE FEAM_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LMassDen,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LMassDen)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LMassDen))-1 ) = PACK(InData%LMassDen,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LMassDen) + DO i1 = LBOUND(InData%LMassDen,1), UBOUND(InData%LMassDen,1) + ReKiBuf(Re_Xferred) = InData%LMassDen(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LDMassDen) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -777,8 +785,10 @@ SUBROUTINE FEAM_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LDMassDen,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LDMassDen)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LDMassDen))-1 ) = PACK(InData%LDMassDen,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LDMassDen) + DO i1 = LBOUND(InData%LDMassDen,1), UBOUND(InData%LDMassDen,1) + ReKiBuf(Re_Xferred) = InData%LDMassDen(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%BottmStiff) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -790,8 +800,10 @@ SUBROUTINE FEAM_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BottmStiff,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BottmStiff)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BottmStiff))-1 ) = PACK(InData%BottmStiff,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BottmStiff) + DO i1 = LBOUND(InData%BottmStiff,1), UBOUND(InData%BottmStiff,1) + ReKiBuf(Re_Xferred) = InData%BottmStiff(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LRadAnch) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -803,8 +815,10 @@ SUBROUTINE FEAM_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LRadAnch,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LRadAnch)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LRadAnch))-1 ) = PACK(InData%LRadAnch,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LRadAnch) + DO i1 = LBOUND(InData%LRadAnch,1), UBOUND(InData%LRadAnch,1) + ReKiBuf(Re_Xferred) = InData%LRadAnch(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LAngAnch) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -816,8 +830,10 @@ SUBROUTINE FEAM_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LAngAnch,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LAngAnch)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LAngAnch))-1 ) = PACK(InData%LAngAnch,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LAngAnch) + DO i1 = LBOUND(InData%LAngAnch,1), UBOUND(InData%LAngAnch,1) + ReKiBuf(Re_Xferred) = InData%LAngAnch(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LDpthAnch) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -829,8 +845,10 @@ SUBROUTINE FEAM_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LDpthAnch,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LDpthAnch)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LDpthAnch))-1 ) = PACK(InData%LDpthAnch,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LDpthAnch) + DO i1 = LBOUND(InData%LDpthAnch,1), UBOUND(InData%LDpthAnch,1) + ReKiBuf(Re_Xferred) = InData%LDpthAnch(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LRadFair) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -842,8 +860,10 @@ SUBROUTINE FEAM_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LRadFair,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LRadFair)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LRadFair))-1 ) = PACK(InData%LRadFair,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LRadFair) + DO i1 = LBOUND(InData%LRadFair,1), UBOUND(InData%LRadFair,1) + ReKiBuf(Re_Xferred) = InData%LRadFair(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LAngFair) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -855,8 +875,10 @@ SUBROUTINE FEAM_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LAngFair,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LAngFair)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LAngFair))-1 ) = PACK(InData%LAngFair,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LAngFair) + DO i1 = LBOUND(InData%LAngFair,1), UBOUND(InData%LAngFair,1) + ReKiBuf(Re_Xferred) = InData%LAngFair(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LDrftFair) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -868,8 +890,10 @@ SUBROUTINE FEAM_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LDrftFair,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LDrftFair)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LDrftFair))-1 ) = PACK(InData%LDrftFair,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LDrftFair) + DO i1 = LBOUND(InData%LDrftFair,1), UBOUND(InData%LDrftFair,1) + ReKiBuf(Re_Xferred) = InData%LDrftFair(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LUnstrLen) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -881,8 +905,10 @@ SUBROUTINE FEAM_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LUnstrLen,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LUnstrLen)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LUnstrLen))-1 ) = PACK(InData%LUnstrLen,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LUnstrLen) + DO i1 = LBOUND(InData%LUnstrLen,1), UBOUND(InData%LUnstrLen,1) + ReKiBuf(Re_Xferred) = InData%LUnstrLen(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%Tension) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -894,8 +920,10 @@ SUBROUTINE FEAM_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Tension,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Tension)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Tension))-1 ) = PACK(InData%Tension,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Tension) + DO i1 = LBOUND(InData%Tension,1), UBOUND(InData%Tension,1) + ReKiBuf(Re_Xferred) = InData%Tension(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%GSL) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -913,8 +941,14 @@ SUBROUTINE FEAM_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GSL,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%GSL)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GSL))-1 ) = PACK(InData%GSL,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GSL) + DO i3 = LBOUND(InData%GSL,3), UBOUND(InData%GSL,3) + DO i2 = LBOUND(InData%GSL,2), UBOUND(InData%GSL,2) + DO i1 = LBOUND(InData%GSL,1), UBOUND(InData%GSL,1) + ReKiBuf(Re_Xferred) = InData%GSL(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%GSR) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -929,8 +963,12 @@ SUBROUTINE FEAM_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GSR,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%GSR)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GSR))-1 ) = PACK(InData%GSR,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GSR) + DO i2 = LBOUND(InData%GSR,2), UBOUND(InData%GSR,2) + DO i1 = LBOUND(InData%GSR,1), UBOUND(InData%GSR,1) + ReKiBuf(Re_Xferred) = InData%GSR(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%GE) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -948,35 +986,41 @@ SUBROUTINE FEAM_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GE,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%GE)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GE))-1 ) = PACK(InData%GE,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GE) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumLines - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumElems - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Eps - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MaxIter - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%SumPrint , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%OutFile - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TabDelim , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%Tstart - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 + DO i3 = LBOUND(InData%GE,3), UBOUND(InData%GE,3) + DO i2 = LBOUND(InData%GE,2), UBOUND(InData%GE,2) + DO i1 = LBOUND(InData%GE,1), UBOUND(InData%GE,1) + ReKiBuf(Re_Xferred) = InData%GE(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IntKiBuf(Int_Xferred) = InData%NumLines + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumElems + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Eps + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Gravity + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDens + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MaxIter + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%SumPrint, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%OutFile + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TabDelim, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%OutFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DbKiBuf(Db_Xferred) = InData%Tstart + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%OutList) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -987,12 +1031,12 @@ SUBROUTINE FEAM_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutList,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) + DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) DO I = 1, LEN(InData%OutList) IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF END SUBROUTINE FEAM_PackInputFile @@ -1009,12 +1053,6 @@ SUBROUTINE FEAM_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -1032,8 +1070,8 @@ SUBROUTINE FEAM_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LineCI not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1047,15 +1085,10 @@ SUBROUTINE FEAM_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineCI.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LineCI)>0) OutData%LineCI = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LineCI))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LineCI) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LineCI,1), UBOUND(OutData%LineCI,1) + OutData%LineCI(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LineCD not allocated Int_Xferred = Int_Xferred + 1 @@ -1070,15 +1103,10 @@ SUBROUTINE FEAM_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineCD.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LineCD)>0) OutData%LineCD = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LineCD))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LineCD) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LineCD,1), UBOUND(OutData%LineCD,1) + OutData%LineCD(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LEAStiff not allocated Int_Xferred = Int_Xferred + 1 @@ -1093,15 +1121,10 @@ SUBROUTINE FEAM_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LEAStiff.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LEAStiff)>0) OutData%LEAStiff = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LEAStiff))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LEAStiff) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LEAStiff,1), UBOUND(OutData%LEAStiff,1) + OutData%LEAStiff(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LMassDen not allocated Int_Xferred = Int_Xferred + 1 @@ -1116,15 +1139,10 @@ SUBROUTINE FEAM_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LMassDen.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LMassDen)>0) OutData%LMassDen = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LMassDen))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LMassDen) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LMassDen,1), UBOUND(OutData%LMassDen,1) + OutData%LMassDen(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LDMassDen not allocated Int_Xferred = Int_Xferred + 1 @@ -1139,15 +1157,10 @@ SUBROUTINE FEAM_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LDMassDen.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LDMassDen)>0) OutData%LDMassDen = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LDMassDen))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LDMassDen) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LDMassDen,1), UBOUND(OutData%LDMassDen,1) + OutData%LDMassDen(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BottmStiff not allocated Int_Xferred = Int_Xferred + 1 @@ -1162,15 +1175,10 @@ SUBROUTINE FEAM_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BottmStiff.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BottmStiff)>0) OutData%BottmStiff = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BottmStiff))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BottmStiff) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BottmStiff,1), UBOUND(OutData%BottmStiff,1) + OutData%BottmStiff(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LRadAnch not allocated Int_Xferred = Int_Xferred + 1 @@ -1185,15 +1193,10 @@ SUBROUTINE FEAM_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LRadAnch.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LRadAnch)>0) OutData%LRadAnch = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LRadAnch))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LRadAnch) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LRadAnch,1), UBOUND(OutData%LRadAnch,1) + OutData%LRadAnch(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LAngAnch not allocated Int_Xferred = Int_Xferred + 1 @@ -1208,15 +1211,10 @@ SUBROUTINE FEAM_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LAngAnch.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LAngAnch)>0) OutData%LAngAnch = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LAngAnch))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LAngAnch) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LAngAnch,1), UBOUND(OutData%LAngAnch,1) + OutData%LAngAnch(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LDpthAnch not allocated Int_Xferred = Int_Xferred + 1 @@ -1231,15 +1229,10 @@ SUBROUTINE FEAM_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LDpthAnch.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LDpthAnch)>0) OutData%LDpthAnch = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LDpthAnch))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LDpthAnch) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LDpthAnch,1), UBOUND(OutData%LDpthAnch,1) + OutData%LDpthAnch(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LRadFair not allocated Int_Xferred = Int_Xferred + 1 @@ -1254,15 +1247,10 @@ SUBROUTINE FEAM_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LRadFair.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LRadFair)>0) OutData%LRadFair = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LRadFair))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LRadFair) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LRadFair,1), UBOUND(OutData%LRadFair,1) + OutData%LRadFair(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LAngFair not allocated Int_Xferred = Int_Xferred + 1 @@ -1277,15 +1265,10 @@ SUBROUTINE FEAM_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LAngFair.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LAngFair)>0) OutData%LAngFair = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LAngFair))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LAngFair) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LAngFair,1), UBOUND(OutData%LAngFair,1) + OutData%LAngFair(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LDrftFair not allocated Int_Xferred = Int_Xferred + 1 @@ -1300,15 +1283,10 @@ SUBROUTINE FEAM_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LDrftFair.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LDrftFair)>0) OutData%LDrftFair = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LDrftFair))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LDrftFair) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LDrftFair,1), UBOUND(OutData%LDrftFair,1) + OutData%LDrftFair(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LUnstrLen not allocated Int_Xferred = Int_Xferred + 1 @@ -1323,15 +1301,10 @@ SUBROUTINE FEAM_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LUnstrLen.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LUnstrLen)>0) OutData%LUnstrLen = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LUnstrLen))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LUnstrLen) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LUnstrLen,1), UBOUND(OutData%LUnstrLen,1) + OutData%LUnstrLen(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Tension not allocated Int_Xferred = Int_Xferred + 1 @@ -1346,15 +1319,10 @@ SUBROUTINE FEAM_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Tension.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Tension)>0) OutData%Tension = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Tension))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Tension) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Tension,1), UBOUND(OutData%Tension,1) + OutData%Tension(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GSL not allocated Int_Xferred = Int_Xferred + 1 @@ -1375,15 +1343,14 @@ SUBROUTINE FEAM_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GSL.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%GSL)>0) OutData%GSL = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GSL))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GSL) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%GSL,3), UBOUND(OutData%GSL,3) + DO i2 = LBOUND(OutData%GSL,2), UBOUND(OutData%GSL,2) + DO i1 = LBOUND(OutData%GSL,1), UBOUND(OutData%GSL,1) + OutData%GSL(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 ! GSR not allocated Int_Xferred = Int_Xferred + 1 @@ -1401,15 +1368,12 @@ SUBROUTINE FEAM_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GSR.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%GSR)>0) OutData%GSR = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GSR))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GSR) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%GSR,2), UBOUND(OutData%GSR,2) + DO i1 = LBOUND(OutData%GSR,1), UBOUND(OutData%GSR,1) + OutData%GSR(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GE not allocated Int_Xferred = Int_Xferred + 1 @@ -1430,42 +1394,41 @@ SUBROUTINE FEAM_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%GE)>0) OutData%GE = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GE))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GE) - DEALLOCATE(mask3) - END IF - OutData%NumLines = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumElems = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%Eps = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Gravity = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MaxIter = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%SumPrint = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%OutFile = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TabDelim = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%Tstart = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i3 = LBOUND(OutData%GE,3), UBOUND(OutData%GE,3) + DO i2 = LBOUND(OutData%GE,2), UBOUND(OutData%GE,2) + DO i1 = LBOUND(OutData%GE,1), UBOUND(OutData%GE,1) + OutData%GE(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + OutData%NumLines = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumElems = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Eps = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Gravity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WtrDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MaxIter = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%SumPrint = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumPrint) + Int_Xferred = Int_Xferred + 1 + OutData%OutFile = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TabDelim = TRANSFER(IntKiBuf(Int_Xferred), OutData%TabDelim) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%OutFmt) + OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%Tstart = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutList not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1479,19 +1442,12 @@ SUBROUTINE FEAM_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) + DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) DO I = 1, LEN(OutData%OutList) OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF END SUBROUTINE FEAM_UnPackInputFile @@ -1667,18 +1623,20 @@ SUBROUTINE FEAM_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PtfmInit))-1 ) = PACK(InData%PtfmInit,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PtfmInit) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%InputFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO i1 = LBOUND(InData%PtfmInit,1), UBOUND(InData%PtfmInit,1) + ReKiBuf(Re_Xferred) = InData%PtfmInit(i1) + Re_Xferred = Re_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%NStepWave + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveAcc0) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1695,8 +1653,14 @@ SUBROUTINE FEAM_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc0,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveAcc0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveAcc0))-1 ) = PACK(InData%WaveAcc0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveAcc0) + DO i3 = LBOUND(InData%WaveAcc0,3), UBOUND(InData%WaveAcc0,3) + DO i2 = LBOUND(InData%WaveAcc0,2), UBOUND(InData%WaveAcc0,2) + DO i1 = LBOUND(InData%WaveAcc0,1), UBOUND(InData%WaveAcc0,1) + ReKiBuf(Re_Xferred) = InData%WaveAcc0(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1708,8 +1672,10 @@ SUBROUTINE FEAM_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveTime)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveTime))-1 ) = PACK(InData%WaveTime,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveTime) + DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) + ReKiBuf(Re_Xferred) = InData%WaveTime(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveVel0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1727,13 +1693,19 @@ SUBROUTINE FEAM_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel0,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveVel0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveVel0))-1 ) = PACK(InData%WaveVel0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveVel0) + DO i3 = LBOUND(InData%WaveVel0,3), UBOUND(InData%WaveVel0,3) + DO i2 = LBOUND(InData%WaveVel0,2), UBOUND(InData%WaveVel0,2) + DO i1 = LBOUND(InData%WaveVel0,1), UBOUND(InData%WaveVel0,1) + ReKiBuf(Re_Xferred) = InData%WaveVel0(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Gravity + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDens + Re_Xferred = Re_Xferred + 1 END SUBROUTINE FEAM_PackInitInput SUBROUTINE FEAM_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1749,12 +1721,6 @@ SUBROUTINE FEAM_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -1771,27 +1737,22 @@ SUBROUTINE FEAM_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%InputFile) + OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I i1_l = LBOUND(OutData%PtfmInit,1) i1_u = UBOUND(OutData%PtfmInit,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%PtfmInit = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PtfmInit))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PtfmInit) - DEALLOCATE(mask1) - OutData%NStepWave = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%PtfmInit,1), UBOUND(OutData%PtfmInit,1) + OutData%PtfmInit(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%NStepWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAcc0 not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1811,15 +1772,14 @@ SUBROUTINE FEAM_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%WaveAcc0)>0) OutData%WaveAcc0 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveAcc0))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveAcc0) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%WaveAcc0,3), UBOUND(OutData%WaveAcc0,3) + DO i2 = LBOUND(OutData%WaveAcc0,2), UBOUND(OutData%WaveAcc0,2) + DO i1 = LBOUND(OutData%WaveAcc0,1), UBOUND(OutData%WaveAcc0,1) + OutData%WaveAcc0(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 ! WaveTime not allocated Int_Xferred = Int_Xferred + 1 @@ -1834,15 +1794,10 @@ SUBROUTINE FEAM_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveTime)>0) OutData%WaveTime = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveTime))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveTime) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) + OutData%WaveTime(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel0 not allocated Int_Xferred = Int_Xferred + 1 @@ -1863,20 +1818,19 @@ SUBROUTINE FEAM_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%WaveVel0)>0) OutData%WaveVel0 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveVel0))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveVel0) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%WaveVel0,3), UBOUND(OutData%WaveVel0,3) + DO i2 = LBOUND(OutData%WaveVel0,2), UBOUND(OutData%WaveVel0,2) + DO i1 = LBOUND(OutData%WaveVel0,1), UBOUND(OutData%WaveVel0,1) + OutData%WaveVel0(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - OutData%Gravity = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%Gravity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WtrDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE FEAM_UnPackInitInput SUBROUTINE FEAM_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -2161,12 +2115,12 @@ SUBROUTINE FEAM_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) + DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) DO I = 1, LEN(InData%WriteOutputHdr) IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdr(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2178,12 +2132,12 @@ SUBROUTINE FEAM_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) + DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) DO I = 1, LEN(InData%WriteOutputUnt) IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUnt(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2223,8 +2177,10 @@ SUBROUTINE FEAM_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LAnchxi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LAnchxi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LAnchxi))-1 ) = PACK(InData%LAnchxi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LAnchxi) + DO i1 = LBOUND(InData%LAnchxi,1), UBOUND(InData%LAnchxi,1) + ReKiBuf(Re_Xferred) = InData%LAnchxi(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LAnchyi) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2236,8 +2192,10 @@ SUBROUTINE FEAM_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LAnchyi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LAnchyi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LAnchyi))-1 ) = PACK(InData%LAnchyi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LAnchyi) + DO i1 = LBOUND(InData%LAnchyi,1), UBOUND(InData%LAnchyi,1) + ReKiBuf(Re_Xferred) = InData%LAnchyi(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LAnchzi) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2249,8 +2207,10 @@ SUBROUTINE FEAM_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LAnchzi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LAnchzi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LAnchzi))-1 ) = PACK(InData%LAnchzi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LAnchzi) + DO i1 = LBOUND(InData%LAnchzi,1), UBOUND(InData%LAnchzi,1) + ReKiBuf(Re_Xferred) = InData%LAnchzi(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LFairxt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2262,8 +2222,10 @@ SUBROUTINE FEAM_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LFairxt,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LFairxt)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LFairxt))-1 ) = PACK(InData%LFairxt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LFairxt) + DO i1 = LBOUND(InData%LFairxt,1), UBOUND(InData%LFairxt,1) + ReKiBuf(Re_Xferred) = InData%LFairxt(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LFairyt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2275,8 +2237,10 @@ SUBROUTINE FEAM_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LFairyt,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LFairyt)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LFairyt))-1 ) = PACK(InData%LFairyt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LFairyt) + DO i1 = LBOUND(InData%LFairyt,1), UBOUND(InData%LFairyt,1) + ReKiBuf(Re_Xferred) = InData%LFairyt(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LFairzt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2288,8 +2252,10 @@ SUBROUTINE FEAM_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LFairzt,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LFairzt)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LFairzt))-1 ) = PACK(InData%LFairzt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LFairzt) + DO i1 = LBOUND(InData%LFairzt,1), UBOUND(InData%LFairzt,1) + ReKiBuf(Re_Xferred) = InData%LFairzt(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE FEAM_PackInitOutput @@ -2306,12 +2272,6 @@ SUBROUTINE FEAM_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -2339,19 +2299,12 @@ SUBROUTINE FEAM_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) DO I = 1, LEN(OutData%WriteOutputHdr) OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated Int_Xferred = Int_Xferred + 1 @@ -2366,19 +2319,12 @@ SUBROUTINE FEAM_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) DO I = 1, LEN(OutData%WriteOutputUnt) OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -2433,15 +2379,10 @@ SUBROUTINE FEAM_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LAnchxi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LAnchxi)>0) OutData%LAnchxi = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LAnchxi))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LAnchxi) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LAnchxi,1), UBOUND(OutData%LAnchxi,1) + OutData%LAnchxi(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LAnchyi not allocated Int_Xferred = Int_Xferred + 1 @@ -2456,15 +2397,10 @@ SUBROUTINE FEAM_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LAnchyi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LAnchyi)>0) OutData%LAnchyi = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LAnchyi))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LAnchyi) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LAnchyi,1), UBOUND(OutData%LAnchyi,1) + OutData%LAnchyi(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LAnchzi not allocated Int_Xferred = Int_Xferred + 1 @@ -2479,15 +2415,10 @@ SUBROUTINE FEAM_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LAnchzi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LAnchzi)>0) OutData%LAnchzi = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LAnchzi))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LAnchzi) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LAnchzi,1), UBOUND(OutData%LAnchzi,1) + OutData%LAnchzi(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LFairxt not allocated Int_Xferred = Int_Xferred + 1 @@ -2502,15 +2433,10 @@ SUBROUTINE FEAM_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LFairxt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LFairxt)>0) OutData%LFairxt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LFairxt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LFairxt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LFairxt,1), UBOUND(OutData%LFairxt,1) + OutData%LFairxt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LFairyt not allocated Int_Xferred = Int_Xferred + 1 @@ -2525,15 +2451,10 @@ SUBROUTINE FEAM_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LFairyt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LFairyt)>0) OutData%LFairyt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LFairyt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LFairyt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LFairyt,1), UBOUND(OutData%LFairyt,1) + OutData%LFairyt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LFairzt not allocated Int_Xferred = Int_Xferred + 1 @@ -2548,15 +2469,10 @@ SUBROUTINE FEAM_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LFairzt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LFairzt)>0) OutData%LFairzt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LFairzt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LFairzt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LFairzt,1), UBOUND(OutData%LFairzt,1) + OutData%LFairzt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE FEAM_UnPackInitOutput @@ -2708,8 +2624,12 @@ SUBROUTINE FEAM_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLU,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%GLU)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GLU))-1 ) = PACK(InData%GLU,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GLU) + DO i2 = LBOUND(InData%GLU,2), UBOUND(InData%GLU,2) + DO i1 = LBOUND(InData%GLU,1), UBOUND(InData%GLU,1) + ReKiBuf(Re_Xferred) = InData%GLU(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%GLDU) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2724,8 +2644,12 @@ SUBROUTINE FEAM_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLDU,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%GLDU)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GLDU))-1 ) = PACK(InData%GLDU,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GLDU) + DO i2 = LBOUND(InData%GLDU,2), UBOUND(InData%GLDU,2) + DO i1 = LBOUND(InData%GLDU,1), UBOUND(InData%GLDU,1) + ReKiBuf(Re_Xferred) = InData%GLDU(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE FEAM_PackContState @@ -2742,12 +2666,6 @@ SUBROUTINE FEAM_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -2779,15 +2697,12 @@ SUBROUTINE FEAM_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GLU.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%GLU)>0) OutData%GLU = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GLU))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GLU) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%GLU,2), UBOUND(OutData%GLU,2) + DO i1 = LBOUND(OutData%GLU,1), UBOUND(OutData%GLU,1) + OutData%GLU(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GLDU not allocated Int_Xferred = Int_Xferred + 1 @@ -2805,15 +2720,12 @@ SUBROUTINE FEAM_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GLDU.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%GLDU)>0) OutData%GLDU = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GLDU))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GLDU) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%GLDU,2), UBOUND(OutData%GLDU,2) + DO i1 = LBOUND(OutData%GLDU,1), UBOUND(OutData%GLDU,1) + OutData%GLDU(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE FEAM_UnPackContState @@ -2908,8 +2820,8 @@ SUBROUTINE FEAM_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyDiscState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE FEAM_PackDiscState SUBROUTINE FEAM_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2925,12 +2837,6 @@ SUBROUTINE FEAM_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_UnPackDiscState' @@ -2944,8 +2850,8 @@ SUBROUTINE FEAM_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyDiscState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyDiscState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE FEAM_UnPackDiscState SUBROUTINE FEAM_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -3042,10 +2948,14 @@ SUBROUTINE FEAM_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TSN))-1 ) = PACK(InData%TSN,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TSN) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TZER))-1 ) = PACK(InData%TZER,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TZER) + DO i1 = LBOUND(InData%TSN,1), UBOUND(InData%TSN,1) + ReKiBuf(Re_Xferred) = InData%TSN(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%TZER,1), UBOUND(InData%TZER,1) + ReKiBuf(Re_Xferred) = InData%TZER(i1) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE FEAM_PackConstrState SUBROUTINE FEAM_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -3061,12 +2971,6 @@ SUBROUTINE FEAM_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -3083,26 +2987,16 @@ SUBROUTINE FEAM_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Xferred = 1 i1_l = LBOUND(OutData%TSN,1) i1_u = UBOUND(OutData%TSN,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%TSN = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TSN))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TSN) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TSN,1), UBOUND(OutData%TSN,1) + OutData%TSN(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%TZER,1) i1_u = UBOUND(OutData%TZER,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%TZER = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TZER))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TZER) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TZER,1), UBOUND(OutData%TZER,1) + OutData%TZER(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE FEAM_UnPackConstrState SUBROUTINE FEAM_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -3359,8 +3253,12 @@ SUBROUTINE FEAM_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLU0,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%GLU0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GLU0))-1 ) = PACK(InData%GLU0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GLU0) + DO i2 = LBOUND(InData%GLU0,2), UBOUND(InData%GLU0,2) + DO i1 = LBOUND(InData%GLU0,1), UBOUND(InData%GLU0,1) + ReKiBuf(Re_Xferred) = InData%GLU0(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%GLDDU) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3375,11 +3273,15 @@ SUBROUTINE FEAM_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLDDU,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%GLDDU)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GLDDU))-1 ) = PACK(InData%GLDDU,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GLDDU) + DO i2 = LBOUND(InData%GLDDU,2), UBOUND(InData%GLDDU,2) + DO i1 = LBOUND(InData%GLDDU,1), UBOUND(InData%GLDDU,1) + ReKiBuf(Re_Xferred) = InData%GLDDU(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%BottomTouch , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%BottomTouch, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%GFORC0) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -3396,8 +3298,14 @@ SUBROUTINE FEAM_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GFORC0,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%GFORC0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GFORC0))-1 ) = PACK(InData%GFORC0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GFORC0) + DO i3 = LBOUND(InData%GFORC0,3), UBOUND(InData%GFORC0,3) + DO i2 = LBOUND(InData%GFORC0,2), UBOUND(InData%GFORC0,2) + DO i1 = LBOUND(InData%GFORC0,1), UBOUND(InData%GFORC0,1) + ReKiBuf(Re_Xferred) = InData%GFORC0(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%GMASS0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3418,8 +3326,16 @@ SUBROUTINE FEAM_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GMASS0,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%GMASS0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GMASS0))-1 ) = PACK(InData%GMASS0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GMASS0) + DO i4 = LBOUND(InData%GMASS0,4), UBOUND(InData%GMASS0,4) + DO i3 = LBOUND(InData%GMASS0,3), UBOUND(InData%GMASS0,3) + DO i2 = LBOUND(InData%GMASS0,2), UBOUND(InData%GMASS0,2) + DO i1 = LBOUND(InData%GMASS0,1), UBOUND(InData%GMASS0,1) + ReKiBuf(Re_Xferred) = InData%GMASS0(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FAST_FPA) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3434,8 +3350,12 @@ SUBROUTINE FEAM_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FAST_FPA,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FAST_FPA)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FAST_FPA))-1 ) = PACK(InData%FAST_FPA,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FAST_FPA) + DO i2 = LBOUND(InData%FAST_FPA,2), UBOUND(InData%FAST_FPA,2) + DO i1 = LBOUND(InData%FAST_FPA,1), UBOUND(InData%FAST_FPA,1) + ReKiBuf(Re_Xferred) = InData%FAST_FPA(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FAST_RP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3450,17 +3370,29 @@ SUBROUTINE FEAM_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FAST_RP,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FAST_RP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FAST_RP))-1 ) = PACK(InData%FAST_RP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FAST_RP) + DO i2 = LBOUND(InData%FAST_RP,2), UBOUND(InData%FAST_RP,2) + DO i1 = LBOUND(InData%FAST_RP,1), UBOUND(InData%FAST_RP,1) + ReKiBuf(Re_Xferred) = InData%FAST_RP(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%INCR - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RSDF))-1 ) = PACK(InData%RSDF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RSDF) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FORC0))-1 ) = PACK(InData%FORC0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FORC0) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%EMAS0))-1 ) = PACK(InData%EMAS0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%EMAS0) + IntKiBuf(Int_Xferred) = InData%INCR + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%RSDF,1), UBOUND(InData%RSDF,1) + ReKiBuf(Re_Xferred) = InData%RSDF(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%FORC0,1), UBOUND(InData%FORC0,1) + ReKiBuf(Re_Xferred) = InData%FORC0(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i2 = LBOUND(InData%EMAS0,2), UBOUND(InData%EMAS0,2) + DO i1 = LBOUND(InData%EMAS0,1), UBOUND(InData%EMAS0,1) + ReKiBuf(Re_Xferred) = InData%EMAS0(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END SUBROUTINE FEAM_PackOtherState SUBROUTINE FEAM_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -3476,12 +3408,6 @@ SUBROUTINE FEAM_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -3515,15 +3441,12 @@ SUBROUTINE FEAM_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GLU0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%GLU0)>0) OutData%GLU0 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GLU0))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GLU0) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%GLU0,2), UBOUND(OutData%GLU0,2) + DO i1 = LBOUND(OutData%GLU0,1), UBOUND(OutData%GLU0,1) + OutData%GLU0(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GLDDU not allocated Int_Xferred = Int_Xferred + 1 @@ -3541,18 +3464,15 @@ SUBROUTINE FEAM_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GLDDU.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%GLDDU)>0) OutData%GLDDU = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GLDDU))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GLDDU) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%GLDDU,2), UBOUND(OutData%GLDDU,2) + DO i1 = LBOUND(OutData%GLDDU,1), UBOUND(OutData%GLDDU,1) + OutData%GLDDU(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%BottomTouch = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%BottomTouch = TRANSFER(IntKiBuf(Int_Xferred), OutData%BottomTouch) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GFORC0 not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3572,15 +3492,14 @@ SUBROUTINE FEAM_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GFORC0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%GFORC0)>0) OutData%GFORC0 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GFORC0))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GFORC0) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%GFORC0,3), UBOUND(OutData%GFORC0,3) + DO i2 = LBOUND(OutData%GFORC0,2), UBOUND(OutData%GFORC0,2) + DO i1 = LBOUND(OutData%GFORC0,1), UBOUND(OutData%GFORC0,1) + OutData%GFORC0(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 ! GMASS0 not allocated Int_Xferred = Int_Xferred + 1 @@ -3604,15 +3523,16 @@ SUBROUTINE FEAM_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GMASS0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%GMASS0)>0) OutData%GMASS0 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GMASS0))-1 ), mask4, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GMASS0) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%GMASS0,4), UBOUND(OutData%GMASS0,4) + DO i3 = LBOUND(OutData%GMASS0,3), UBOUND(OutData%GMASS0,3) + DO i2 = LBOUND(OutData%GMASS0,2), UBOUND(OutData%GMASS0,2) + DO i1 = LBOUND(OutData%GMASS0,1), UBOUND(OutData%GMASS0,1) + OutData%GMASS0(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FAST_FPA not allocated Int_Xferred = Int_Xferred + 1 @@ -3630,15 +3550,12 @@ SUBROUTINE FEAM_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FAST_FPA.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%FAST_FPA)>0) OutData%FAST_FPA = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FAST_FPA))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FAST_FPA) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%FAST_FPA,2), UBOUND(OutData%FAST_FPA,2) + DO i1 = LBOUND(OutData%FAST_FPA,1), UBOUND(OutData%FAST_FPA,1) + OutData%FAST_FPA(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FAST_RP not allocated Int_Xferred = Int_Xferred + 1 @@ -3656,53 +3573,37 @@ SUBROUTINE FEAM_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FAST_RP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%FAST_RP)>0) OutData%FAST_RP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FAST_RP))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FAST_RP) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%FAST_RP,2), UBOUND(OutData%FAST_RP,2) + DO i1 = LBOUND(OutData%FAST_RP,1), UBOUND(OutData%FAST_RP,1) + OutData%FAST_RP(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%INCR = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%INCR = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%RSDF,1) i1_u = UBOUND(OutData%RSDF,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%RSDF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RSDF))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RSDF) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%RSDF,1), UBOUND(OutData%RSDF,1) + OutData%RSDF(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%FORC0,1) i1_u = UBOUND(OutData%FORC0,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%FORC0 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FORC0))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FORC0) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FORC0,1), UBOUND(OutData%FORC0,1) + OutData%FORC0(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%EMAS0,1) i1_u = UBOUND(OutData%EMAS0,1) i2_l = LBOUND(OutData%EMAS0,2) i2_u = UBOUND(OutData%EMAS0,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%EMAS0 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%EMAS0))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%EMAS0) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%EMAS0,2), UBOUND(OutData%EMAS0,2) + DO i1 = LBOUND(OutData%EMAS0,1), UBOUND(OutData%EMAS0,1) + OutData%EMAS0(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END SUBROUTINE FEAM_UnPackOtherState SUBROUTINE FEAM_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -4060,8 +3961,12 @@ SUBROUTINE FEAM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLF,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%GLF)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GLF))-1 ) = PACK(InData%GLF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GLF) + DO i2 = LBOUND(InData%GLF,2), UBOUND(InData%GLF,2) + DO i1 = LBOUND(InData%GLF,1), UBOUND(InData%GLF,1) + ReKiBuf(Re_Xferred) = InData%GLF(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%GLK) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4079,13 +3984,27 @@ SUBROUTINE FEAM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLK,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%GLK)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GLK))-1 ) = PACK(InData%GLK,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GLK) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%EMASS))-1 ) = PACK(InData%EMASS,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%EMASS) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%ESTIF))-1 ) = PACK(InData%ESTIF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%ESTIF) + DO i3 = LBOUND(InData%GLK,3), UBOUND(InData%GLK,3) + DO i2 = LBOUND(InData%GLK,2), UBOUND(InData%GLK,2) + DO i1 = LBOUND(InData%GLK,1), UBOUND(InData%GLK,1) + ReKiBuf(Re_Xferred) = InData%GLK(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + DO i2 = LBOUND(InData%EMASS,2), UBOUND(InData%EMASS,2) + DO i1 = LBOUND(InData%EMASS,1), UBOUND(InData%EMASS,1) + ReKiBuf(Re_Xferred) = InData%EMASS(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%ESTIF,2), UBOUND(InData%ESTIF,2) + DO i1 = LBOUND(InData%ESTIF,1), UBOUND(InData%ESTIF,1) + ReKiBuf(Re_Xferred) = InData%ESTIF(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO IF ( .NOT. ALLOCATED(InData%FAST_FP) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4099,31 +4018,67 @@ SUBROUTINE FEAM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FAST_FP,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FAST_FP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FAST_FP))-1 ) = PACK(InData%FAST_FP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FAST_FP) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FORCE))-1 ) = PACK(InData%FORCE,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FORCE) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FP))-1 ) = PACK(InData%FP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FP) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%U))-1 ) = PACK(InData%U,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%U) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%U0))-1 ) = PACK(InData%U0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%U0) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DU))-1 ) = PACK(InData%DU,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DU) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DDU))-1 ) = PACK(InData%DDU,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DDU) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%R))-1 ) = PACK(InData%R,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%R) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RP))-1 ) = PACK(InData%RP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RP) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RHSR))-1 ) = PACK(InData%RHSR,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RHSR) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SLIN))-1 ) = PACK(InData%SLIN,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SLIN) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%STIFR))-1 ) = PACK(InData%STIFR,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%STIFR) + DO i2 = LBOUND(InData%FAST_FP,2), UBOUND(InData%FAST_FP,2) + DO i1 = LBOUND(InData%FAST_FP,1), UBOUND(InData%FAST_FP,1) + ReKiBuf(Re_Xferred) = InData%FAST_FP(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + DO i1 = LBOUND(InData%FORCE,1), UBOUND(InData%FORCE,1) + ReKiBuf(Re_Xferred) = InData%FORCE(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%FP,1), UBOUND(InData%FP,1) + ReKiBuf(Re_Xferred) = InData%FP(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i2 = LBOUND(InData%U,2), UBOUND(InData%U,2) + DO i1 = LBOUND(InData%U,1), UBOUND(InData%U,1) + ReKiBuf(Re_Xferred) = InData%U(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%U0,2), UBOUND(InData%U0,2) + DO i1 = LBOUND(InData%U0,1), UBOUND(InData%U0,1) + ReKiBuf(Re_Xferred) = InData%U0(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%DU,2), UBOUND(InData%DU,2) + DO i1 = LBOUND(InData%DU,1), UBOUND(InData%DU,1) + ReKiBuf(Re_Xferred) = InData%DU(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%DDU,2), UBOUND(InData%DDU,2) + DO i1 = LBOUND(InData%DDU,1), UBOUND(InData%DDU,1) + ReKiBuf(Re_Xferred) = InData%DDU(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i1 = LBOUND(InData%R,1), UBOUND(InData%R,1) + ReKiBuf(Re_Xferred) = InData%R(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%RP,1), UBOUND(InData%RP,1) + ReKiBuf(Re_Xferred) = InData%RP(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%RHSR,1), UBOUND(InData%RHSR,1) + ReKiBuf(Re_Xferred) = InData%RHSR(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%SLIN,1), UBOUND(InData%SLIN,1) + ReKiBuf(Re_Xferred) = InData%SLIN(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i2 = LBOUND(InData%STIFR,2), UBOUND(InData%STIFR,2) + DO i1 = LBOUND(InData%STIFR,1), UBOUND(InData%STIFR,1) + ReKiBuf(Re_Xferred) = InData%STIFR(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO IF ( .NOT. ALLOCATED(InData%FAIR_ANG) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4137,8 +4092,12 @@ SUBROUTINE FEAM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FAIR_ANG,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FAIR_ANG)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FAIR_ANG))-1 ) = PACK(InData%FAIR_ANG,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FAIR_ANG) + DO i2 = LBOUND(InData%FAIR_ANG,2), UBOUND(InData%FAIR_ANG,2) + DO i1 = LBOUND(InData%FAIR_ANG,1), UBOUND(InData%FAIR_ANG,1) + ReKiBuf(Re_Xferred) = InData%FAIR_ANG(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FAIR_T) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4150,8 +4109,10 @@ SUBROUTINE FEAM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FAIR_T,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FAIR_T)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FAIR_T))-1 ) = PACK(InData%FAIR_T,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FAIR_T) + DO i1 = LBOUND(InData%FAIR_T,1), UBOUND(InData%FAIR_T,1) + ReKiBuf(Re_Xferred) = InData%FAIR_T(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%ANCH_ANG) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4166,8 +4127,12 @@ SUBROUTINE FEAM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ANCH_ANG,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ANCH_ANG)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%ANCH_ANG))-1 ) = PACK(InData%ANCH_ANG,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%ANCH_ANG) + DO i2 = LBOUND(InData%ANCH_ANG,2), UBOUND(InData%ANCH_ANG,2) + DO i1 = LBOUND(InData%ANCH_ANG,1), UBOUND(InData%ANCH_ANG,1) + ReKiBuf(Re_Xferred) = InData%ANCH_ANG(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%ANCH_T) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4179,8 +4144,10 @@ SUBROUTINE FEAM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ANCH_T,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ANCH_T)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%ANCH_T))-1 ) = PACK(InData%ANCH_T,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%ANCH_T) + DO i1 = LBOUND(InData%ANCH_T,1), UBOUND(InData%ANCH_T,1) + ReKiBuf(Re_Xferred) = InData%ANCH_T(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%Line_Coordinate) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4198,8 +4165,14 @@ SUBROUTINE FEAM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Line_Coordinate,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Line_Coordinate)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Line_Coordinate))-1 ) = PACK(InData%Line_Coordinate,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Line_Coordinate) + DO i3 = LBOUND(InData%Line_Coordinate,3), UBOUND(InData%Line_Coordinate,3) + DO i2 = LBOUND(InData%Line_Coordinate,2), UBOUND(InData%Line_Coordinate,2) + DO i1 = LBOUND(InData%Line_Coordinate,1), UBOUND(InData%Line_Coordinate,1) + ReKiBuf(Re_Xferred) = InData%Line_Coordinate(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Line_Tangent) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4217,8 +4190,14 @@ SUBROUTINE FEAM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Line_Tangent,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Line_Tangent)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Line_Tangent))-1 ) = PACK(InData%Line_Tangent,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Line_Tangent) + DO i3 = LBOUND(InData%Line_Tangent,3), UBOUND(InData%Line_Tangent,3) + DO i2 = LBOUND(InData%Line_Tangent,2), UBOUND(InData%Line_Tangent,2) + DO i1 = LBOUND(InData%Line_Tangent,1), UBOUND(InData%Line_Tangent,1) + ReKiBuf(Re_Xferred) = InData%Line_Tangent(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%F_Lines) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4233,11 +4212,15 @@ SUBROUTINE FEAM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_Lines,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%F_Lines)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_Lines))-1 ) = PACK(InData%F_Lines,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_Lines) + DO i2 = LBOUND(InData%F_Lines,2), UBOUND(InData%F_Lines,2) + DO i1 = LBOUND(InData%F_Lines,1), UBOUND(InData%F_Lines,1) + ReKiBuf(Re_Xferred) = InData%F_Lines(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%LastIndWave - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%LastIndWave + Int_Xferred = Int_Xferred + 1 END SUBROUTINE FEAM_PackMisc SUBROUTINE FEAM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -4253,12 +4236,6 @@ SUBROUTINE FEAM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -4291,15 +4268,12 @@ SUBROUTINE FEAM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GLF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%GLF)>0) OutData%GLF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GLF))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GLF) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%GLF,2), UBOUND(OutData%GLF,2) + DO i1 = LBOUND(OutData%GLF,1), UBOUND(OutData%GLF,1) + OutData%GLF(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GLK not allocated Int_Xferred = Int_Xferred + 1 @@ -4320,42 +4294,35 @@ SUBROUTINE FEAM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GLK.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%GLK)>0) OutData%GLK = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GLK))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GLK) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%GLK,3), UBOUND(OutData%GLK,3) + DO i2 = LBOUND(OutData%GLK,2), UBOUND(OutData%GLK,2) + DO i1 = LBOUND(OutData%GLK,1), UBOUND(OutData%GLK,1) + OutData%GLK(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF i1_l = LBOUND(OutData%EMASS,1) i1_u = UBOUND(OutData%EMASS,1) i2_l = LBOUND(OutData%EMASS,2) i2_u = UBOUND(OutData%EMASS,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%EMASS = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%EMASS))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%EMASS) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%EMASS,2), UBOUND(OutData%EMASS,2) + DO i1 = LBOUND(OutData%EMASS,1), UBOUND(OutData%EMASS,1) + OutData%EMASS(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%ESTIF,1) i1_u = UBOUND(OutData%ESTIF,1) i2_l = LBOUND(OutData%ESTIF,2) i2_u = UBOUND(OutData%ESTIF,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%ESTIF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%ESTIF))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%ESTIF) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%ESTIF,2), UBOUND(OutData%ESTIF,2) + DO i1 = LBOUND(OutData%ESTIF,1), UBOUND(OutData%ESTIF,1) + OutData%ESTIF(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FAST_FP not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -4372,147 +4339,99 @@ SUBROUTINE FEAM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FAST_FP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%FAST_FP)>0) OutData%FAST_FP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FAST_FP))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FAST_FP) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%FAST_FP,2), UBOUND(OutData%FAST_FP,2) + DO i1 = LBOUND(OutData%FAST_FP,1), UBOUND(OutData%FAST_FP,1) + OutData%FAST_FP(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF i1_l = LBOUND(OutData%FORCE,1) i1_u = UBOUND(OutData%FORCE,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%FORCE = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FORCE))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FORCE) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FORCE,1), UBOUND(OutData%FORCE,1) + OutData%FORCE(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%FP,1) i1_u = UBOUND(OutData%FP,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%FP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FP))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FP) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FP,1), UBOUND(OutData%FP,1) + OutData%FP(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%U,1) i1_u = UBOUND(OutData%U,1) i2_l = LBOUND(OutData%U,2) i2_u = UBOUND(OutData%U,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%U = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%U))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%U) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%U,2), UBOUND(OutData%U,2) + DO i1 = LBOUND(OutData%U,1), UBOUND(OutData%U,1) + OutData%U(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%U0,1) i1_u = UBOUND(OutData%U0,1) i2_l = LBOUND(OutData%U0,2) i2_u = UBOUND(OutData%U0,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%U0 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%U0))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%U0) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%U0,2), UBOUND(OutData%U0,2) + DO i1 = LBOUND(OutData%U0,1), UBOUND(OutData%U0,1) + OutData%U0(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%DU,1) i1_u = UBOUND(OutData%DU,1) i2_l = LBOUND(OutData%DU,2) i2_u = UBOUND(OutData%DU,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%DU = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DU))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DU) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%DU,2), UBOUND(OutData%DU,2) + DO i1 = LBOUND(OutData%DU,1), UBOUND(OutData%DU,1) + OutData%DU(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%DDU,1) i1_u = UBOUND(OutData%DDU,1) i2_l = LBOUND(OutData%DDU,2) i2_u = UBOUND(OutData%DDU,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%DDU = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DDU))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DDU) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%DDU,2), UBOUND(OutData%DDU,2) + DO i1 = LBOUND(OutData%DDU,1), UBOUND(OutData%DDU,1) + OutData%DDU(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%R,1) i1_u = UBOUND(OutData%R,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%R = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%R))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%R) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%R,1), UBOUND(OutData%R,1) + OutData%R(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%RP,1) i1_u = UBOUND(OutData%RP,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%RP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RP))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RP) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%RP,1), UBOUND(OutData%RP,1) + OutData%RP(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%RHSR,1) i1_u = UBOUND(OutData%RHSR,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%RHSR = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RHSR))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RHSR) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%RHSR,1), UBOUND(OutData%RHSR,1) + OutData%RHSR(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%SLIN,1) i1_u = UBOUND(OutData%SLIN,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%SLIN = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SLIN))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SLIN) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%SLIN,1), UBOUND(OutData%SLIN,1) + OutData%SLIN(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%STIFR,1) i1_u = UBOUND(OutData%STIFR,1) i2_l = LBOUND(OutData%STIFR,2) i2_u = UBOUND(OutData%STIFR,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%STIFR = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%STIFR))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%STIFR) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%STIFR,2), UBOUND(OutData%STIFR,2) + DO i1 = LBOUND(OutData%STIFR,1), UBOUND(OutData%STIFR,1) + OutData%STIFR(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FAIR_ANG not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -4529,15 +4448,12 @@ SUBROUTINE FEAM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FAIR_ANG.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%FAIR_ANG)>0) OutData%FAIR_ANG = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FAIR_ANG))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FAIR_ANG) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%FAIR_ANG,2), UBOUND(OutData%FAIR_ANG,2) + DO i1 = LBOUND(OutData%FAIR_ANG,1), UBOUND(OutData%FAIR_ANG,1) + OutData%FAIR_ANG(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FAIR_T not allocated Int_Xferred = Int_Xferred + 1 @@ -4552,15 +4468,10 @@ SUBROUTINE FEAM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FAIR_T.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%FAIR_T)>0) OutData%FAIR_T = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FAIR_T))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FAIR_T) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FAIR_T,1), UBOUND(OutData%FAIR_T,1) + OutData%FAIR_T(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ANCH_ANG not allocated Int_Xferred = Int_Xferred + 1 @@ -4578,15 +4489,12 @@ SUBROUTINE FEAM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ANCH_ANG.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%ANCH_ANG)>0) OutData%ANCH_ANG = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%ANCH_ANG))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%ANCH_ANG) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%ANCH_ANG,2), UBOUND(OutData%ANCH_ANG,2) + DO i1 = LBOUND(OutData%ANCH_ANG,1), UBOUND(OutData%ANCH_ANG,1) + OutData%ANCH_ANG(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ANCH_T not allocated Int_Xferred = Int_Xferred + 1 @@ -4601,15 +4509,10 @@ SUBROUTINE FEAM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ANCH_T.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%ANCH_T)>0) OutData%ANCH_T = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%ANCH_T))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%ANCH_T) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%ANCH_T,1), UBOUND(OutData%ANCH_T,1) + OutData%ANCH_T(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Line_Coordinate not allocated Int_Xferred = Int_Xferred + 1 @@ -4630,15 +4533,14 @@ SUBROUTINE FEAM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Line_Coordinate.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%Line_Coordinate)>0) OutData%Line_Coordinate = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Line_Coordinate))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Line_Coordinate) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%Line_Coordinate,3), UBOUND(OutData%Line_Coordinate,3) + DO i2 = LBOUND(OutData%Line_Coordinate,2), UBOUND(OutData%Line_Coordinate,2) + DO i1 = LBOUND(OutData%Line_Coordinate,1), UBOUND(OutData%Line_Coordinate,1) + OutData%Line_Coordinate(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 ! Line_Tangent not allocated Int_Xferred = Int_Xferred + 1 @@ -4659,15 +4561,14 @@ SUBROUTINE FEAM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Line_Tangent.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%Line_Tangent)>0) OutData%Line_Tangent = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Line_Tangent))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Line_Tangent) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%Line_Tangent,3), UBOUND(OutData%Line_Tangent,3) + DO i2 = LBOUND(OutData%Line_Tangent,2), UBOUND(OutData%Line_Tangent,2) + DO i1 = LBOUND(OutData%Line_Tangent,1), UBOUND(OutData%Line_Tangent,1) + OutData%Line_Tangent(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 ! F_Lines not allocated Int_Xferred = Int_Xferred + 1 @@ -4685,18 +4586,15 @@ SUBROUTINE FEAM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_Lines.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%F_Lines)>0) OutData%F_Lines = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_Lines))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_Lines) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%F_Lines,2), UBOUND(OutData%F_Lines,2) + DO i1 = LBOUND(OutData%F_Lines,1), UBOUND(OutData%F_Lines,1) + OutData%F_Lines(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%LastIndWave = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%LastIndWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE FEAM_UnPackMisc SUBROUTINE FEAM_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -5268,22 +5166,24 @@ SUBROUTINE FEAM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GRAV))-1 ) = PACK(InData%GRAV,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GRAV) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Eps - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MaxIter - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NHBD - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NDIM - Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(InData%GRAV,1), UBOUND(InData%GRAV,1) + ReKiBuf(Re_Xferred) = InData%GRAV(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%Eps + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Gravity + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDens + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MaxIter + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NHBD + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NDIM + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%NEQ) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -5294,17 +5194,19 @@ SUBROUTINE FEAM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NEQ,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%NEQ)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%NEQ))-1 ) = PACK(InData%NEQ,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%NEQ) + DO i1 = LBOUND(InData%NEQ,1), UBOUND(InData%NEQ,1) + IntKiBuf(Int_Xferred) = InData%NEQ(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NBAND - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumLines - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumElems - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumNodes - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NBAND + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumLines + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumElems + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumNodes + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%GSL) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -5321,8 +5223,14 @@ SUBROUTINE FEAM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GSL,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%GSL)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GSL))-1 ) = PACK(InData%GSL,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GSL) + DO i3 = LBOUND(InData%GSL,3), UBOUND(InData%GSL,3) + DO i2 = LBOUND(InData%GSL,2), UBOUND(InData%GSL,2) + DO i1 = LBOUND(InData%GSL,1), UBOUND(InData%GSL,1) + ReKiBuf(Re_Xferred) = InData%GSL(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%GP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5337,8 +5245,12 @@ SUBROUTINE FEAM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GP,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%GP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GP))-1 ) = PACK(InData%GP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GP) + DO i2 = LBOUND(InData%GP,2), UBOUND(InData%GP,2) + DO i1 = LBOUND(InData%GP,1), UBOUND(InData%GP,1) + ReKiBuf(Re_Xferred) = InData%GP(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Elength) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5350,8 +5262,10 @@ SUBROUTINE FEAM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Elength,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Elength)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Elength))-1 ) = PACK(InData%Elength,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Elength) + DO i1 = LBOUND(InData%Elength,1), UBOUND(InData%Elength,1) + ReKiBuf(Re_Xferred) = InData%Elength(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%BottmElev) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5363,8 +5277,10 @@ SUBROUTINE FEAM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BottmElev,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BottmElev)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BottmElev))-1 ) = PACK(InData%BottmElev,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BottmElev) + DO i1 = LBOUND(InData%BottmElev,1), UBOUND(InData%BottmElev,1) + ReKiBuf(Re_Xferred) = InData%BottmElev(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%BottmStiff) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5376,8 +5292,10 @@ SUBROUTINE FEAM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BottmStiff,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BottmStiff)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BottmStiff))-1 ) = PACK(InData%BottmStiff,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BottmStiff) + DO i1 = LBOUND(InData%BottmStiff,1), UBOUND(InData%BottmStiff,1) + ReKiBuf(Re_Xferred) = InData%BottmStiff(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LMassDen) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5389,8 +5307,10 @@ SUBROUTINE FEAM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LMassDen,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LMassDen)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LMassDen))-1 ) = PACK(InData%LMassDen,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LMassDen) + DO i1 = LBOUND(InData%LMassDen,1), UBOUND(InData%LMassDen,1) + ReKiBuf(Re_Xferred) = InData%LMassDen(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LDMassDen) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5402,8 +5322,10 @@ SUBROUTINE FEAM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LDMassDen,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LDMassDen)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LDMassDen))-1 ) = PACK(InData%LDMassDen,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LDMassDen) + DO i1 = LBOUND(InData%LDMassDen,1), UBOUND(InData%LDMassDen,1) + ReKiBuf(Re_Xferred) = InData%LDMassDen(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LEAStiff) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5415,8 +5337,10 @@ SUBROUTINE FEAM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LEAStiff,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LEAStiff)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LEAStiff))-1 ) = PACK(InData%LEAStiff,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LEAStiff) + DO i1 = LBOUND(InData%LEAStiff,1), UBOUND(InData%LEAStiff,1) + ReKiBuf(Re_Xferred) = InData%LEAStiff(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LineCI) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5428,8 +5352,10 @@ SUBROUTINE FEAM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LineCI,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LineCI)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LineCI))-1 ) = PACK(InData%LineCI,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LineCI) + DO i1 = LBOUND(InData%LineCI,1), UBOUND(InData%LineCI,1) + ReKiBuf(Re_Xferred) = InData%LineCI(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LineCD) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5441,8 +5367,10 @@ SUBROUTINE FEAM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LineCD,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LineCD)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LineCD))-1 ) = PACK(InData%LineCD,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LineCD) + DO i1 = LBOUND(InData%LineCD,1), UBOUND(InData%LineCD,1) + ReKiBuf(Re_Xferred) = InData%LineCD(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%Bvp) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5457,8 +5385,12 @@ SUBROUTINE FEAM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Bvp,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Bvp)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Bvp))-1 ) = PACK(InData%Bvp,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Bvp) + DO i2 = LBOUND(InData%Bvp,2), UBOUND(InData%Bvp,2) + DO i1 = LBOUND(InData%Bvp,1), UBOUND(InData%Bvp,1) + ReKiBuf(Re_Xferred) = InData%Bvp(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveAcc0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5476,8 +5408,14 @@ SUBROUTINE FEAM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc0,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveAcc0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveAcc0))-1 ) = PACK(InData%WaveAcc0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveAcc0) + DO i3 = LBOUND(InData%WaveAcc0,3), UBOUND(InData%WaveAcc0,3) + DO i2 = LBOUND(InData%WaveAcc0,2), UBOUND(InData%WaveAcc0,2) + DO i1 = LBOUND(InData%WaveAcc0,1), UBOUND(InData%WaveAcc0,1) + ReKiBuf(Re_Xferred) = InData%WaveAcc0(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5489,8 +5427,10 @@ SUBROUTINE FEAM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveTime)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveTime))-1 ) = PACK(InData%WaveTime,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveTime) + DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) + ReKiBuf(Re_Xferred) = InData%WaveTime(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveVel0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5508,53 +5448,119 @@ SUBROUTINE FEAM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel0,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveVel0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveVel0))-1 ) = PACK(InData%WaveVel0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveVel0) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SHAP))-1 ) = PACK(InData%SHAP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SHAP) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SHAPS))-1 ) = PACK(InData%SHAPS,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SHAPS) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GAUSSW))-1 ) = PACK(InData%GAUSSW,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GAUSSW) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NGAUSS - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SHAPT))-1 ) = PACK(InData%SHAPT,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SHAPT) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SHAPTS))-1 ) = PACK(InData%SHAPTS,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SHAPTS) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NTRAP - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SBEND))-1 ) = PACK(InData%SBEND,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SBEND) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%STEN))-1 ) = PACK(InData%STEN,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%STEN) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RMASS))-1 ) = PACK(InData%RMASS,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RMASS) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RADDM))-1 ) = PACK(InData%RADDM,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RADDM) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PMPN))-1 ) = PACK(InData%PMPN,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PMPN) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AM))-1 ) = PACK(InData%AM,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AM) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PM))-1 ) = PACK(InData%PM,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PM) - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%IDOF))-1 ) = PACK(InData%IDOF,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%IDOF) - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%JDOF))-1 ) = PACK(InData%JDOF,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%JDOF) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PPA))-1 ) = PACK(InData%PPA,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PPA) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmRefzt - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO i3 = LBOUND(InData%WaveVel0,3), UBOUND(InData%WaveVel0,3) + DO i2 = LBOUND(InData%WaveVel0,2), UBOUND(InData%WaveVel0,2) + DO i1 = LBOUND(InData%WaveVel0,1), UBOUND(InData%WaveVel0,1) + ReKiBuf(Re_Xferred) = InData%WaveVel0(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IntKiBuf(Int_Xferred) = InData%NStepWave + Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(InData%SHAP,2), UBOUND(InData%SHAP,2) + DO i1 = LBOUND(InData%SHAP,1), UBOUND(InData%SHAP,1) + ReKiBuf(Re_Xferred) = InData%SHAP(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%SHAPS,2), UBOUND(InData%SHAPS,2) + DO i1 = LBOUND(InData%SHAPS,1), UBOUND(InData%SHAPS,1) + ReKiBuf(Re_Xferred) = InData%SHAPS(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i1 = LBOUND(InData%GAUSSW,1), UBOUND(InData%GAUSSW,1) + ReKiBuf(Re_Xferred) = InData%GAUSSW(i1) + Re_Xferred = Re_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%NGAUSS + Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(InData%SHAPT,2), UBOUND(InData%SHAPT,2) + DO i1 = LBOUND(InData%SHAPT,1), UBOUND(InData%SHAPT,1) + ReKiBuf(Re_Xferred) = InData%SHAPT(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%SHAPTS,2), UBOUND(InData%SHAPTS,2) + DO i1 = LBOUND(InData%SHAPTS,1), UBOUND(InData%SHAPTS,1) + ReKiBuf(Re_Xferred) = InData%SHAPTS(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + IntKiBuf(Int_Xferred) = InData%NTRAP + Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(InData%SBEND,2), UBOUND(InData%SBEND,2) + DO i1 = LBOUND(InData%SBEND,1), UBOUND(InData%SBEND,1) + ReKiBuf(Re_Xferred) = InData%SBEND(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i3 = LBOUND(InData%STEN,3), UBOUND(InData%STEN,3) + DO i2 = LBOUND(InData%STEN,2), UBOUND(InData%STEN,2) + DO i1 = LBOUND(InData%STEN,1), UBOUND(InData%STEN,1) + ReKiBuf(Re_Xferred) = InData%STEN(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + DO i2 = LBOUND(InData%RMASS,2), UBOUND(InData%RMASS,2) + DO i1 = LBOUND(InData%RMASS,1), UBOUND(InData%RMASS,1) + ReKiBuf(Re_Xferred) = InData%RMASS(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i4 = LBOUND(InData%RADDM,4), UBOUND(InData%RADDM,4) + DO i3 = LBOUND(InData%RADDM,3), UBOUND(InData%RADDM,3) + DO i2 = LBOUND(InData%RADDM,2), UBOUND(InData%RADDM,2) + DO i1 = LBOUND(InData%RADDM,1), UBOUND(InData%RADDM,1) + ReKiBuf(Re_Xferred) = InData%RADDM(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + DO i2 = LBOUND(InData%PMPN,2), UBOUND(InData%PMPN,2) + DO i1 = LBOUND(InData%PMPN,1), UBOUND(InData%PMPN,1) + ReKiBuf(Re_Xferred) = InData%PMPN(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i1 = LBOUND(InData%AM,1), UBOUND(InData%AM,1) + ReKiBuf(Re_Xferred) = InData%AM(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%PM,1), UBOUND(InData%PM,1) + ReKiBuf(Re_Xferred) = InData%PM(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i2 = LBOUND(InData%IDOF,2), UBOUND(InData%IDOF,2) + DO i1 = LBOUND(InData%IDOF,1), UBOUND(InData%IDOF,1) + IntKiBuf(Int_Xferred) = InData%IDOF(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + DO i1 = LBOUND(InData%JDOF,1), UBOUND(InData%JDOF,1) + IntKiBuf(Int_Xferred) = InData%JDOF(i1) + Int_Xferred = Int_Xferred + 1 + END DO + DO i3 = LBOUND(InData%PPA,3), UBOUND(InData%PPA,3) + DO i2 = LBOUND(InData%PPA,2), UBOUND(InData%PPA,2) + DO i1 = LBOUND(InData%PPA,1), UBOUND(InData%PPA,1) + ReKiBuf(Re_Xferred) = InData%PPA(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + ReKiBuf(Re_Xferred) = InData%PtfmRefzt + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -5596,10 +5602,10 @@ SUBROUTINE FEAM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, ENDIF END DO END IF - DO I = 1, LEN(InData%Delim) - IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(InData%Delim) + IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( .NOT. ALLOCATED(InData%GLUZR) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -5616,8 +5622,14 @@ SUBROUTINE FEAM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLUZR,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%GLUZR)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GLUZR))-1 ) = PACK(InData%GLUZR,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GLUZR) + DO i3 = LBOUND(InData%GLUZR,3), UBOUND(InData%GLUZR,3) + DO i2 = LBOUND(InData%GLUZR,2), UBOUND(InData%GLUZR,2) + DO i1 = LBOUND(InData%GLUZR,1), UBOUND(InData%GLUZR,1) + ReKiBuf(Re_Xferred) = InData%GLUZR(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%GTZER) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5632,8 +5644,12 @@ SUBROUTINE FEAM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GTZER,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%GTZER)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GTZER))-1 ) = PACK(InData%GTZER,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GTZER) + DO i2 = LBOUND(InData%GTZER,2), UBOUND(InData%GTZER,2) + DO i1 = LBOUND(InData%GTZER,1), UBOUND(InData%GTZER,1) + ReKiBuf(Re_Xferred) = InData%GTZER(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE FEAM_PackParam @@ -5650,12 +5666,6 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -5673,31 +5683,26 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 i1_l = LBOUND(OutData%GRAV,1) i1_u = UBOUND(OutData%GRAV,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%GRAV = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GRAV))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GRAV) - DEALLOCATE(mask1) - OutData%Eps = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Gravity = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MaxIter = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NHBD = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NDIM = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%GRAV,1), UBOUND(OutData%GRAV,1) + OutData%GRAV(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%Eps = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Gravity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WtrDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MaxIter = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NHBD = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NDIM = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NEQ not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5711,24 +5716,19 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NEQ.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%NEQ)>0) OutData%NEQ = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%NEQ))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%NEQ) - DEALLOCATE(mask1) - END IF - OutData%NBAND = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumLines = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumElems = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumNodes = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%NEQ,1), UBOUND(OutData%NEQ,1) + OutData%NEQ(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + OutData%NBAND = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumLines = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumElems = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumNodes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GSL not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5748,15 +5748,14 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GSL.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%GSL)>0) OutData%GSL = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GSL))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GSL) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%GSL,3), UBOUND(OutData%GSL,3) + DO i2 = LBOUND(OutData%GSL,2), UBOUND(OutData%GSL,2) + DO i1 = LBOUND(OutData%GSL,1), UBOUND(OutData%GSL,1) + OutData%GSL(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 ! GP not allocated Int_Xferred = Int_Xferred + 1 @@ -5774,15 +5773,12 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%GP)>0) OutData%GP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GP))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GP) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%GP,2), UBOUND(OutData%GP,2) + DO i1 = LBOUND(OutData%GP,1), UBOUND(OutData%GP,1) + OutData%GP(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Elength not allocated Int_Xferred = Int_Xferred + 1 @@ -5797,15 +5793,10 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Elength.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Elength)>0) OutData%Elength = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Elength))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Elength) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Elength,1), UBOUND(OutData%Elength,1) + OutData%Elength(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BottmElev not allocated Int_Xferred = Int_Xferred + 1 @@ -5820,15 +5811,10 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BottmElev.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BottmElev)>0) OutData%BottmElev = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BottmElev))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BottmElev) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BottmElev,1), UBOUND(OutData%BottmElev,1) + OutData%BottmElev(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BottmStiff not allocated Int_Xferred = Int_Xferred + 1 @@ -5843,15 +5829,10 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BottmStiff.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BottmStiff)>0) OutData%BottmStiff = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BottmStiff))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BottmStiff) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BottmStiff,1), UBOUND(OutData%BottmStiff,1) + OutData%BottmStiff(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LMassDen not allocated Int_Xferred = Int_Xferred + 1 @@ -5866,15 +5847,10 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LMassDen.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LMassDen)>0) OutData%LMassDen = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LMassDen))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LMassDen) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LMassDen,1), UBOUND(OutData%LMassDen,1) + OutData%LMassDen(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LDMassDen not allocated Int_Xferred = Int_Xferred + 1 @@ -5889,15 +5865,10 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LDMassDen.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LDMassDen)>0) OutData%LDMassDen = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LDMassDen))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LDMassDen) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LDMassDen,1), UBOUND(OutData%LDMassDen,1) + OutData%LDMassDen(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LEAStiff not allocated Int_Xferred = Int_Xferred + 1 @@ -5912,15 +5883,10 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LEAStiff.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LEAStiff)>0) OutData%LEAStiff = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LEAStiff))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LEAStiff) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LEAStiff,1), UBOUND(OutData%LEAStiff,1) + OutData%LEAStiff(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LineCI not allocated Int_Xferred = Int_Xferred + 1 @@ -5935,15 +5901,10 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineCI.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LineCI)>0) OutData%LineCI = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LineCI))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LineCI) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LineCI,1), UBOUND(OutData%LineCI,1) + OutData%LineCI(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LineCD not allocated Int_Xferred = Int_Xferred + 1 @@ -5958,15 +5919,10 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineCD.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LineCD)>0) OutData%LineCD = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LineCD))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LineCD) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LineCD,1), UBOUND(OutData%LineCD,1) + OutData%LineCD(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Bvp not allocated Int_Xferred = Int_Xferred + 1 @@ -5984,15 +5940,12 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Bvp.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Bvp)>0) OutData%Bvp = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Bvp))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Bvp) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Bvp,2), UBOUND(OutData%Bvp,2) + DO i1 = LBOUND(OutData%Bvp,1), UBOUND(OutData%Bvp,1) + OutData%Bvp(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAcc0 not allocated Int_Xferred = Int_Xferred + 1 @@ -6013,15 +5966,14 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%WaveAcc0)>0) OutData%WaveAcc0 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveAcc0))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveAcc0) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%WaveAcc0,3), UBOUND(OutData%WaveAcc0,3) + DO i2 = LBOUND(OutData%WaveAcc0,2), UBOUND(OutData%WaveAcc0,2) + DO i1 = LBOUND(OutData%WaveAcc0,1), UBOUND(OutData%WaveAcc0,1) + OutData%WaveAcc0(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 ! WaveTime not allocated Int_Xferred = Int_Xferred + 1 @@ -6036,15 +5988,10 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveTime)>0) OutData%WaveTime = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveTime))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveTime) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) + OutData%WaveTime(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel0 not allocated Int_Xferred = Int_Xferred + 1 @@ -6065,126 +6012,101 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%WaveVel0)>0) OutData%WaveVel0 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveVel0))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveVel0) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%WaveVel0,3), UBOUND(OutData%WaveVel0,3) + DO i2 = LBOUND(OutData%WaveVel0,2), UBOUND(OutData%WaveVel0,2) + DO i1 = LBOUND(OutData%WaveVel0,1), UBOUND(OutData%WaveVel0,1) + OutData%WaveVel0(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - OutData%NStepWave = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NStepWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%SHAP,1) i1_u = UBOUND(OutData%SHAP,1) i2_l = LBOUND(OutData%SHAP,2) i2_u = UBOUND(OutData%SHAP,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%SHAP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SHAP))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SHAP) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%SHAP,2), UBOUND(OutData%SHAP,2) + DO i1 = LBOUND(OutData%SHAP,1), UBOUND(OutData%SHAP,1) + OutData%SHAP(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%SHAPS,1) i1_u = UBOUND(OutData%SHAPS,1) i2_l = LBOUND(OutData%SHAPS,2) i2_u = UBOUND(OutData%SHAPS,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%SHAPS = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SHAPS))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SHAPS) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%SHAPS,2), UBOUND(OutData%SHAPS,2) + DO i1 = LBOUND(OutData%SHAPS,1), UBOUND(OutData%SHAPS,1) + OutData%SHAPS(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%GAUSSW,1) i1_u = UBOUND(OutData%GAUSSW,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%GAUSSW = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GAUSSW))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GAUSSW) - DEALLOCATE(mask1) - OutData%NGAUSS = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%GAUSSW,1), UBOUND(OutData%GAUSSW,1) + OutData%GAUSSW(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%NGAUSS = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%SHAPT,1) i1_u = UBOUND(OutData%SHAPT,1) i2_l = LBOUND(OutData%SHAPT,2) i2_u = UBOUND(OutData%SHAPT,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%SHAPT = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SHAPT))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SHAPT) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%SHAPT,2), UBOUND(OutData%SHAPT,2) + DO i1 = LBOUND(OutData%SHAPT,1), UBOUND(OutData%SHAPT,1) + OutData%SHAPT(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%SHAPTS,1) i1_u = UBOUND(OutData%SHAPTS,1) i2_l = LBOUND(OutData%SHAPTS,2) i2_u = UBOUND(OutData%SHAPTS,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%SHAPTS = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SHAPTS))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SHAPTS) - DEALLOCATE(mask2) - OutData%NTRAP = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(OutData%SHAPTS,2), UBOUND(OutData%SHAPTS,2) + DO i1 = LBOUND(OutData%SHAPTS,1), UBOUND(OutData%SHAPTS,1) + OutData%SHAPTS(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + OutData%NTRAP = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%SBEND,1) i1_u = UBOUND(OutData%SBEND,1) i2_l = LBOUND(OutData%SBEND,2) i2_u = UBOUND(OutData%SBEND,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%SBEND = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SBEND))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SBEND) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%SBEND,2), UBOUND(OutData%SBEND,2) + DO i1 = LBOUND(OutData%SBEND,1), UBOUND(OutData%SBEND,1) + OutData%SBEND(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%STEN,1) i1_u = UBOUND(OutData%STEN,1) i2_l = LBOUND(OutData%STEN,2) i2_u = UBOUND(OutData%STEN,2) i3_l = LBOUND(OutData%STEN,3) i3_u = UBOUND(OutData%STEN,3) - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - OutData%STEN = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%STEN))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%STEN) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%STEN,3), UBOUND(OutData%STEN,3) + DO i2 = LBOUND(OutData%STEN,2), UBOUND(OutData%STEN,2) + DO i1 = LBOUND(OutData%STEN,1), UBOUND(OutData%STEN,1) + OutData%STEN(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO i1_l = LBOUND(OutData%RMASS,1) i1_u = UBOUND(OutData%RMASS,1) i2_l = LBOUND(OutData%RMASS,2) i2_u = UBOUND(OutData%RMASS,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%RMASS = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RMASS))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RMASS) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%RMASS,2), UBOUND(OutData%RMASS,2) + DO i1 = LBOUND(OutData%RMASS,1), UBOUND(OutData%RMASS,1) + OutData%RMASS(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%RADDM,1) i1_u = UBOUND(OutData%RADDM,1) i2_l = LBOUND(OutData%RADDM,2) @@ -6193,97 +6115,76 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs i3_u = UBOUND(OutData%RADDM,3) i4_l = LBOUND(OutData%RADDM,4) i4_u = UBOUND(OutData%RADDM,4) - ALLOCATE(mask4(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - OutData%RADDM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RADDM))-1 ), mask4, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RADDM) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%RADDM,4), UBOUND(OutData%RADDM,4) + DO i3 = LBOUND(OutData%RADDM,3), UBOUND(OutData%RADDM,3) + DO i2 = LBOUND(OutData%RADDM,2), UBOUND(OutData%RADDM,2) + DO i1 = LBOUND(OutData%RADDM,1), UBOUND(OutData%RADDM,1) + OutData%RADDM(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO i1_l = LBOUND(OutData%PMPN,1) i1_u = UBOUND(OutData%PMPN,1) i2_l = LBOUND(OutData%PMPN,2) i2_u = UBOUND(OutData%PMPN,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%PMPN = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PMPN))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PMPN) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PMPN,2), UBOUND(OutData%PMPN,2) + DO i1 = LBOUND(OutData%PMPN,1), UBOUND(OutData%PMPN,1) + OutData%PMPN(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%AM,1) i1_u = UBOUND(OutData%AM,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%AM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AM))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AM) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AM,1), UBOUND(OutData%AM,1) + OutData%AM(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%PM,1) i1_u = UBOUND(OutData%PM,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%PM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PM))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PM) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%PM,1), UBOUND(OutData%PM,1) + OutData%PM(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%IDOF,1) i1_u = UBOUND(OutData%IDOF,1) i2_l = LBOUND(OutData%IDOF,2) i2_u = UBOUND(OutData%IDOF,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%IDOF = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%IDOF))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%IDOF) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%IDOF,2), UBOUND(OutData%IDOF,2) + DO i1 = LBOUND(OutData%IDOF,1), UBOUND(OutData%IDOF,1) + OutData%IDOF(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%JDOF,1) i1_u = UBOUND(OutData%JDOF,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%JDOF = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%JDOF))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%JDOF) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%JDOF,1), UBOUND(OutData%JDOF,1) + OutData%JDOF(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO i1_l = LBOUND(OutData%PPA,1) i1_u = UBOUND(OutData%PPA,1) i2_l = LBOUND(OutData%PPA,2) i2_u = UBOUND(OutData%PPA,2) i3_l = LBOUND(OutData%PPA,3) i3_u = UBOUND(OutData%PPA,3) - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - OutData%PPA = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PPA))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PPA) - DEALLOCATE(mask3) - OutData%PtfmRefzt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO i3 = LBOUND(OutData%PPA,3), UBOUND(OutData%PPA,3) + DO i2 = LBOUND(OutData%PPA,2), UBOUND(OutData%PPA,2) + DO i1 = LBOUND(OutData%PPA,1), UBOUND(OutData%PPA,1) + OutData%PPA(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + OutData%PtfmRefzt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -6340,10 +6241,10 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%Delim) + OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GLUZR not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -6363,15 +6264,14 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GLUZR.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%GLUZR)>0) OutData%GLUZR = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GLUZR))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GLUZR) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%GLUZR,3), UBOUND(OutData%GLUZR,3) + DO i2 = LBOUND(OutData%GLUZR,2), UBOUND(OutData%GLUZR,2) + DO i1 = LBOUND(OutData%GLUZR,1), UBOUND(OutData%GLUZR,1) + OutData%GLUZR(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 ! GTZER not allocated Int_Xferred = Int_Xferred + 1 @@ -6389,15 +6289,12 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GTZER.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%GTZER)>0) OutData%GTZER = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GTZER))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GTZER) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%GTZER,2), UBOUND(OutData%GTZER,2) + DO i1 = LBOUND(OutData%GTZER,1), UBOUND(OutData%GTZER,1) + OutData%GTZER(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE FEAM_UnPackParam @@ -6604,12 +6501,6 @@ SUBROUTINE FEAM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_UnPackInput' @@ -6868,8 +6759,10 @@ SUBROUTINE FEAM_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WriteOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF CALL MeshPack( InData%PtFairleadLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! PtFairleadLoad CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6942,12 +6835,6 @@ SUBROUTINE FEAM_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -6975,15 +6862,10 @@ SUBROUTINE FEAM_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WriteOutput)>0) OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -7142,8 +7024,8 @@ SUBROUTINE FEAM_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -7158,6 +7040,8 @@ SUBROUTINE FEAM_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(u1%HydroForceLineMesh, u2%HydroForceLineMesh, tin, u_out%HydroForceLineMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL MeshExtrapInterp1(u1%PtFairleadDisplacement, u2%PtFairleadDisplacement, tin, u_out%PtFairleadDisplacement, tin_out, ErrStat2, ErrMsg2 ) @@ -7191,8 +7075,9 @@ SUBROUTINE FEAM_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_Input_ExtrapInterp2' @@ -7214,6 +7099,8 @@ SUBROUTINE FEAM_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(u1%HydroForceLineMesh, u2%HydroForceLineMesh, u3%HydroForceLineMesh, tin, u_out%HydroForceLineMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL MeshExtrapInterp2(u1%PtFairleadDisplacement, u2%PtFairleadDisplacement, u3%PtFairleadDisplacement, tin, u_out%PtFairleadDisplacement, tin_out, ErrStat2, ErrMsg2 ) @@ -7295,12 +7182,12 @@ SUBROUTINE FEAM_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! 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 :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -7313,13 +7200,13 @@ SUBROUTINE FEAM_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END IF ! check if allocated CALL MeshExtrapInterp1(y1%PtFairleadLoad, y2%PtFairleadLoad, tin, y_out%PtFairleadLoad, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) @@ -7354,13 +7241,14 @@ SUBROUTINE FEAM_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -7379,14 +7267,14 @@ SUBROUTINE FEAM_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END IF ! check if allocated CALL MeshExtrapInterp2(y1%PtFairleadLoad, y2%PtFairleadLoad, y3%PtFairleadLoad, tin, y_out%PtFairleadLoad, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) diff --git a/modules/hydrodyn/src/Conv_Radiation_Types.f90 b/modules/hydrodyn/src/Conv_Radiation_Types.f90 index e5dd8d3382..cbbf1b3868 100644 --- a/modules/hydrodyn/src/Conv_Radiation_Types.f90 +++ b/modules/hydrodyn/src/Conv_Radiation_Types.f90 @@ -268,18 +268,18 @@ SUBROUTINE Conv_Rdtn_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%RdtnDT - Db_Xferred = Db_Xferred + 1 - DO I = 1, LEN(InData%RdtnDTChr) - IntKiBuf(Int_Xferred) = ICHAR(InData%RdtnDTChr(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HighFreq - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%WAMITFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%WAMITFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DbKiBuf(Db_Xferred) = InData%RdtnDT + Db_Xferred = Db_Xferred + 1 + DO I = 1, LEN(InData%RdtnDTChr) + IntKiBuf(Int_Xferred) = ICHAR(InData%RdtnDTChr(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + ReKiBuf(Re_Xferred) = InData%HighFreq + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(InData%WAMITFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%WAMITFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( .NOT. ALLOCATED(InData%HdroAddMs) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -293,8 +293,12 @@ SUBROUTINE Conv_Rdtn_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HdroAddMs,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%HdroAddMs)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%HdroAddMs))-1 ) = PACK(InData%HdroAddMs,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%HdroAddMs) + DO i2 = LBOUND(InData%HdroAddMs,2), UBOUND(InData%HdroAddMs,2) + DO i1 = LBOUND(InData%HdroAddMs,1), UBOUND(InData%HdroAddMs,1) + ReKiBuf(Re_Xferred) = InData%HdroAddMs(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%HdroFreq) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -306,8 +310,10 @@ SUBROUTINE Conv_Rdtn_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HdroFreq,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%HdroFreq)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%HdroFreq))-1 ) = PACK(InData%HdroFreq,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%HdroFreq) + DO i1 = LBOUND(InData%HdroFreq,1), UBOUND(InData%HdroFreq,1) + ReKiBuf(Re_Xferred) = InData%HdroFreq(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%HdroDmpng) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -322,15 +328,19 @@ SUBROUTINE Conv_Rdtn_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HdroDmpng,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%HdroDmpng)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%HdroDmpng))-1 ) = PACK(InData%HdroDmpng,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%HdroDmpng) + DO i2 = LBOUND(InData%HdroDmpng,2), UBOUND(InData%HdroDmpng,2) + DO i1 = LBOUND(InData%HdroDmpng,1), UBOUND(InData%HdroDmpng,1) + ReKiBuf(Re_Xferred) = InData%HdroDmpng(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NInpFreq - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%RdtnTMax - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UnSum - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NInpFreq + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%RdtnTMax + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%UnSum + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Conv_Rdtn_PackInitInput SUBROUTINE Conv_Rdtn_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -346,12 +356,6 @@ SUBROUTINE Conv_Rdtn_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -368,18 +372,18 @@ SUBROUTINE Conv_Rdtn_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%RdtnDT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - DO I = 1, LEN(OutData%RdtnDTChr) - OutData%RdtnDTChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%HighFreq = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%WAMITFile) - OutData%WAMITFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + OutData%RdtnDT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + DO I = 1, LEN(OutData%RdtnDTChr) + OutData%RdtnDTChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%HighFreq = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(OutData%WAMITFile) + OutData%WAMITFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! HdroAddMs not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -396,15 +400,12 @@ SUBROUTINE Conv_Rdtn_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%HdroAddMs.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%HdroAddMs)>0) OutData%HdroAddMs = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%HdroAddMs))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%HdroAddMs) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%HdroAddMs,2), UBOUND(OutData%HdroAddMs,2) + DO i1 = LBOUND(OutData%HdroAddMs,1), UBOUND(OutData%HdroAddMs,1) + OutData%HdroAddMs(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! HdroFreq not allocated Int_Xferred = Int_Xferred + 1 @@ -419,15 +420,10 @@ SUBROUTINE Conv_Rdtn_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%HdroFreq.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%HdroFreq)>0) OutData%HdroFreq = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%HdroFreq))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%HdroFreq) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%HdroFreq,1), UBOUND(OutData%HdroFreq,1) + OutData%HdroFreq(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! HdroDmpng not allocated Int_Xferred = Int_Xferred + 1 @@ -445,22 +441,19 @@ SUBROUTINE Conv_Rdtn_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%HdroDmpng.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%HdroDmpng)>0) OutData%HdroDmpng = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%HdroDmpng))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%HdroDmpng) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%HdroDmpng,2), UBOUND(OutData%HdroDmpng,2) + DO i1 = LBOUND(OutData%HdroDmpng,1), UBOUND(OutData%HdroDmpng,1) + OutData%HdroDmpng(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%NInpFreq = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%RdtnTMax = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%UnSum = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NInpFreq = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%RdtnTMax = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%UnSum = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Conv_Rdtn_UnPackInitInput SUBROUTINE Conv_Rdtn_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -554,8 +547,8 @@ SUBROUTINE Conv_Rdtn_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DummyInitOut - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DummyInitOut + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Conv_Rdtn_PackInitOutput SUBROUTINE Conv_Rdtn_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -571,12 +564,6 @@ SUBROUTINE Conv_Rdtn_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_UnPackInitOutput' @@ -590,8 +577,8 @@ SUBROUTINE Conv_Rdtn_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyInitOut = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%DummyInitOut = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Conv_Rdtn_UnPackInitOutput SUBROUTINE Conv_Rdtn_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) @@ -685,8 +672,8 @@ SUBROUTINE Conv_Rdtn_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyContState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyContState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Conv_Rdtn_PackContState SUBROUTINE Conv_Rdtn_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -702,12 +689,6 @@ SUBROUTINE Conv_Rdtn_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_UnPackContState' @@ -721,8 +702,8 @@ SUBROUTINE Conv_Rdtn_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyContState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyContState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Conv_Rdtn_UnPackContState SUBROUTINE Conv_Rdtn_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) @@ -853,11 +834,15 @@ SUBROUTINE Conv_Rdtn_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%XDHistory,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%XDHistory)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%XDHistory))-1 ) = PACK(InData%XDHistory,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%XDHistory) + DO i2 = LBOUND(InData%XDHistory,2), UBOUND(InData%XDHistory,2) + DO i1 = LBOUND(InData%XDHistory,1), UBOUND(InData%XDHistory,1) + ReKiBuf(Re_Xferred) = InData%XDHistory(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%LastTime - Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%LastTime + Db_Xferred = Db_Xferred + 1 END SUBROUTINE Conv_Rdtn_PackDiscState SUBROUTINE Conv_Rdtn_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -873,12 +858,6 @@ SUBROUTINE Conv_Rdtn_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -910,18 +889,15 @@ SUBROUTINE Conv_Rdtn_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%XDHistory.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%XDHistory)>0) OutData%XDHistory = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%XDHistory))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%XDHistory) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%XDHistory,2), UBOUND(OutData%XDHistory,2) + DO i1 = LBOUND(OutData%XDHistory,1), UBOUND(OutData%XDHistory,1) + OutData%XDHistory(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%LastTime = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%LastTime = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 END SUBROUTINE Conv_Rdtn_UnPackDiscState SUBROUTINE Conv_Rdtn_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -1015,8 +991,8 @@ SUBROUTINE Conv_Rdtn_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyConstrState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Conv_Rdtn_PackConstrState SUBROUTINE Conv_Rdtn_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1032,12 +1008,6 @@ SUBROUTINE Conv_Rdtn_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_UnPackConstrState' @@ -1051,8 +1021,8 @@ SUBROUTINE Conv_Rdtn_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyConstrState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyConstrState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Conv_Rdtn_UnPackConstrState SUBROUTINE Conv_Rdtn_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -1146,8 +1116,8 @@ SUBROUTINE Conv_Rdtn_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%IndRdtn - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%IndRdtn + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Conv_Rdtn_PackOtherState SUBROUTINE Conv_Rdtn_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1163,12 +1133,6 @@ SUBROUTINE Conv_Rdtn_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_UnPackOtherState' @@ -1182,8 +1146,8 @@ SUBROUTINE Conv_Rdtn_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%IndRdtn = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%IndRdtn = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Conv_Rdtn_UnPackOtherState SUBROUTINE Conv_Rdtn_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -1277,8 +1241,8 @@ SUBROUTINE Conv_Rdtn_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%LastIndRdtn - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%LastIndRdtn + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Conv_Rdtn_PackMisc SUBROUTINE Conv_Rdtn_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1294,12 +1258,6 @@ SUBROUTINE Conv_Rdtn_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_UnPackMisc' @@ -1313,8 +1271,8 @@ SUBROUTINE Conv_Rdtn_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%LastIndRdtn = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%LastIndRdtn = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Conv_Rdtn_UnPackMisc SUBROUTINE Conv_Rdtn_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -1441,10 +1399,10 @@ SUBROUTINE Conv_Rdtn_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%RdtnDT - Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%RdtnDT + Db_Xferred = Db_Xferred + 1 IF ( .NOT. ALLOCATED(InData%RdtnKrnl) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1461,13 +1419,19 @@ SUBROUTINE Conv_Rdtn_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RdtnKrnl,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RdtnKrnl)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RdtnKrnl))-1 ) = PACK(InData%RdtnKrnl,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RdtnKrnl) + DO i3 = LBOUND(InData%RdtnKrnl,3), UBOUND(InData%RdtnKrnl,3) + DO i2 = LBOUND(InData%RdtnKrnl,2), UBOUND(InData%RdtnKrnl,2) + DO i1 = LBOUND(InData%RdtnKrnl,1), UBOUND(InData%RdtnKrnl,1) + ReKiBuf(Re_Xferred) = InData%RdtnKrnl(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepRdtn - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepRdtn1 - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepRdtn + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepRdtn1 + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Conv_Rdtn_PackParam SUBROUTINE Conv_Rdtn_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1483,12 +1447,6 @@ SUBROUTINE Conv_Rdtn_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -1505,10 +1463,10 @@ SUBROUTINE Conv_Rdtn_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%RdtnDT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%RdtnDT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RdtnKrnl not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1528,20 +1486,19 @@ SUBROUTINE Conv_Rdtn_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RdtnKrnl.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%RdtnKrnl)>0) OutData%RdtnKrnl = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RdtnKrnl))-1 ), mask3, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%RdtnKrnl) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%RdtnKrnl,3), UBOUND(OutData%RdtnKrnl,3) + DO i2 = LBOUND(OutData%RdtnKrnl,2), UBOUND(OutData%RdtnKrnl,2) + DO i1 = LBOUND(OutData%RdtnKrnl,1), UBOUND(OutData%RdtnKrnl,1) + OutData%RdtnKrnl(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - OutData%NStepRdtn = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NStepRdtn1 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NStepRdtn = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NStepRdtn1 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Conv_Rdtn_UnPackParam SUBROUTINE Conv_Rdtn_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -1636,8 +1593,10 @@ SUBROUTINE Conv_Rdtn_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Velocity))-1 ) = PACK(InData%Velocity,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Velocity) + DO i1 = LBOUND(InData%Velocity,1), UBOUND(InData%Velocity,1) + ReKiBuf(Re_Xferred) = InData%Velocity(i1) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE Conv_Rdtn_PackInput SUBROUTINE Conv_Rdtn_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1653,12 +1612,6 @@ SUBROUTINE Conv_Rdtn_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1675,15 +1628,10 @@ SUBROUTINE Conv_Rdtn_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Xferred = 1 i1_l = LBOUND(OutData%Velocity,1) i1_u = UBOUND(OutData%Velocity,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%Velocity = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Velocity))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Velocity) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Velocity,1), UBOUND(OutData%Velocity,1) + OutData%Velocity(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE Conv_Rdtn_UnPackInput SUBROUTINE Conv_Rdtn_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -1778,8 +1726,10 @@ SUBROUTINE Conv_Rdtn_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_Rdtn))-1 ) = PACK(InData%F_Rdtn,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_Rdtn) + DO i1 = LBOUND(InData%F_Rdtn,1), UBOUND(InData%F_Rdtn,1) + ReKiBuf(Re_Xferred) = InData%F_Rdtn(i1) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE Conv_Rdtn_PackOutput SUBROUTINE Conv_Rdtn_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1795,12 +1745,6 @@ SUBROUTINE Conv_Rdtn_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1817,15 +1761,10 @@ SUBROUTINE Conv_Rdtn_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Xferred = 1 i1_l = LBOUND(OutData%F_Rdtn,1) i1_u = UBOUND(OutData%F_Rdtn,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%F_Rdtn = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_Rdtn))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_Rdtn) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%F_Rdtn,1), UBOUND(OutData%F_Rdtn,1) + OutData%F_Rdtn(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE Conv_Rdtn_UnPackOutput @@ -1903,12 +1842,12 @@ SUBROUTINE Conv_Rdtn_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, E REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! 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 :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -1921,12 +1860,12 @@ SUBROUTINE Conv_Rdtn_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, E CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(b1(SIZE(u_out%Velocity,1))) - ALLOCATE(c1(SIZE(u_out%Velocity,1))) - b1 = -(u1%Velocity - u2%Velocity)/t(2) - u_out%Velocity = u1%Velocity + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + + ScaleFactor = t_out / t(2) + DO i1 = LBOUND(u_out%Velocity,1),UBOUND(u_out%Velocity,1) + b = -(u1%Velocity(i1) - u2%Velocity(i1)) + u_out%Velocity(i1) = u1%Velocity(i1) + b * ScaleFactor + END DO END SUBROUTINE Conv_Rdtn_Input_ExtrapInterp1 @@ -1956,13 +1895,14 @@ SUBROUTINE Conv_Rdtn_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrSta REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -1981,13 +1921,13 @@ SUBROUTINE Conv_Rdtn_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrSta CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(b1(SIZE(u_out%Velocity,1))) - ALLOCATE(c1(SIZE(u_out%Velocity,1))) - b1 = (t(3)**2*(u1%Velocity - u2%Velocity) + t(2)**2*(-u1%Velocity + u3%Velocity))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%Velocity + t(3)*u2%Velocity - t(2)*u3%Velocity ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Velocity = u1%Velocity + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) + DO i1 = LBOUND(u_out%Velocity,1),UBOUND(u_out%Velocity,1) + b = (t(3)**2*(u1%Velocity(i1) - u2%Velocity(i1)) + t(2)**2*(-u1%Velocity(i1) + u3%Velocity(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%Velocity(i1) + t(3)*u2%Velocity(i1) - t(2)*u3%Velocity(i1) ) * scaleFactor + u_out%Velocity(i1) = u1%Velocity(i1) + b + c * t_out + END DO END SUBROUTINE Conv_Rdtn_Input_ExtrapInterp2 @@ -2065,12 +2005,12 @@ SUBROUTINE Conv_Rdtn_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! 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 :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -2083,12 +2023,12 @@ SUBROUTINE Conv_Rdtn_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(b1(SIZE(y_out%F_Rdtn,1))) - ALLOCATE(c1(SIZE(y_out%F_Rdtn,1))) - b1 = -(y1%F_Rdtn - y2%F_Rdtn)/t(2) - y_out%F_Rdtn = y1%F_Rdtn + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + + ScaleFactor = t_out / t(2) + DO i1 = LBOUND(y_out%F_Rdtn,1),UBOUND(y_out%F_Rdtn,1) + b = -(y1%F_Rdtn(i1) - y2%F_Rdtn(i1)) + y_out%F_Rdtn(i1) = y1%F_Rdtn(i1) + b * ScaleFactor + END DO END SUBROUTINE Conv_Rdtn_Output_ExtrapInterp1 @@ -2118,13 +2058,14 @@ SUBROUTINE Conv_Rdtn_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrSt REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -2143,13 +2084,13 @@ SUBROUTINE Conv_Rdtn_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrSt CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(b1(SIZE(y_out%F_Rdtn,1))) - ALLOCATE(c1(SIZE(y_out%F_Rdtn,1))) - b1 = (t(3)**2*(y1%F_Rdtn - y2%F_Rdtn) + t(2)**2*(-y1%F_Rdtn + y3%F_Rdtn))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%F_Rdtn + t(3)*y2%F_Rdtn - t(2)*y3%F_Rdtn ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%F_Rdtn = y1%F_Rdtn + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) + DO i1 = LBOUND(y_out%F_Rdtn,1),UBOUND(y_out%F_Rdtn,1) + b = (t(3)**2*(y1%F_Rdtn(i1) - y2%F_Rdtn(i1)) + t(2)**2*(-y1%F_Rdtn(i1) + y3%F_Rdtn(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%F_Rdtn(i1) + t(3)*y2%F_Rdtn(i1) - t(2)*y3%F_Rdtn(i1) ) * scaleFactor + y_out%F_Rdtn(i1) = y1%F_Rdtn(i1) + b + c * t_out + END DO END SUBROUTINE Conv_Rdtn_Output_ExtrapInterp2 END MODULE Conv_Radiation_Types diff --git a/modules/hydrodyn/src/Current_Types.f90 b/modules/hydrodyn/src/Current_Types.f90 index a6e1405853..f262434bca 100644 --- a/modules/hydrodyn/src/Current_Types.f90 +++ b/modules/hydrodyn/src/Current_Types.f90 @@ -233,28 +233,28 @@ SUBROUTINE Current_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CurrSSV0 - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%CurrSSDirChr) - IntKiBuf(Int_Xferred) = ICHAR(InData%CurrSSDirChr(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CurrSSDir - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CurrNSRef - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CurrNSV0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CurrNSDir - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CurrDIV - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CurrDIDir - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%CurrMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CurrSSV0 + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(InData%CurrSSDirChr) + IntKiBuf(Int_Xferred) = ICHAR(InData%CurrSSDirChr(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + ReKiBuf(Re_Xferred) = InData%CurrSSDir + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CurrNSRef + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CurrNSV0 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CurrNSDir + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CurrDIV + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CurrDIDir + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%CurrMod + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDpth + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%MorisonNodezi) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -265,15 +265,17 @@ SUBROUTINE Current_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MorisonNodezi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%MorisonNodezi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MorisonNodezi))-1 ) = PACK(InData%MorisonNodezi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MorisonNodezi) + DO i1 = LBOUND(InData%MorisonNodezi,1), UBOUND(InData%MorisonNodezi,1) + ReKiBuf(Re_Xferred) = InData%MorisonNodezi(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NMorisonNodes - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%DirRoot) - IntKiBuf(Int_Xferred) = ICHAR(InData%DirRoot(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + IntKiBuf(Int_Xferred) = InData%NMorisonNodes + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%DirRoot) + IntKiBuf(Int_Xferred) = ICHAR(InData%DirRoot(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE Current_PackInitInput SUBROUTINE Current_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -289,12 +291,6 @@ SUBROUTINE Current_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -309,28 +305,28 @@ SUBROUTINE Current_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%CurrSSV0 = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%CurrSSDirChr) - OutData%CurrSSDirChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%CurrSSDir = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%CurrNSRef = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%CurrNSV0 = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%CurrNSDir = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%CurrDIV = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%CurrDIDir = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%CurrMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%WtrDpth = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%CurrSSV0 = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(OutData%CurrSSDirChr) + OutData%CurrSSDirChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%CurrSSDir = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%CurrNSRef = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%CurrNSV0 = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%CurrNSDir = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%CurrDIV = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%CurrDIDir = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%CurrMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WtrDpth = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MorisonNodezi not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -344,22 +340,17 @@ SUBROUTINE Current_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MorisonNodezi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%MorisonNodezi)>0) OutData%MorisonNodezi = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MorisonNodezi))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%MorisonNodezi) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%MorisonNodezi,1), UBOUND(OutData%MorisonNodezi,1) + OutData%MorisonNodezi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%NMorisonNodes = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%DirRoot) - OutData%DirRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + OutData%NMorisonNodes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%DirRoot) + OutData%DirRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE Current_UnPackInitInput SUBROUTINE Current_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -506,8 +497,10 @@ SUBROUTINE Current_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CurrVxi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CurrVxi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CurrVxi))-1 ) = PACK(InData%CurrVxi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CurrVxi) + DO i1 = LBOUND(InData%CurrVxi,1), UBOUND(InData%CurrVxi,1) + ReKiBuf(Re_Xferred) = InData%CurrVxi(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%CurrVyi) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -519,13 +512,15 @@ SUBROUTINE Current_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CurrVyi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CurrVyi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CurrVyi))-1 ) = PACK(InData%CurrVyi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CurrVyi) + DO i1 = LBOUND(InData%CurrVyi,1), UBOUND(InData%CurrVyi,1) + ReKiBuf(Re_Xferred) = InData%CurrVyi(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PCurrVxiPz0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PCurrVyiPz0 - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PCurrVxiPz0 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PCurrVyiPz0 + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Current_PackInitOutput SUBROUTINE Current_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -541,12 +536,6 @@ SUBROUTINE Current_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -574,15 +563,10 @@ SUBROUTINE Current_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CurrVxi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%CurrVxi)>0) OutData%CurrVxi = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CurrVxi))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%CurrVxi) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%CurrVxi,1), UBOUND(OutData%CurrVxi,1) + OutData%CurrVxi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CurrVyi not allocated Int_Xferred = Int_Xferred + 1 @@ -597,20 +581,15 @@ SUBROUTINE Current_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CurrVyi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%CurrVyi)>0) OutData%CurrVyi = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CurrVyi))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%CurrVyi) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%CurrVyi,1), UBOUND(OutData%CurrVyi,1) + OutData%CurrVyi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%PCurrVxiPz0 = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%PCurrVyiPz0 = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%PCurrVxiPz0 = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%PCurrVyiPz0 = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Current_UnPackInitOutput SUBROUTINE Current_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) @@ -704,8 +683,8 @@ SUBROUTINE Current_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyContState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyContState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Current_PackContState SUBROUTINE Current_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -721,12 +700,6 @@ SUBROUTINE Current_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Current_UnPackContState' @@ -740,8 +713,8 @@ SUBROUTINE Current_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyContState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyContState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Current_UnPackContState SUBROUTINE Current_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) @@ -835,8 +808,8 @@ SUBROUTINE Current_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyDiscState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Current_PackDiscState SUBROUTINE Current_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -852,12 +825,6 @@ SUBROUTINE Current_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Current_UnPackDiscState' @@ -871,8 +838,8 @@ SUBROUTINE Current_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyDiscState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyDiscState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Current_UnPackDiscState SUBROUTINE Current_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -966,8 +933,8 @@ SUBROUTINE Current_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyConstrState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Current_PackConstrState SUBROUTINE Current_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -983,12 +950,6 @@ SUBROUTINE Current_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Current_UnPackConstrState' @@ -1002,8 +963,8 @@ SUBROUTINE Current_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyConstrState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyConstrState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Current_UnPackConstrState SUBROUTINE Current_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -1097,8 +1058,8 @@ SUBROUTINE Current_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DummyOtherState - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DummyOtherState + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Current_PackOtherState SUBROUTINE Current_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1114,12 +1075,6 @@ SUBROUTINE Current_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Current_UnPackOtherState' @@ -1133,8 +1088,8 @@ SUBROUTINE Current_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyOtherState = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%DummyOtherState = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Current_UnPackOtherState SUBROUTINE Current_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -1228,8 +1183,8 @@ SUBROUTINE Current_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyMiscVar - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyMiscVar + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Current_PackMisc SUBROUTINE Current_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1245,12 +1200,6 @@ SUBROUTINE Current_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Current_UnPackMisc' @@ -1264,8 +1213,8 @@ SUBROUTINE Current_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyMiscVar = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyMiscVar = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Current_UnPackMisc SUBROUTINE Current_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -1359,8 +1308,8 @@ SUBROUTINE Current_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 END SUBROUTINE Current_PackParam SUBROUTINE Current_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1376,12 +1325,6 @@ SUBROUTINE Current_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Current_UnPackParam' @@ -1395,8 +1338,8 @@ SUBROUTINE Current_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 END SUBROUTINE Current_UnPackParam SUBROUTINE Current_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -1490,8 +1433,8 @@ SUBROUTINE Current_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyInput - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyInput + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Current_PackInput SUBROUTINE Current_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1507,12 +1450,6 @@ SUBROUTINE Current_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Current_UnPackInput' @@ -1526,8 +1463,8 @@ SUBROUTINE Current_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyInput = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyInput = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Current_UnPackInput SUBROUTINE Current_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -1621,8 +1558,8 @@ SUBROUTINE Current_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyOutput - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyOutput + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Current_PackOutput SUBROUTINE Current_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1638,12 +1575,6 @@ SUBROUTINE Current_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Current_UnPackOutput' @@ -1657,8 +1588,8 @@ SUBROUTINE Current_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyOutput = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyOutput = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Current_UnPackOutput @@ -1736,8 +1667,8 @@ SUBROUTINE Current_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, Err REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'Current_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -1752,8 +1683,10 @@ SUBROUTINE Current_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = -(u1%DummyInput - u2%DummyInput)/t(2) - u_out%DummyInput = u1%DummyInput + b0 * t_out + + ScaleFactor = t_out / t(2) + b = -(u1%DummyInput - u2%DummyInput) + u_out%DummyInput = u1%DummyInput + b * ScaleFactor END SUBROUTINE Current_Input_ExtrapInterp1 @@ -1783,8 +1716,9 @@ SUBROUTINE Current_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'Current_Input_ExtrapInterp2' @@ -1806,9 +1740,11 @@ SUBROUTINE Current_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = (t(3)**2*(u1%DummyInput - u2%DummyInput) + t(2)**2*(-u1%DummyInput + u3%DummyInput))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%DummyInput + t(3)*u2%DummyInput - t(2)*u3%DummyInput ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%DummyInput = u1%DummyInput + b0 * t_out + c0 * t_out**2 + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) + b = (t(3)**2*(u1%DummyInput - u2%DummyInput) + t(2)**2*(-u1%DummyInput + u3%DummyInput))* scaleFactor + c = ( (t(2)-t(3))*u1%DummyInput + t(3)*u2%DummyInput - t(2)*u3%DummyInput ) * scaleFactor + u_out%DummyInput = u1%DummyInput + b + c * t_out END SUBROUTINE Current_Input_ExtrapInterp2 @@ -1886,8 +1822,8 @@ SUBROUTINE Current_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Er REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'Current_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -1902,8 +1838,10 @@ SUBROUTINE Current_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = -(y1%DummyOutput - y2%DummyOutput)/t(2) - y_out%DummyOutput = y1%DummyOutput + b0 * t_out + + ScaleFactor = t_out / t(2) + b = -(y1%DummyOutput - y2%DummyOutput) + y_out%DummyOutput = y1%DummyOutput + b * ScaleFactor END SUBROUTINE Current_Output_ExtrapInterp1 @@ -1933,8 +1871,9 @@ SUBROUTINE Current_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'Current_Output_ExtrapInterp2' @@ -1956,9 +1895,11 @@ SUBROUTINE Current_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = (t(3)**2*(y1%DummyOutput - y2%DummyOutput) + t(2)**2*(-y1%DummyOutput + y3%DummyOutput))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%DummyOutput + t(3)*y2%DummyOutput - t(2)*y3%DummyOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%DummyOutput = y1%DummyOutput + b0 * t_out + c0 * t_out**2 + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) + b = (t(3)**2*(y1%DummyOutput - y2%DummyOutput) + t(2)**2*(-y1%DummyOutput + y3%DummyOutput))* scaleFactor + c = ( (t(2)-t(3))*y1%DummyOutput + t(3)*y2%DummyOutput - t(2)*y3%DummyOutput ) * scaleFactor + y_out%DummyOutput = y1%DummyOutput + b + c * t_out END SUBROUTINE Current_Output_ExtrapInterp2 END MODULE Current_Types diff --git a/modules/hydrodyn/src/HydroDyn_Types.f90 b/modules/hydrodyn/src/HydroDyn_Types.f90 index a9c61fda9f..4a472c4dbb 100644 --- a/modules/hydrodyn/src/HydroDyn_Types.f90 +++ b/modules/hydrodyn/src/HydroDyn_Types.f90 @@ -562,26 +562,26 @@ SUBROUTINE HydroDyn_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%UseInputFile , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutRootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutRootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Linearize , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TMax - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%HasIce , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%InputFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%UseInputFile, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%OutRootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutRootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%Linearize, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Gravity + Re_Xferred = Re_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%TMax + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%HasIce, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveElevXY) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -595,57 +595,75 @@ SUBROUTINE HydroDyn_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevXY,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElevXY)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElevXY))-1 ) = PACK(InData%WaveElevXY,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElevXY) + DO i2 = LBOUND(InData%WaveElevXY,2), UBOUND(InData%WaveElevXY,2) + DO i1 = LBOUND(InData%WaveElevXY,1), UBOUND(InData%WaveElevXY,1) + ReKiBuf(Re_Xferred) = InData%WaveElevXY(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmLocationX - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmLocationY - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%PtfmSgFChr) - IntKiBuf(Int_Xferred) = ICHAR(InData%PtfmSgFChr(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmSgF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%PtfmSwFChr) - IntKiBuf(Int_Xferred) = ICHAR(InData%PtfmSwFChr(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmSwF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%PtfmHvFChr) - IntKiBuf(Int_Xferred) = ICHAR(InData%PtfmHvFChr(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmHvF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%PtfmRFChr) - IntKiBuf(Int_Xferred) = ICHAR(InData%PtfmRFChr(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmRF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%PtfmPFChr) - IntKiBuf(Int_Xferred) = ICHAR(InData%PtfmPFChr(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmPF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%PtfmYFChr) - IntKiBuf(Int_Xferred) = ICHAR(InData%PtfmYFChr(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmYF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AddF0))-1 ) = PACK(InData%AddF0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AddF0) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AddCLin))-1 ) = PACK(InData%AddCLin,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AddCLin) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AddBLin))-1 ) = PACK(InData%AddBLin,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AddBLin) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AddBQuad))-1 ) = PACK(InData%AddBQuad,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AddBQuad) + ReKiBuf(Re_Xferred) = InData%PtfmLocationX + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmLocationY + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(InData%PtfmSgFChr) + IntKiBuf(Int_Xferred) = ICHAR(InData%PtfmSgFChr(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmSgF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%PtfmSwFChr) + IntKiBuf(Int_Xferred) = ICHAR(InData%PtfmSwFChr(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmSwF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%PtfmHvFChr) + IntKiBuf(Int_Xferred) = ICHAR(InData%PtfmHvFChr(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmHvF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%PtfmRFChr) + IntKiBuf(Int_Xferred) = ICHAR(InData%PtfmRFChr(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmRF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%PtfmPFChr) + IntKiBuf(Int_Xferred) = ICHAR(InData%PtfmPFChr(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmPF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%PtfmYFChr) + IntKiBuf(Int_Xferred) = ICHAR(InData%PtfmYFChr(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmYF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%AddF0,1), UBOUND(InData%AddF0,1) + ReKiBuf(Re_Xferred) = InData%AddF0(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i2 = LBOUND(InData%AddCLin,2), UBOUND(InData%AddCLin,2) + DO i1 = LBOUND(InData%AddCLin,1), UBOUND(InData%AddCLin,1) + ReKiBuf(Re_Xferred) = InData%AddCLin(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%AddBLin,2), UBOUND(InData%AddBLin,2) + DO i1 = LBOUND(InData%AddBLin,1), UBOUND(InData%AddBLin,1) + ReKiBuf(Re_Xferred) = InData%AddBLin(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%AddBQuad,2), UBOUND(InData%AddBQuad,2) + DO i1 = LBOUND(InData%AddBQuad,1), UBOUND(InData%AddBQuad,1) + ReKiBuf(Re_Xferred) = InData%AddBQuad(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO CALL Waves_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%Waves, ErrStat2, ErrMsg2, OnlySize ) ! Waves CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -730,10 +748,10 @@ SUBROUTINE HydroDyn_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - DO I = 1, LEN(InData%PotFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%PotFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(InData%PotFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%PotFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I CALL WAMIT_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT, ErrStat2, ErrMsg2, OnlySize ) ! WAMIT CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -818,12 +836,12 @@ SUBROUTINE HydroDyn_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Echo , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%PotMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NUserOutputs - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%Echo, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%PotMod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NUserOutputs + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%UserOutputs) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -834,37 +852,37 @@ SUBROUTINE HydroDyn_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UserOutputs,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%UserOutputs,1), UBOUND(InData%UserOutputs,1) + DO i1 = LBOUND(InData%UserOutputs,1), UBOUND(InData%UserOutputs,1) DO I = 1, LEN(InData%UserOutputs) IntKiBuf(Int_Xferred) = ICHAR(InData%UserOutputs(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%OutSwtch - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%OutAll , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%OutSwtch + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%OutAll, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) - DO I = 1, LEN(InData%OutList) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%HDSum , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UnSum - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutSFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(InData%OutList) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + IntKiBuf(Int_Xferred) = TRANSFER(InData%HDSum, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%UnSum + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%OutFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%OutSFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE HydroDyn_PackInitInput SUBROUTINE HydroDyn_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -880,12 +898,6 @@ SUBROUTINE HydroDyn_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -901,26 +913,26 @@ SUBROUTINE HydroDyn_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%UseInputFile = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutRootName) - OutData%OutRootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%Linearize = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%Gravity = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMax = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%HasIce = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%InputFile) + OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%UseInputFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseInputFile) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%OutRootName) + OutData%OutRootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%Linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%Linearize) + Int_Xferred = Int_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%Gravity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMax = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%HasIce = TRANSFER(IntKiBuf(Int_Xferred), OutData%HasIce) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevXY not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -937,106 +949,89 @@ SUBROUTINE HydroDyn_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevXY.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveElevXY)>0) OutData%WaveElevXY = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElevXY))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElevXY) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveElevXY,2), UBOUND(OutData%WaveElevXY,2) + DO i1 = LBOUND(OutData%WaveElevXY,1), UBOUND(OutData%WaveElevXY,1) + OutData%WaveElevXY(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%PtfmLocationX = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmLocationY = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%PtfmSgFChr) - OutData%PtfmSgFChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%PtfmSgF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%PtfmSwFChr) - OutData%PtfmSwFChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%PtfmSwF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%PtfmHvFChr) - OutData%PtfmHvFChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%PtfmHvF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%PtfmRFChr) - OutData%PtfmRFChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%PtfmRF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%PtfmPFChr) - OutData%PtfmPFChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%PtfmPF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%PtfmYFChr) - OutData%PtfmYFChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%PtfmYF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%PtfmLocationX = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmLocationY = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(OutData%PtfmSgFChr) + OutData%PtfmSgFChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%PtfmSgF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmSgF) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%PtfmSwFChr) + OutData%PtfmSwFChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%PtfmSwF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmSwF) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%PtfmHvFChr) + OutData%PtfmHvFChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%PtfmHvF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmHvF) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%PtfmRFChr) + OutData%PtfmRFChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%PtfmRF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmRF) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%PtfmPFChr) + OutData%PtfmPFChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%PtfmPF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmPF) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%PtfmYFChr) + OutData%PtfmYFChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%PtfmYF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmYF) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%AddF0,1) i1_u = UBOUND(OutData%AddF0,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%AddF0 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AddF0))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AddF0) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AddF0,1), UBOUND(OutData%AddF0,1) + OutData%AddF0(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%AddCLin,1) i1_u = UBOUND(OutData%AddCLin,1) i2_l = LBOUND(OutData%AddCLin,2) i2_u = UBOUND(OutData%AddCLin,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%AddCLin = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AddCLin))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AddCLin) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AddCLin,2), UBOUND(OutData%AddCLin,2) + DO i1 = LBOUND(OutData%AddCLin,1), UBOUND(OutData%AddCLin,1) + OutData%AddCLin(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%AddBLin,1) i1_u = UBOUND(OutData%AddBLin,1) i2_l = LBOUND(OutData%AddBLin,2) i2_u = UBOUND(OutData%AddBLin,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%AddBLin = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AddBLin))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AddBLin) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AddBLin,2), UBOUND(OutData%AddBLin,2) + DO i1 = LBOUND(OutData%AddBLin,1), UBOUND(OutData%AddBLin,1) + OutData%AddBLin(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%AddBQuad,1) i1_u = UBOUND(OutData%AddBQuad,1) i2_l = LBOUND(OutData%AddBQuad,2) i2_u = UBOUND(OutData%AddBQuad,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%AddBQuad = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AddBQuad))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AddBQuad) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AddBQuad,2), UBOUND(OutData%AddBQuad,2) + DO i1 = LBOUND(OutData%AddBQuad,1), UBOUND(OutData%AddBQuad,1) + OutData%AddBQuad(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -1157,10 +1152,10 @@ SUBROUTINE HydroDyn_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - DO I = 1, LEN(OutData%PotFile) - OutData%PotFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%PotFile) + OutData%PotFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -1281,12 +1276,12 @@ SUBROUTINE HydroDyn_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%Echo = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%PotMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NUserOutputs = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%Echo = TRANSFER(IntKiBuf(Int_Xferred), OutData%Echo) + Int_Xferred = Int_Xferred + 1 + OutData%PotMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NUserOutputs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UserOutputs not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1300,53 +1295,39 @@ SUBROUTINE HydroDyn_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UserOutputs.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%UserOutputs,1), UBOUND(OutData%UserOutputs,1) + DO i1 = LBOUND(OutData%UserOutputs,1), UBOUND(OutData%UserOutputs,1) DO I = 1, LEN(OutData%UserOutputs) OutData%UserOutputs(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF - OutData%OutSwtch = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%OutAll = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%OutSwtch = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%OutAll = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutAll) + Int_Xferred = Int_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%OutList,1) i1_u = UBOUND(OutData%OutList,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) - DO I = 1, LEN(OutData%OutList) - OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - DEALLOCATE(mask1) - OutData%HDSum = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%UnSum = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutSFmt) - OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%OutList) + OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 END DO ! I + END DO + OutData%HDSum = TRANSFER(IntKiBuf(Int_Xferred), OutData%HDSum) + Int_Xferred = Int_Xferred + 1 + OutData%UnSum = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%OutFmt) + OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%OutSFmt) + OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE HydroDyn_UnPackInitInput SUBROUTINE HydroDyn_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -1836,12 +1817,12 @@ SUBROUTINE HydroDyn_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) + DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) DO I = 1, LEN(InData%WriteOutputHdr) IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdr(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1853,12 +1834,12 @@ SUBROUTINE HydroDyn_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) + DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) DO I = 1, LEN(InData%WriteOutputUnt) IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUnt(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveElevSeries) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1873,8 +1854,12 @@ SUBROUTINE HydroDyn_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevSeries,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElevSeries)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElevSeries))-1 ) = PACK(InData%WaveElevSeries,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElevSeries) + DO i2 = LBOUND(InData%WaveElevSeries,2), UBOUND(InData%WaveElevSeries,2) + DO i1 = LBOUND(InData%WaveElevSeries,1), UBOUND(InData%WaveElevSeries,1) + ReKiBuf(Re_Xferred) = InData%WaveElevSeries(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1904,12 +1889,12 @@ SUBROUTINE HydroDyn_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MSL2SWL - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDens + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDpth + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MSL2SWL + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%LinNames_y) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1920,12 +1905,12 @@ SUBROUTINE HydroDyn_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_y,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%LinNames_y,1), UBOUND(InData%LinNames_y,1) + DO i1 = LBOUND(InData%LinNames_y,1), UBOUND(InData%LinNames_y,1) DO I = 1, LEN(InData%LinNames_y) IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_y(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LinNames_x) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1937,12 +1922,12 @@ SUBROUTINE HydroDyn_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_x,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%LinNames_x,1), UBOUND(InData%LinNames_x,1) + DO i1 = LBOUND(InData%LinNames_x,1), UBOUND(InData%LinNames_x,1) DO I = 1, LEN(InData%LinNames_x) IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_x(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LinNames_u) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1954,12 +1939,12 @@ SUBROUTINE HydroDyn_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_u,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%LinNames_u,1), UBOUND(InData%LinNames_u,1) + DO i1 = LBOUND(InData%LinNames_u,1), UBOUND(InData%LinNames_u,1) DO I = 1, LEN(InData%LinNames_u) IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_u(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%DerivOrder_x) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1971,8 +1956,10 @@ SUBROUTINE HydroDyn_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DerivOrder_x,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DerivOrder_x)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%DerivOrder_x))-1 ) = PACK(InData%DerivOrder_x,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%DerivOrder_x) + DO i1 = LBOUND(InData%DerivOrder_x,1), UBOUND(InData%DerivOrder_x,1) + IntKiBuf(Int_Xferred) = InData%DerivOrder_x(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%IsLoad_u) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1984,8 +1971,10 @@ SUBROUTINE HydroDyn_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IsLoad_u,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%IsLoad_u)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%IsLoad_u)-1 ) = TRANSFER(PACK( InData%IsLoad_u ,.TRUE.), IntKiBuf(1), SIZE(InData%IsLoad_u)) - Int_Xferred = Int_Xferred + SIZE(InData%IsLoad_u) + DO i1 = LBOUND(InData%IsLoad_u,1), UBOUND(InData%IsLoad_u,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%IsLoad_u(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF END SUBROUTINE HydroDyn_PackInitOutput @@ -2002,12 +1991,6 @@ SUBROUTINE HydroDyn_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -2196,19 +2179,12 @@ SUBROUTINE HydroDyn_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) DO I = 1, LEN(OutData%WriteOutputHdr) OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated Int_Xferred = Int_Xferred + 1 @@ -2223,19 +2199,12 @@ SUBROUTINE HydroDyn_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) DO I = 1, LEN(OutData%WriteOutputUnt) OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevSeries not allocated Int_Xferred = Int_Xferred + 1 @@ -2253,15 +2222,12 @@ SUBROUTINE HydroDyn_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevSeries.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveElevSeries)>0) OutData%WaveElevSeries = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElevSeries))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElevSeries) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveElevSeries,2), UBOUND(OutData%WaveElevSeries,2) + DO i1 = LBOUND(OutData%WaveElevSeries,1), UBOUND(OutData%WaveElevSeries,1) + OutData%WaveElevSeries(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -2303,12 +2269,12 @@ SUBROUTINE HydroDyn_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%WtrDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDpth = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MSL2SWL = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%WtrDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WtrDpth = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MSL2SWL = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_y not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2322,19 +2288,12 @@ SUBROUTINE HydroDyn_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%LinNames_y,1), UBOUND(OutData%LinNames_y,1) + DO i1 = LBOUND(OutData%LinNames_y,1), UBOUND(OutData%LinNames_y,1) DO I = 1, LEN(OutData%LinNames_y) OutData%LinNames_y(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_x not allocated Int_Xferred = Int_Xferred + 1 @@ -2349,19 +2308,12 @@ SUBROUTINE HydroDyn_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_x.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%LinNames_x,1), UBOUND(OutData%LinNames_x,1) + DO i1 = LBOUND(OutData%LinNames_x,1), UBOUND(OutData%LinNames_x,1) DO I = 1, LEN(OutData%LinNames_x) OutData%LinNames_x(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_u not allocated Int_Xferred = Int_Xferred + 1 @@ -2376,19 +2328,12 @@ SUBROUTINE HydroDyn_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%LinNames_u,1), UBOUND(OutData%LinNames_u,1) + DO i1 = LBOUND(OutData%LinNames_u,1), UBOUND(OutData%LinNames_u,1) DO I = 1, LEN(OutData%LinNames_u) OutData%LinNames_u(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DerivOrder_x not allocated Int_Xferred = Int_Xferred + 1 @@ -2403,15 +2348,10 @@ SUBROUTINE HydroDyn_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%DerivOrder_x)>0) OutData%DerivOrder_x = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%DerivOrder_x))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%DerivOrder_x) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%DerivOrder_x,1), UBOUND(OutData%DerivOrder_x,1) + OutData%DerivOrder_x(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IsLoad_u not allocated Int_Xferred = Int_Xferred + 1 @@ -2426,15 +2366,10 @@ SUBROUTINE HydroDyn_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%IsLoad_u)>0) OutData%IsLoad_u = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%IsLoad_u))-1 ), OutData%IsLoad_u), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%IsLoad_u) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%IsLoad_u,1), UBOUND(OutData%IsLoad_u,1) + OutData%IsLoad_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsLoad_u(i1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF END SUBROUTINE HydroDyn_UnPackInitOutput @@ -2690,12 +2625,6 @@ SUBROUTINE HydroDyn_UnPackHD_ModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_UnPackHD_ModuleMapType' @@ -3132,12 +3061,6 @@ SUBROUTINE HydroDyn_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_UnPackContState' @@ -3614,12 +3537,6 @@ SUBROUTINE HydroDyn_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_UnPackDiscState' @@ -4096,12 +4013,6 @@ SUBROUTINE HydroDyn_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_UnPackConstrState' @@ -4578,12 +4489,6 @@ SUBROUTINE HydroDyn_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_UnPackOtherState' @@ -5256,18 +5161,24 @@ SUBROUTINE HydroDyn_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Decimate - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%LastOutTime - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%LastIndWave - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_PtfmAdd))-1 ) = PACK(InData%F_PtfmAdd,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_PtfmAdd) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_Hydro))-1 ) = PACK(InData%F_Hydro,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_Hydro) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_Waves))-1 ) = PACK(InData%F_Waves,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_Waves) + IntKiBuf(Int_Xferred) = InData%Decimate + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%LastOutTime + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%LastIndWave + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%F_PtfmAdd,1), UBOUND(InData%F_PtfmAdd,1) + ReKiBuf(Re_Xferred) = InData%F_PtfmAdd(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%F_Hydro,1), UBOUND(InData%F_Hydro,1) + ReKiBuf(Re_Xferred) = InData%F_Hydro(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%F_Waves,1), UBOUND(InData%F_Waves,1) + ReKiBuf(Re_Xferred) = InData%F_Waves(i1) + Re_Xferred = Re_Xferred + 1 + END DO CALL WAMIT_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT, ErrStat2, ErrMsg2, OnlySize ) ! WAMIT CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -5464,8 +5375,8 @@ SUBROUTINE HydroDyn_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%IgnoreMod , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%IgnoreMod, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE HydroDyn_PackMisc SUBROUTINE HydroDyn_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -5481,12 +5392,6 @@ SUBROUTINE HydroDyn_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -5701,45 +5606,30 @@ SUBROUTINE HydroDyn_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%Decimate = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%LastOutTime = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%LastIndWave = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%Decimate = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%LastOutTime = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%LastIndWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%F_PtfmAdd,1) i1_u = UBOUND(OutData%F_PtfmAdd,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%F_PtfmAdd = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_PtfmAdd))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_PtfmAdd) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%F_PtfmAdd,1), UBOUND(OutData%F_PtfmAdd,1) + OutData%F_PtfmAdd(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%F_Hydro,1) i1_u = UBOUND(OutData%F_Hydro,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%F_Hydro = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_Hydro))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_Hydro) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%F_Hydro,1), UBOUND(OutData%F_Hydro,1) + OutData%F_Hydro(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%F_Waves,1) i1_u = UBOUND(OutData%F_Waves,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%F_Waves = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_Waves))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_Waves) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%F_Waves,1), UBOUND(OutData%F_Waves,1) + OutData%F_Waves(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -6020,8 +5910,8 @@ SUBROUTINE HydroDyn_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%IgnoreMod = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%IgnoreMod = TRANSFER(IntKiBuf(Int_Xferred), OutData%IgnoreMod) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE HydroDyn_UnPackMisc SUBROUTINE HydroDyn_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -6519,8 +6409,8 @@ SUBROUTINE HydroDyn_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%PotMod - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%PotMod + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -6531,13 +6421,15 @@ SUBROUTINE HydroDyn_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveTime)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveTime))-1 ) = PACK(InData%WaveTime,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveTime) + DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) + ReKiBuf(Re_Xferred) = InData%WaveTime(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NWaveElev - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepWave + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NWaveElev + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveElev) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -6551,8 +6443,12 @@ SUBROUTINE HydroDyn_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElev)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElev))-1 ) = PACK(InData%WaveElev,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElev) + DO i2 = LBOUND(InData%WaveElev,2), UBOUND(InData%WaveElev,2) + DO i1 = LBOUND(InData%WaveElev,1), UBOUND(InData%WaveElev,1) + ReKiBuf(Re_Xferred) = InData%WaveElev(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveElev1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6567,21 +6463,39 @@ SUBROUTINE HydroDyn_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElev1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElev1))-1 ) = PACK(InData%WaveElev1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElev1) + DO i2 = LBOUND(InData%WaveElev1,2), UBOUND(InData%WaveElev1,2) + DO i1 = LBOUND(InData%WaveElev1,1), UBOUND(InData%WaveElev1,1) + ReKiBuf(Re_Xferred) = InData%WaveElev1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AddF0))-1 ) = PACK(InData%AddF0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AddF0) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AddCLin))-1 ) = PACK(InData%AddCLin,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AddCLin) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AddBLin))-1 ) = PACK(InData%AddBLin,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AddBLin) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AddBQuad))-1 ) = PACK(InData%AddBQuad,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AddBQuad) - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDpth + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%AddF0,1), UBOUND(InData%AddF0,1) + ReKiBuf(Re_Xferred) = InData%AddF0(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i2 = LBOUND(InData%AddCLin,2), UBOUND(InData%AddCLin,2) + DO i1 = LBOUND(InData%AddCLin,1), UBOUND(InData%AddCLin,1) + ReKiBuf(Re_Xferred) = InData%AddCLin(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%AddBLin,2), UBOUND(InData%AddBLin,2) + DO i1 = LBOUND(InData%AddBLin,1), UBOUND(InData%AddBLin,1) + ReKiBuf(Re_Xferred) = InData%AddBLin(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%AddBQuad,2), UBOUND(InData%AddBQuad,2) + DO i1 = LBOUND(InData%AddBQuad,1), UBOUND(InData%AddBQuad,1) + ReKiBuf(Re_Xferred) = InData%AddBQuad(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -6623,28 +6537,28 @@ SUBROUTINE HydroDyn_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumTotalOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%OutSwtch - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutSFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%Delim) - IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UnOutFile - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%OutDec - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumTotalOuts + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%OutSwtch + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%OutFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%OutSFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%Delim) + IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%UnOutFile + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%OutDec + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%Jac_u_indx) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -6658,8 +6572,12 @@ SUBROUTINE HydroDyn_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Jac_u_indx)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%Jac_u_indx))-1 ) = PACK(InData%Jac_u_indx,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%Jac_u_indx) + DO i2 = LBOUND(InData%Jac_u_indx,2), UBOUND(InData%Jac_u_indx,2) + DO i1 = LBOUND(InData%Jac_u_indx,1), UBOUND(InData%Jac_u_indx,1) + IntKiBuf(Int_Xferred) = InData%Jac_u_indx(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%du) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6671,8 +6589,10 @@ SUBROUTINE HydroDyn_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%du,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%du)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%du))-1 ) = PACK(InData%du,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%du) + DO i1 = LBOUND(InData%du,1), UBOUND(InData%du,1) + DbKiBuf(Db_Xferred) = InData%du(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%dx) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6684,11 +6604,13 @@ SUBROUTINE HydroDyn_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dx,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%dx)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%dx))-1 ) = PACK(InData%dx,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%dx) + DO i1 = LBOUND(InData%dx,1), UBOUND(InData%dx,1) + DbKiBuf(Db_Xferred) = InData%dx(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Jac_ny - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Jac_ny + Int_Xferred = Int_Xferred + 1 END SUBROUTINE HydroDyn_PackParam SUBROUTINE HydroDyn_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -6704,12 +6626,6 @@ SUBROUTINE HydroDyn_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -6885,8 +6801,8 @@ SUBROUTINE HydroDyn_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%PotMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%PotMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -6900,20 +6816,15 @@ SUBROUTINE HydroDyn_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveTime)>0) OutData%WaveTime = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveTime))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveTime) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) + OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%NStepWave = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NWaveElev = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NStepWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NWaveElev = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -6930,15 +6841,12 @@ SUBROUTINE HydroDyn_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveElev)>0) OutData%WaveElev = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElev))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElev) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveElev,2), UBOUND(OutData%WaveElev,2) + DO i1 = LBOUND(OutData%WaveElev,1), UBOUND(OutData%WaveElev,1) + OutData%WaveElev(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev1 not allocated Int_Xferred = Int_Xferred + 1 @@ -6956,70 +6864,53 @@ SUBROUTINE HydroDyn_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveElev1)>0) OutData%WaveElev1 = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElev1))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElev1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveElev1,2), UBOUND(OutData%WaveElev1,2) + DO i1 = LBOUND(OutData%WaveElev1,1), UBOUND(OutData%WaveElev1,1) + OutData%WaveElev1(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%WtrDpth = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%WtrDpth = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%AddF0,1) i1_u = UBOUND(OutData%AddF0,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%AddF0 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AddF0))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AddF0) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AddF0,1), UBOUND(OutData%AddF0,1) + OutData%AddF0(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%AddCLin,1) i1_u = UBOUND(OutData%AddCLin,1) i2_l = LBOUND(OutData%AddCLin,2) i2_u = UBOUND(OutData%AddCLin,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%AddCLin = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AddCLin))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AddCLin) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AddCLin,2), UBOUND(OutData%AddCLin,2) + DO i1 = LBOUND(OutData%AddCLin,1), UBOUND(OutData%AddCLin,1) + OutData%AddCLin(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%AddBLin,1) i1_u = UBOUND(OutData%AddBLin,1) i2_l = LBOUND(OutData%AddBLin,2) i2_u = UBOUND(OutData%AddBLin,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%AddBLin = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AddBLin))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AddBLin) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AddBLin,2), UBOUND(OutData%AddBLin,2) + DO i1 = LBOUND(OutData%AddBLin,1), UBOUND(OutData%AddBLin,1) + OutData%AddBLin(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%AddBQuad,1) i1_u = UBOUND(OutData%AddBQuad,1) i2_l = LBOUND(OutData%AddBQuad,2) i2_u = UBOUND(OutData%AddBQuad,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%AddBQuad = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AddBQuad))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AddBQuad) - DEALLOCATE(mask2) - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + DO i2 = LBOUND(OutData%AddBQuad,2), UBOUND(OutData%AddBQuad,2) + DO i1 = LBOUND(OutData%AddBQuad,1), UBOUND(OutData%AddBQuad,1) + OutData%AddBQuad(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -7076,28 +6967,28 @@ SUBROUTINE HydroDyn_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumTotalOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%OutSwtch = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutSFmt) - OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%UnOutFile = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%OutDec = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumTotalOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%OutSwtch = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%OutFmt) + OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%OutSFmt) + OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%Delim) + OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%UnOutFile = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%OutDec = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_u_indx not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -7114,15 +7005,12 @@ SUBROUTINE HydroDyn_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Jac_u_indx)>0) OutData%Jac_u_indx = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%Jac_u_indx))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%Jac_u_indx) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Jac_u_indx,2), UBOUND(OutData%Jac_u_indx,2) + DO i1 = LBOUND(OutData%Jac_u_indx,1), UBOUND(OutData%Jac_u_indx,1) + OutData%Jac_u_indx(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! du not allocated Int_Xferred = Int_Xferred + 1 @@ -7137,15 +7025,10 @@ SUBROUTINE HydroDyn_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%du.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%du)>0) OutData%du = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%du))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%du) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%du,1), UBOUND(OutData%du,1) + OutData%du(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dx not allocated Int_Xferred = Int_Xferred + 1 @@ -7160,18 +7043,13 @@ SUBROUTINE HydroDyn_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%dx)>0) OutData%dx = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%dx))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%dx) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%dx,1), UBOUND(OutData%dx,1) + OutData%dx(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO END IF - OutData%Jac_ny = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%Jac_ny = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE HydroDyn_UnPackParam SUBROUTINE HydroDyn_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -7377,12 +7255,6 @@ SUBROUTINE HydroDyn_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_UnPackInput' @@ -7893,8 +7765,10 @@ SUBROUTINE HydroDyn_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WriteOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE HydroDyn_PackOutput @@ -7911,12 +7785,6 @@ SUBROUTINE HydroDyn_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -8184,15 +8052,10 @@ SUBROUTINE HydroDyn_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WriteOutput)>0) OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE HydroDyn_UnPackOutput @@ -8271,8 +8134,8 @@ SUBROUTINE HydroDyn_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, Er REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -8287,6 +8150,8 @@ SUBROUTINE HydroDyn_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL Morison_Input_ExtrapInterp1( u1%Morison, u2%Morison, tin, u_out%Morison, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL MeshExtrapInterp1(u1%Mesh, u2%Mesh, tin, u_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) @@ -8320,8 +8185,9 @@ SUBROUTINE HydroDyn_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_Input_ExtrapInterp2' @@ -8343,6 +8209,8 @@ SUBROUTINE HydroDyn_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL Morison_Input_ExtrapInterp2( u1%Morison, u2%Morison, u3%Morison, tin, u_out%Morison, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL MeshExtrapInterp2(u1%Mesh, u2%Mesh, u3%Mesh, tin, u_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) @@ -8424,12 +8292,12 @@ SUBROUTINE HydroDyn_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, E REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! 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 :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -8442,6 +8310,8 @@ SUBROUTINE HydroDyn_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, E CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL WAMIT_Output_ExtrapInterp1( y1%WAMIT, y2%WAMIT, tin, y_out%WAMIT, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL WAMIT2_Output_ExtrapInterp1( y1%WAMIT2, y2%WAMIT2, tin, y_out%WAMIT2, tin_out, ErrStat2, ErrMsg2 ) @@ -8455,12 +8325,10 @@ SUBROUTINE HydroDyn_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, E CALL MeshExtrapInterp1(y1%AllHdroOrigin, y2%AllHdroOrigin, tin, y_out%AllHdroOrigin, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END IF ! check if allocated END SUBROUTINE HydroDyn_Output_ExtrapInterp1 @@ -8491,13 +8359,14 @@ SUBROUTINE HydroDyn_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrSta REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -8516,6 +8385,8 @@ SUBROUTINE HydroDyn_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrSta CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL WAMIT_Output_ExtrapInterp2( y1%WAMIT, y2%WAMIT, y3%WAMIT, tin, y_out%WAMIT, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL WAMIT2_Output_ExtrapInterp2( y1%WAMIT2, y2%WAMIT2, y3%WAMIT2, tin, y_out%WAMIT2, tin_out, ErrStat2, ErrMsg2 ) @@ -8529,13 +8400,11 @@ SUBROUTINE HydroDyn_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrSta CALL MeshExtrapInterp2(y1%AllHdroOrigin, y2%AllHdroOrigin, y3%AllHdroOrigin, tin, y_out%AllHdroOrigin, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END IF ! check if allocated END SUBROUTINE HydroDyn_Output_ExtrapInterp2 diff --git a/modules/hydrodyn/src/Morison_Types.f90 b/modules/hydrodyn/src/Morison_Types.f90 index baa9d27f7f..c900a11d05 100644 --- a/modules/hydrodyn/src/Morison_Types.f90 +++ b/modules/hydrodyn/src/Morison_Types.f90 @@ -519,20 +519,24 @@ SUBROUTINE Morison_PackJointType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%JointID - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%JointPos))-1 ) = PACK(InData%JointPos,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%JointPos) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%JointAxID - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%JointAxIDIndx - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%JointOvrlp - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NConnections - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%ConnectionList))-1 ) = PACK(InData%ConnectionList,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%ConnectionList) + IntKiBuf(Int_Xferred) = InData%JointID + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%JointPos,1), UBOUND(InData%JointPos,1) + ReKiBuf(Re_Xferred) = InData%JointPos(i1) + Re_Xferred = Re_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%JointAxID + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%JointAxIDIndx + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%JointOvrlp + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NConnections + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%ConnectionList,1), UBOUND(InData%ConnectionList,1) + IntKiBuf(Int_Xferred) = InData%ConnectionList(i1) + Int_Xferred = Int_Xferred + 1 + END DO END SUBROUTINE Morison_PackJointType SUBROUTINE Morison_UnPackJointType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -548,12 +552,6 @@ SUBROUTINE Morison_UnPackJointType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -570,38 +568,28 @@ SUBROUTINE Morison_UnPackJointType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%JointID = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%JointID = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%JointPos,1) i1_u = UBOUND(OutData%JointPos,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%JointPos = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%JointPos))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%JointPos) - DEALLOCATE(mask1) - OutData%JointAxID = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%JointAxIDIndx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%JointOvrlp = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NConnections = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%JointPos,1), UBOUND(OutData%JointPos,1) + OutData%JointPos(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%JointAxID = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%JointAxIDIndx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%JointOvrlp = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NConnections = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%ConnectionList,1) i1_u = UBOUND(OutData%ConnectionList,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%ConnectionList = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%ConnectionList))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%ConnectionList) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%ConnectionList,1), UBOUND(OutData%ConnectionList,1) + OutData%ConnectionList(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END SUBROUTINE Morison_UnPackJointType SUBROUTINE Morison_CopyMemberPropType( SrcMemberPropTypeData, DstMemberPropTypeData, CtrlCode, ErrStat, ErrMsg ) @@ -699,12 +687,12 @@ SUBROUTINE Morison_PackMemberPropType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%PropSetID - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PropD - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PropThck - Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%PropSetID + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PropD + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PropThck + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Morison_PackMemberPropType SUBROUTINE Morison_UnPackMemberPropType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -720,12 +708,6 @@ SUBROUTINE Morison_UnPackMemberPropType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Morison_UnPackMemberPropType' @@ -739,12 +721,12 @@ SUBROUTINE Morison_UnPackMemberPropType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%PropSetID = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%PropD = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PropThck = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%PropSetID = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%PropD = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PropThck = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Morison_UnPackMemberPropType SUBROUTINE Morison_CopyFilledGroupType( SrcFilledGroupTypeData, DstFilledGroupTypeData, CtrlCode, ErrStat, ErrMsg ) @@ -865,8 +847,8 @@ SUBROUTINE Morison_PackFilledGroupType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrS Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%FillNumM - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%FillNumM + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%FillMList) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -877,17 +859,19 @@ SUBROUTINE Morison_PackFilledGroupType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrS IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FillMList,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FillMList)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%FillMList))-1 ) = PACK(InData%FillMList,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%FillMList) + DO i1 = LBOUND(InData%FillMList,1), UBOUND(InData%FillMList,1) + IntKiBuf(Int_Xferred) = InData%FillMList(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FillFSLoc - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%FillDensChr) - IntKiBuf(Int_Xferred) = ICHAR(InData%FillDensChr(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FillDens - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FillFSLoc + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(InData%FillDensChr) + IntKiBuf(Int_Xferred) = ICHAR(InData%FillDensChr(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + ReKiBuf(Re_Xferred) = InData%FillDens + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Morison_PackFilledGroupType SUBROUTINE Morison_UnPackFilledGroupType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -903,12 +887,6 @@ SUBROUTINE Morison_UnPackFilledGroupType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -923,8 +901,8 @@ SUBROUTINE Morison_UnPackFilledGroupType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%FillNumM = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%FillNumM = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FillMList not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -938,24 +916,19 @@ SUBROUTINE Morison_UnPackFilledGroupType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FillMList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%FillMList)>0) OutData%FillMList = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%FillMList))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%FillMList) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FillMList,1), UBOUND(OutData%FillMList,1) + OutData%FillMList(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF - OutData%FillFSLoc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%FillDensChr) - OutData%FillDensChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%FillDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%FillFSLoc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(OutData%FillDensChr) + OutData%FillDensChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%FillDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Morison_UnPackFilledGroupType SUBROUTINE Morison_CopyCoefDpths( SrcCoefDpthsData, DstCoefDpthsData, CtrlCode, ErrStat, ErrMsg ) @@ -1069,28 +1042,28 @@ SUBROUTINE Morison_PackCoefDpths( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Dpth - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DpthCd - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DpthCdMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DpthCa - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DpthCaMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DpthCp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DpthCpMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DpthAxCa - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DpthAxCaMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DpthAxCp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DpthAxCpMG - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Dpth + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DpthCd + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DpthCdMG + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DpthCa + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DpthCaMG + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DpthCp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DpthCpMG + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DpthAxCa + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DpthAxCaMG + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DpthAxCp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DpthAxCpMG + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Morison_PackCoefDpths SUBROUTINE Morison_UnPackCoefDpths( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1106,12 +1079,6 @@ SUBROUTINE Morison_UnPackCoefDpths( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Morison_UnPackCoefDpths' @@ -1125,28 +1092,28 @@ SUBROUTINE Morison_UnPackCoefDpths( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%Dpth = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%DpthCd = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%DpthCdMG = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%DpthCa = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%DpthCaMG = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%DpthCp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%DpthCpMG = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%DpthAxCa = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%DpthAxCaMG = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%DpthAxCp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%DpthAxCpMG = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%Dpth = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%DpthCd = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%DpthCdMG = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%DpthCa = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%DpthCaMG = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%DpthCp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%DpthCpMG = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%DpthAxCa = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%DpthAxCaMG = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%DpthAxCp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%DpthAxCpMG = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Morison_UnPackCoefDpths SUBROUTINE Morison_CopyAxialCoefType( SrcAxialCoefTypeData, DstAxialCoefTypeData, CtrlCode, ErrStat, ErrMsg ) @@ -1246,14 +1213,14 @@ SUBROUTINE Morison_PackAxialCoefType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%AxCoefID - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AxCd - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AxCa - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AxCp - Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%AxCoefID + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AxCd + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AxCa + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AxCp + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Morison_PackAxialCoefType SUBROUTINE Morison_UnPackAxialCoefType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1269,12 +1236,6 @@ SUBROUTINE Morison_UnPackAxialCoefType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Morison_UnPackAxialCoefType' @@ -1288,14 +1249,14 @@ SUBROUTINE Morison_UnPackAxialCoefType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%AxCoefID = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%AxCd = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%AxCa = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%AxCp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%AxCoefID = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%AxCd = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AxCa = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AxCp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Morison_UnPackAxialCoefType SUBROUTINE Morison_CopyMemberInputType( SrcMemberInputTypeData, DstMemberInputTypeData, CtrlCode, ErrStat, ErrMsg ) @@ -1423,40 +1384,46 @@ SUBROUTINE Morison_PackMemberInputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrS Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MemberID - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MJointID1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MJointID2 - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MJointID1Indx - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MJointID2Indx - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MPropSetID1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MPropSetID2 - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MPropSetID1Indx - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MPropSetID2Indx - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MDivSize - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MCoefMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MmbrCoefIDIndx - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MmbrFilledIDIndx - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PropPot , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumSplits - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Splits))-1 ) = PACK(InData%Splits,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Splits) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%R_LToG))-1 ) = PACK(InData%R_LToG,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%R_LToG) + IntKiBuf(Int_Xferred) = InData%MemberID + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MJointID1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MJointID2 + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MJointID1Indx + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MJointID2Indx + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MPropSetID1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MPropSetID2 + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MPropSetID1Indx + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MPropSetID2Indx + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MDivSize + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MCoefMod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MmbrCoefIDIndx + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MmbrFilledIDIndx + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PropPot, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumSplits + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%Splits,1), UBOUND(InData%Splits,1) + ReKiBuf(Re_Xferred) = InData%Splits(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i2 = LBOUND(InData%R_LToG,2), UBOUND(InData%R_LToG,2) + DO i1 = LBOUND(InData%R_LToG,1), UBOUND(InData%R_LToG,1) + ReKiBuf(Re_Xferred) = InData%R_LToG(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END SUBROUTINE Morison_PackMemberInputType SUBROUTINE Morison_UnPackMemberInputType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1472,12 +1439,6 @@ SUBROUTINE Morison_UnPackMemberInputType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -1493,60 +1454,52 @@ SUBROUTINE Morison_UnPackMemberInputType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%MemberID = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%MJointID1 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%MJointID2 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%MJointID1Indx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%MJointID2Indx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%MPropSetID1 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%MPropSetID2 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%MPropSetID1Indx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%MPropSetID2Indx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%MDivSize = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MCoefMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%MmbrCoefIDIndx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%MmbrFilledIDIndx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%PropPot = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NumSplits = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%MemberID = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%MJointID1 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%MJointID2 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%MJointID1Indx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%MJointID2Indx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%MPropSetID1 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%MPropSetID2 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%MPropSetID1Indx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%MPropSetID2Indx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%MDivSize = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MCoefMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%MmbrCoefIDIndx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%MmbrFilledIDIndx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%PropPot = TRANSFER(IntKiBuf(Int_Xferred), OutData%PropPot) + Int_Xferred = Int_Xferred + 1 + OutData%NumSplits = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%Splits,1) i1_u = UBOUND(OutData%Splits,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%Splits = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Splits))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Splits) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Splits,1), UBOUND(OutData%Splits,1) + OutData%Splits(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%R_LToG,1) i1_u = UBOUND(OutData%R_LToG,1) i2_l = LBOUND(OutData%R_LToG,2) i2_u = UBOUND(OutData%R_LToG,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%R_LToG = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%R_LToG))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%R_LToG) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%R_LToG,2), UBOUND(OutData%R_LToG,2) + DO i1 = LBOUND(OutData%R_LToG,1), UBOUND(OutData%R_LToG,1) + OutData%R_LToG(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END SUBROUTINE Morison_UnPackMemberInputType SUBROUTINE Morison_CopyNodeType( SrcNodeTypeData, DstNodeTypeData, CtrlCode, ErrStat, ErrMsg ) @@ -1706,72 +1659,80 @@ SUBROUTINE Morison_PackNodeType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NodeType - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%JointIndx - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%JointPos))-1 ) = PACK(InData%JointPos,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%JointPos) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%JointOvrlp - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%JointAxIDIndx - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NConnections - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%ConnectionList))-1 ) = PACK(InData%ConnectionList,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%ConnectionList) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NConnectPreSplit - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cd - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CdMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Ca - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CaMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CpMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%JAxCd - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%JAxCa - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%JAxCp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AxCa - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AxCp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AxCaMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AxCpMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%R - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%t - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%tMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dRdz - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MGdensity - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FillFSLoc - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%FillFlag , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FillDensity - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%InpMbrIndx - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%InpMbrDist - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PropPot , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%R_LToG))-1 ) = PACK(InData%R_LToG,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%R_LToG) + IntKiBuf(Int_Xferred) = InData%NodeType + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%JointIndx + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%JointPos,1), UBOUND(InData%JointPos,1) + ReKiBuf(Re_Xferred) = InData%JointPos(i1) + Re_Xferred = Re_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%JointOvrlp + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%JointAxIDIndx + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NConnections + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%ConnectionList,1), UBOUND(InData%ConnectionList,1) + IntKiBuf(Int_Xferred) = InData%ConnectionList(i1) + Int_Xferred = Int_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%NConnectPreSplit + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cd + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CdMG + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Ca + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CaMG + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CpMG + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%JAxCd + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%JAxCa + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%JAxCp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AxCa + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AxCp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AxCaMG + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AxCpMG + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%R + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%t + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%tMG + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dRdz + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MGdensity + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FillFSLoc + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%FillFlag, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FillDensity + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%InpMbrIndx + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%InpMbrDist + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PropPot, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(InData%R_LToG,2), UBOUND(InData%R_LToG,2) + DO i1 = LBOUND(InData%R_LToG,1), UBOUND(InData%R_LToG,1) + ReKiBuf(Re_Xferred) = InData%R_LToG(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END SUBROUTINE Morison_PackNodeType SUBROUTINE Morison_UnPackNodeType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1787,12 +1748,6 @@ SUBROUTINE Morison_UnPackNodeType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -1808,101 +1763,88 @@ SUBROUTINE Morison_UnPackNodeType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%NodeType = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%JointIndx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NodeType = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%JointIndx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%JointPos,1) i1_u = UBOUND(OutData%JointPos,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%JointPos = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%JointPos))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%JointPos) - DEALLOCATE(mask1) - OutData%JointOvrlp = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%JointAxIDIndx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NConnections = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%JointPos,1), UBOUND(OutData%JointPos,1) + OutData%JointPos(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%JointOvrlp = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%JointAxIDIndx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NConnections = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%ConnectionList,1) i1_u = UBOUND(OutData%ConnectionList,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%ConnectionList = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%ConnectionList))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%ConnectionList) - DEALLOCATE(mask1) - OutData%NConnectPreSplit = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%Cd = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%CdMG = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Ca = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%CaMG = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%CpMG = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%JAxCd = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%JAxCa = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%JAxCp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%AxCa = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%AxCp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%AxCaMG = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%AxCpMG = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%R = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%t = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%tMG = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%dRdz = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MGdensity = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%FillFSLoc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%FillFlag = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%FillDensity = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%InpMbrIndx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%InpMbrDist = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PropPot = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%ConnectionList,1), UBOUND(OutData%ConnectionList,1) + OutData%ConnectionList(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + OutData%NConnectPreSplit = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Cd = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%CdMG = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Ca = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%CaMG = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%CpMG = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%JAxCd = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%JAxCa = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%JAxCp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AxCa = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AxCp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AxCaMG = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AxCpMG = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%R = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%t = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%tMG = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%dRdz = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MGdensity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%FillFSLoc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%FillFlag = TRANSFER(IntKiBuf(Int_Xferred), OutData%FillFlag) + Int_Xferred = Int_Xferred + 1 + OutData%FillDensity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%InpMbrIndx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%InpMbrDist = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PropPot = TRANSFER(IntKiBuf(Int_Xferred), OutData%PropPot) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%R_LToG,1) i1_u = UBOUND(OutData%R_LToG,1) i2_l = LBOUND(OutData%R_LToG,2) i2_u = UBOUND(OutData%R_LToG,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%R_LToG = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%R_LToG))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%R_LToG) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%R_LToG,2), UBOUND(OutData%R_LToG,2) + DO i1 = LBOUND(OutData%R_LToG,1), UBOUND(OutData%R_LToG,1) + OutData%R_LToG(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END SUBROUTINE Morison_UnPackNodeType SUBROUTINE Morison_CopyMemberType( SrcMemberTypeData, DstMemberTypeData, CtrlCode, ErrStat, ErrMsg ) @@ -2082,92 +2024,102 @@ SUBROUTINE Morison_PackMemberType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Node1Indx - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Node2Indx - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%R1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%t1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%R2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%t2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cd1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CdMG1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Ca1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CaMG1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cp1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CpMG1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AxCa1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AxCaMG1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AxCp1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AxCpMG1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cd2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CdMG2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Ca2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CaMG2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cp2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CpMG2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AxCa2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AxCaMG2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AxCp2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AxCpMG2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%InpMbrDist1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%InpMbrDist2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%InpMbrLen - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%InpMbrIndx - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%R_LToG))-1 ) = PACK(InData%R_LToG,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%R_LToG) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumSplits - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Splits))-1 ) = PACK(InData%Splits,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Splits) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MGvolume - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MDivSize - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MCoefMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MmbrCoefIDIndx - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MmbrFilledIDIndx - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FillFSLoc - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FillDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_Bouy))-1 ) = PACK(InData%F_Bouy,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_Bouy) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_DP))-1 ) = PACK(InData%F_DP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_DP) - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PropPot , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Node1Indx + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Node2Indx + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%R1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%t1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%R2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%t2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cd1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CdMG1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Ca1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CaMG1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cp1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CpMG1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AxCa1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AxCaMG1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AxCp1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AxCpMG1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cd2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CdMG2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Ca2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CaMG2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cp2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CpMG2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AxCa2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AxCaMG2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AxCp2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AxCpMG2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%InpMbrDist1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%InpMbrDist2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%InpMbrLen + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%InpMbrIndx + Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(InData%R_LToG,2), UBOUND(InData%R_LToG,2) + DO i1 = LBOUND(InData%R_LToG,1), UBOUND(InData%R_LToG,1) + ReKiBuf(Re_Xferred) = InData%R_LToG(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + IntKiBuf(Int_Xferred) = InData%NumSplits + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%Splits,1), UBOUND(InData%Splits,1) + ReKiBuf(Re_Xferred) = InData%Splits(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%MGvolume + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MDivSize + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MCoefMod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MmbrCoefIDIndx + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MmbrFilledIDIndx + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FillFSLoc + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FillDens + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%F_Bouy,1), UBOUND(InData%F_Bouy,1) + ReKiBuf(Re_Xferred) = InData%F_Bouy(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%F_DP,1), UBOUND(InData%F_DP,1) + ReKiBuf(Re_Xferred) = InData%F_DP(i1) + Re_Xferred = Re_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = TRANSFER(InData%PropPot, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Morison_PackMemberType SUBROUTINE Morison_UnPackMemberType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2183,12 +2135,6 @@ SUBROUTINE Morison_UnPackMemberType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -2204,130 +2150,112 @@ SUBROUTINE Morison_UnPackMemberType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%Node1Indx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%Node2Indx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%R1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%t1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%R2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%t2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cd1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%CdMG1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Ca1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%CaMG1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cp1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%CpMG1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%AxCa1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%AxCaMG1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%AxCp1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%AxCpMG1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cd2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%CdMG2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Ca2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%CaMG2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cp2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%CpMG2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%AxCa2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%AxCaMG2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%AxCp2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%AxCpMG2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%InpMbrDist1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%InpMbrDist2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%InpMbrLen = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%InpMbrIndx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%Node1Indx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Node2Indx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%R1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%t1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%R2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%t2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cd1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%CdMG1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Ca1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%CaMG1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cp1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%CpMG1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AxCa1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AxCaMG1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AxCp1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AxCpMG1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cd2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%CdMG2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Ca2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%CaMG2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cp2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%CpMG2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AxCa2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AxCaMG2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AxCp2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AxCpMG2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%InpMbrDist1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%InpMbrDist2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%InpMbrLen = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%InpMbrIndx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%R_LToG,1) i1_u = UBOUND(OutData%R_LToG,1) i2_l = LBOUND(OutData%R_LToG,2) i2_u = UBOUND(OutData%R_LToG,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%R_LToG = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%R_LToG))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%R_LToG) - DEALLOCATE(mask2) - OutData%NumSplits = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(OutData%R_LToG,2), UBOUND(OutData%R_LToG,2) + DO i1 = LBOUND(OutData%R_LToG,1), UBOUND(OutData%R_LToG,1) + OutData%R_LToG(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + OutData%NumSplits = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%Splits,1) i1_u = UBOUND(OutData%Splits,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%Splits = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Splits))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Splits) - DEALLOCATE(mask1) - OutData%MGvolume = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MDivSize = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MCoefMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%MmbrCoefIDIndx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%MmbrFilledIDIndx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%FillFSLoc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%FillDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%Splits,1), UBOUND(OutData%Splits,1) + OutData%Splits(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%MGvolume = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MDivSize = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MCoefMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%MmbrCoefIDIndx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%MmbrFilledIDIndx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%FillFSLoc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%FillDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%F_Bouy,1) i1_u = UBOUND(OutData%F_Bouy,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%F_Bouy = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_Bouy))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_Bouy) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%F_Bouy,1), UBOUND(OutData%F_Bouy,1) + OutData%F_Bouy(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%F_DP,1) i1_u = UBOUND(OutData%F_DP,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%F_DP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_DP))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_DP) - DEALLOCATE(mask1) - OutData%PropPot = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%F_DP,1), UBOUND(OutData%F_DP,1) + OutData%F_DP(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%PropPot = TRANSFER(IntKiBuf(Int_Xferred), OutData%PropPot) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Morison_UnPackMemberType SUBROUTINE Morison_CopyCoefMembers( SrcCoefMembersData, DstCoefMembersData, CtrlCode, ErrStat, ErrMsg ) @@ -2461,48 +2389,48 @@ SUBROUTINE Morison_PackCoefMembers( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MemberID - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MemberCd1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MemberCd2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MemberCdMG1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MemberCdMG2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MemberCa1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MemberCa2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MemberCaMG1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MemberCaMG2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MemberCp1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MemberCp2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MemberCpMG1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MemberCpMG2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MemberAxCa1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MemberAxCa2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MemberAxCaMG1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MemberAxCaMG2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MemberAxCp1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MemberAxCp2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MemberAxCpMG1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MemberAxCpMG2 - Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MemberID + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MemberCd1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MemberCd2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MemberCdMG1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MemberCdMG2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MemberCa1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MemberCa2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MemberCaMG1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MemberCaMG2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MemberCp1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MemberCp2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MemberCpMG1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MemberCpMG2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MemberAxCa1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MemberAxCa2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MemberAxCaMG1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MemberAxCaMG2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MemberAxCp1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MemberAxCp2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MemberAxCpMG1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MemberAxCpMG2 + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Morison_PackCoefMembers SUBROUTINE Morison_UnPackCoefMembers( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2518,12 +2446,6 @@ SUBROUTINE Morison_UnPackCoefMembers( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Morison_UnPackCoefMembers' @@ -2537,48 +2459,48 @@ SUBROUTINE Morison_UnPackCoefMembers( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%MemberID = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%MemberCd1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCd2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCdMG1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCdMG2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCa1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCa2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCaMG1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCaMG2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCp1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCp2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCpMG1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCpMG2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MemberAxCa1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MemberAxCa2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MemberAxCaMG1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MemberAxCaMG2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MemberAxCp1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MemberAxCp2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MemberAxCpMG1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MemberAxCpMG2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%MemberID = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%MemberCd1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MemberCd2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MemberCdMG1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MemberCdMG2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MemberCa1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MemberCa2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MemberCaMG1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MemberCaMG2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MemberCp1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MemberCp2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MemberCpMG1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MemberCpMG2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MemberAxCa1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MemberAxCa2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MemberAxCaMG1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MemberAxCaMG2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MemberAxCp1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MemberAxCp2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MemberAxCpMG1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MemberAxCpMG2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Morison_UnPackCoefMembers SUBROUTINE Morison_CopyMGDepthsType( SrcMGDepthsTypeData, DstMGDepthsTypeData, CtrlCode, ErrStat, ErrMsg ) @@ -2676,12 +2598,12 @@ SUBROUTINE Morison_PackMGDepthsType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MGDpth - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MGThck - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MGDens - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MGDpth + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MGThck + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MGDens + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Morison_PackMGDepthsType SUBROUTINE Morison_UnPackMGDepthsType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2697,12 +2619,6 @@ SUBROUTINE Morison_UnPackMGDepthsType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Morison_UnPackMGDepthsType' @@ -2716,12 +2632,12 @@ SUBROUTINE Morison_UnPackMGDepthsType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%MGDpth = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MGThck = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MGDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%MGDpth = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MGThck = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MGDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Morison_UnPackMGDepthsType SUBROUTINE Morison_CopyMOutput( SrcMOutputData, DstMOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -2900,10 +2816,10 @@ SUBROUTINE Morison_PackMOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MemberID - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NOutLoc - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MemberID + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NOutLoc + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%NodeLocs) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2914,11 +2830,13 @@ SUBROUTINE Morison_PackMOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodeLocs,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%NodeLocs)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%NodeLocs))-1 ) = PACK(InData%NodeLocs,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%NodeLocs) + DO i1 = LBOUND(InData%NodeLocs,1), UBOUND(InData%NodeLocs,1) + ReKiBuf(Re_Xferred) = InData%NodeLocs(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MemberIDIndx - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MemberIDIndx + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%Marker1) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2929,8 +2847,10 @@ SUBROUTINE Morison_PackMOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Marker1,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Marker1)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%Marker1))-1 ) = PACK(InData%Marker1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%Marker1) + DO i1 = LBOUND(InData%Marker1,1), UBOUND(InData%Marker1,1) + IntKiBuf(Int_Xferred) = InData%Marker1(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%Marker2) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2942,8 +2862,10 @@ SUBROUTINE Morison_PackMOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Marker2,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Marker2)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%Marker2))-1 ) = PACK(InData%Marker2,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%Marker2) + DO i1 = LBOUND(InData%Marker2,1), UBOUND(InData%Marker2,1) + IntKiBuf(Int_Xferred) = InData%Marker2(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%s) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2955,8 +2877,10 @@ SUBROUTINE Morison_PackMOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%s,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%s)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%s))-1 ) = PACK(InData%s,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%s) + DO i1 = LBOUND(InData%s,1), UBOUND(InData%s,1) + ReKiBuf(Re_Xferred) = InData%s(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE Morison_PackMOutput @@ -2973,12 +2897,6 @@ SUBROUTINE Morison_UnPackMOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -2993,10 +2911,10 @@ SUBROUTINE Morison_UnPackMOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%MemberID = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NOutLoc = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%MemberID = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NOutLoc = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NodeLocs not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3010,18 +2928,13 @@ SUBROUTINE Morison_UnPackMOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodeLocs.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%NodeLocs)>0) OutData%NodeLocs = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%NodeLocs))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%NodeLocs) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%NodeLocs,1), UBOUND(OutData%NodeLocs,1) + OutData%NodeLocs(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%MemberIDIndx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%MemberIDIndx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Marker1 not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3035,15 +2948,10 @@ SUBROUTINE Morison_UnPackMOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Marker1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Marker1)>0) OutData%Marker1 = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%Marker1))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%Marker1) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Marker1,1), UBOUND(OutData%Marker1,1) + OutData%Marker1(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Marker2 not allocated Int_Xferred = Int_Xferred + 1 @@ -3058,15 +2966,10 @@ SUBROUTINE Morison_UnPackMOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Marker2.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Marker2)>0) OutData%Marker2 = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%Marker2))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%Marker2) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Marker2,1), UBOUND(OutData%Marker2,1) + OutData%Marker2(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! s not allocated Int_Xferred = Int_Xferred + 1 @@ -3081,15 +2984,10 @@ SUBROUTINE Morison_UnPackMOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%s.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%s)>0) OutData%s = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%s))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%s) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%s,1), UBOUND(OutData%s,1) + OutData%s(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE Morison_UnPackMOutput @@ -3191,14 +3089,16 @@ SUBROUTINE Morison_PackJOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%JointID - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%JointIDIndx - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumMarkers - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%Markers))-1 ) = PACK(InData%Markers,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%Markers) + IntKiBuf(Int_Xferred) = InData%JointID + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%JointIDIndx + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumMarkers + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%Markers,1), UBOUND(InData%Markers,1) + IntKiBuf(Int_Xferred) = InData%Markers(i1) + Int_Xferred = Int_Xferred + 1 + END DO END SUBROUTINE Morison_PackJOutput SUBROUTINE Morison_UnPackJOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -3214,12 +3114,6 @@ SUBROUTINE Morison_UnPackJOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -3234,23 +3128,18 @@ SUBROUTINE Morison_UnPackJOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%JointID = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%JointIDIndx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumMarkers = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%JointID = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%JointIDIndx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumMarkers = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%Markers,1) i1_u = UBOUND(OutData%Markers,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%Markers = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%Markers))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%Markers) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Markers,1), UBOUND(OutData%Markers,1) + OutData%Markers(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END SUBROUTINE Morison_UnPackJOutput SUBROUTINE Morison_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) @@ -4092,20 +3981,20 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MSL2SWL - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NJoints - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NNodes - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TotalPossibleSuperMembers - Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Gravity + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDens + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDpth + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MSL2SWL + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NJoints + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NNodes + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TotalPossibleSuperMembers + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%InpJoints) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4188,8 +4077,8 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NElements - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NElements + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%Elements) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4231,8 +4120,8 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NAxCoefs - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NAxCoefs + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%AxialCoefs) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4274,8 +4163,8 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NPropSets - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NPropSets + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%MPropSets) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4317,28 +4206,28 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ENDIF END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SimplCd - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SimplCdMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SimplCa - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SimplCaMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SimplCp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SimplCpMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SimplAxCa - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SimplAxCaMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SimplAxCp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SimplAxCpMG - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NCoefDpth - Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SimplCd + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SimplCdMG + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SimplCa + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SimplCaMG + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SimplCp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SimplCpMG + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SimplAxCa + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SimplAxCaMG + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SimplAxCp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SimplAxCpMG + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NCoefDpth + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%CoefDpths) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4380,8 +4269,8 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NCoefMembers - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NCoefMembers + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%CoefMembers) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4423,8 +4312,8 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NMembers - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NMembers + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%InpMembers) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4466,8 +4355,8 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NFillGroups - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NFillGroups + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%FilledGroups) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4509,8 +4398,8 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NMGDepths - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NMGDepths + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%MGDepths) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4552,12 +4441,12 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ENDIF END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MGTop - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MGBottom - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NMOutputs - Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MGTop + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MGBottom + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NMOutputs + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%MOutLst) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4599,8 +4488,8 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NJOutputs - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NJOutputs + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%JOutLst) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4643,11 +4532,11 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E END DO END IF DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) - DO I = 1, LEN(InData%OutList) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 + DO I = 1, LEN(InData%OutList) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO IF ( .NOT. ALLOCATED(InData%ValidOutList) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4658,25 +4547,27 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ValidOutList,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ValidOutList)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%ValidOutList)-1 ) = TRANSFER(PACK( InData%ValidOutList ,.TRUE.), IntKiBuf(1), SIZE(InData%ValidOutList)) - Int_Xferred = Int_Xferred + SIZE(InData%ValidOutList) + DO i1 = LBOUND(InData%ValidOutList,1), UBOUND(InData%ValidOutList,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%ValidOutList(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%OutSwtch - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%OutAll , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutRootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutRootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UnOutFile - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UnSum - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%OutSwtch + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%OutAll, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%OutRootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutRootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%UnOutFile + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%UnSum + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepWave + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveAcc) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4693,8 +4584,14 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveAcc)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveAcc))-1 ) = PACK(InData%WaveAcc,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveAcc) + DO i3 = LBOUND(InData%WaveAcc,3), UBOUND(InData%WaveAcc,3) + DO i2 = LBOUND(InData%WaveAcc,2), UBOUND(InData%WaveAcc,2) + DO i1 = LBOUND(InData%WaveAcc,1), UBOUND(InData%WaveAcc,1) + ReKiBuf(Re_Xferred) = InData%WaveAcc(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4706,8 +4603,10 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveTime)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveTime))-1 ) = PACK(InData%WaveTime,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveTime) + DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) + ReKiBuf(Re_Xferred) = InData%WaveTime(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveDynP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4722,8 +4621,12 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveDynP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveDynP))-1 ) = PACK(InData%WaveDynP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveDynP) + DO i2 = LBOUND(InData%WaveDynP,2), UBOUND(InData%WaveDynP,2) + DO i1 = LBOUND(InData%WaveDynP,1), UBOUND(InData%WaveDynP,1) + ReKiBuf(Re_Xferred) = InData%WaveDynP(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveVel) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4741,8 +4644,14 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveVel)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveVel))-1 ) = PACK(InData%WaveVel,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveVel) + DO i3 = LBOUND(InData%WaveVel,3), UBOUND(InData%WaveVel,3) + DO i2 = LBOUND(InData%WaveVel,2), UBOUND(InData%WaveVel,2) + DO i1 = LBOUND(InData%WaveVel,1), UBOUND(InData%WaveVel,1) + ReKiBuf(Re_Xferred) = InData%WaveVel(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%nodeInWater) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4757,8 +4666,12 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%nodeInWater,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%nodeInWater)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%nodeInWater))-1 ) = PACK(InData%nodeInWater,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%nodeInWater) + DO i2 = LBOUND(InData%nodeInWater,2), UBOUND(InData%nodeInWater,2) + DO i1 = LBOUND(InData%nodeInWater,1), UBOUND(InData%nodeInWater,1) + IntKiBuf(Int_Xferred) = InData%nodeInWater(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF END SUBROUTINE Morison_PackInitInput @@ -4775,12 +4688,6 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -4797,20 +4704,20 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%Gravity = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDpth = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MSL2SWL = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NJoints = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NNodes = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TotalPossibleSuperMembers = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%Gravity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WtrDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WtrDpth = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MSL2SWL = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NJoints = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NNodes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TotalPossibleSuperMembers = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InpJoints not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -4923,8 +4830,8 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%NElements = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NElements = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Elements not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -4981,8 +4888,8 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%NAxCoefs = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NAxCoefs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AxialCoefs not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5039,8 +4946,8 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%NPropSets = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NPropSets = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MPropSets not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5097,28 +5004,28 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%SimplCd = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SimplCdMG = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SimplCa = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SimplCaMG = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SimplCp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SimplCpMG = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SimplAxCa = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SimplAxCaMG = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SimplAxCp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SimplAxCpMG = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NCoefDpth = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%SimplCd = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SimplCdMG = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SimplCa = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SimplCaMG = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SimplCp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SimplCpMG = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SimplAxCa = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SimplAxCaMG = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SimplAxCp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SimplAxCpMG = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NCoefDpth = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CoefDpths not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5175,8 +5082,8 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%NCoefMembers = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NCoefMembers = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CoefMembers not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5233,8 +5140,8 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%NMembers = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NMembers = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InpMembers not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5291,8 +5198,8 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%NFillGroups = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NFillGroups = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FilledGroups not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5349,8 +5256,8 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%NMGDepths = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NMGDepths = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MGDepths not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5407,12 +5314,12 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%MGTop = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MGBottom = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NMOutputs = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%MGTop = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MGBottom = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NMOutputs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MOutLst not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5469,8 +5376,8 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%NJOutputs = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NJOutputs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! JOutLst not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5529,19 +5436,12 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat END IF i1_l = LBOUND(OutData%OutList,1) i1_u = UBOUND(OutData%OutList,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) - DO I = 1, LEN(OutData%OutList) - OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - DEALLOCATE(mask1) + DO I = 1, LEN(OutData%OutList) + OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ValidOutList not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5555,32 +5455,27 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ValidOutList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%ValidOutList)>0) OutData%ValidOutList = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%ValidOutList))-1 ), OutData%ValidOutList), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%ValidOutList) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%ValidOutList,1), UBOUND(OutData%ValidOutList,1) + OutData%ValidOutList(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%ValidOutList(i1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%OutSwtch = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%OutAll = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutRootName) - OutData%OutRootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%UnOutFile = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%UnSum = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NStepWave = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%OutSwtch = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%OutAll = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutAll) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%OutRootName) + OutData%OutRootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%UnOutFile = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%UnSum = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NStepWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAcc not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5600,15 +5495,14 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%WaveAcc)>0) OutData%WaveAcc = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveAcc))-1 ), mask3, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveAcc) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%WaveAcc,3), UBOUND(OutData%WaveAcc,3) + DO i2 = LBOUND(OutData%WaveAcc,2), UBOUND(OutData%WaveAcc,2) + DO i1 = LBOUND(OutData%WaveAcc,1), UBOUND(OutData%WaveAcc,1) + OutData%WaveAcc(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated Int_Xferred = Int_Xferred + 1 @@ -5623,15 +5517,10 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveTime)>0) OutData%WaveTime = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveTime))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveTime) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) + OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDynP not allocated Int_Xferred = Int_Xferred + 1 @@ -5649,15 +5538,12 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveDynP)>0) OutData%WaveDynP = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveDynP))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveDynP) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveDynP,2), UBOUND(OutData%WaveDynP,2) + DO i1 = LBOUND(OutData%WaveDynP,1), UBOUND(OutData%WaveDynP,1) + OutData%WaveDynP(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel not allocated Int_Xferred = Int_Xferred + 1 @@ -5678,15 +5564,14 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%WaveVel)>0) OutData%WaveVel = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveVel))-1 ), mask3, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveVel) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%WaveVel,3), UBOUND(OutData%WaveVel,3) + DO i2 = LBOUND(OutData%WaveVel,2), UBOUND(OutData%WaveVel,2) + DO i1 = LBOUND(OutData%WaveVel,1), UBOUND(OutData%WaveVel,1) + OutData%WaveVel(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! nodeInWater not allocated Int_Xferred = Int_Xferred + 1 @@ -5704,15 +5589,12 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%nodeInWater.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%nodeInWater)>0) OutData%nodeInWater = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%nodeInWater))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%nodeInWater) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%nodeInWater,2), UBOUND(OutData%nodeInWater,2) + DO i1 = LBOUND(OutData%nodeInWater,1), UBOUND(OutData%nodeInWater,1) + OutData%nodeInWater(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF END SUBROUTINE Morison_UnPackInitInput @@ -5975,8 +5857,10 @@ SUBROUTINE Morison_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Morison_Rad,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Morison_Rad)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Morison_Rad))-1 ) = PACK(InData%Morison_Rad,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Morison_Rad) + DO i1 = LBOUND(InData%Morison_Rad,1), UBOUND(InData%Morison_Rad,1) + ReKiBuf(Re_Xferred) = InData%Morison_Rad(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutputHdr) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5988,12 +5872,12 @@ SUBROUTINE Morison_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) + DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) DO I = 1, LEN(InData%WriteOutputHdr) IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdr(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6005,12 +5889,12 @@ SUBROUTINE Morison_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) + DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) DO I = 1, LEN(InData%WriteOutputUnt) IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUnt(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF END SUBROUTINE Morison_PackInitOutput @@ -6027,12 +5911,6 @@ SUBROUTINE Morison_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -6140,15 +6018,10 @@ SUBROUTINE Morison_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Morison_Rad.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Morison_Rad)>0) OutData%Morison_Rad = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Morison_Rad))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%Morison_Rad) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Morison_Rad,1), UBOUND(OutData%Morison_Rad,1) + OutData%Morison_Rad(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputHdr not allocated Int_Xferred = Int_Xferred + 1 @@ -6163,19 +6036,12 @@ SUBROUTINE Morison_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) DO I = 1, LEN(OutData%WriteOutputHdr) OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated Int_Xferred = Int_Xferred + 1 @@ -6190,19 +6056,12 @@ SUBROUTINE Morison_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) DO I = 1, LEN(OutData%WriteOutputUnt) OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF END SUBROUTINE Morison_UnPackInitOutput @@ -6297,8 +6156,8 @@ SUBROUTINE Morison_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyContState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyContState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Morison_PackContState SUBROUTINE Morison_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -6314,12 +6173,6 @@ SUBROUTINE Morison_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Morison_UnPackContState' @@ -6333,8 +6186,8 @@ SUBROUTINE Morison_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyContState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyContState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Morison_UnPackContState SUBROUTINE Morison_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) @@ -6428,8 +6281,8 @@ SUBROUTINE Morison_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyDiscState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Morison_PackDiscState SUBROUTINE Morison_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -6445,12 +6298,6 @@ SUBROUTINE Morison_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Morison_UnPackDiscState' @@ -6464,8 +6311,8 @@ SUBROUTINE Morison_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyDiscState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyDiscState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Morison_UnPackDiscState SUBROUTINE Morison_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -6559,8 +6406,8 @@ SUBROUTINE Morison_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyConstrState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Morison_PackConstrState SUBROUTINE Morison_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -6576,12 +6423,6 @@ SUBROUTINE Morison_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Morison_UnPackConstrState' @@ -6595,8 +6436,8 @@ SUBROUTINE Morison_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyConstrState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyConstrState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Morison_UnPackConstrState SUBROUTINE Morison_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -6690,8 +6531,8 @@ SUBROUTINE Morison_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DummyOtherState - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DummyOtherState + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Morison_PackOtherState SUBROUTINE Morison_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -6707,12 +6548,6 @@ SUBROUTINE Morison_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Morison_UnPackOtherState' @@ -6726,8 +6561,8 @@ SUBROUTINE Morison_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyOtherState = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%DummyOtherState = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Morison_UnPackOtherState SUBROUTINE Morison_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -7228,8 +7063,12 @@ SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_F_D,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D_F_D)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D_F_D))-1 ) = PACK(InData%D_F_D,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D_F_D) + DO i2 = LBOUND(InData%D_F_D,2), UBOUND(InData%D_F_D,2) + DO i1 = LBOUND(InData%D_F_D,1), UBOUND(InData%D_F_D,1) + ReKiBuf(Re_Xferred) = InData%D_F_D(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%D_F_I) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7244,8 +7083,12 @@ SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_F_I,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D_F_I)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D_F_I))-1 ) = PACK(InData%D_F_I,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D_F_I) + DO i2 = LBOUND(InData%D_F_I,2), UBOUND(InData%D_F_I,2) + DO i1 = LBOUND(InData%D_F_I,1), UBOUND(InData%D_F_I,1) + ReKiBuf(Re_Xferred) = InData%D_F_I(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%D_F_B) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7260,8 +7103,12 @@ SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_F_B,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D_F_B)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D_F_B))-1 ) = PACK(InData%D_F_B,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D_F_B) + DO i2 = LBOUND(InData%D_F_B,2), UBOUND(InData%D_F_B,2) + DO i1 = LBOUND(InData%D_F_B,1), UBOUND(InData%D_F_B,1) + ReKiBuf(Re_Xferred) = InData%D_F_B(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%D_F_AM) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7276,8 +7123,12 @@ SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_F_AM,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D_F_AM)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D_F_AM))-1 ) = PACK(InData%D_F_AM,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D_F_AM) + DO i2 = LBOUND(InData%D_F_AM,2), UBOUND(InData%D_F_AM,2) + DO i1 = LBOUND(InData%D_F_AM,1), UBOUND(InData%D_F_AM,1) + ReKiBuf(Re_Xferred) = InData%D_F_AM(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%D_F_AM_M) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7292,8 +7143,12 @@ SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_F_AM_M,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D_F_AM_M)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D_F_AM_M))-1 ) = PACK(InData%D_F_AM_M,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D_F_AM_M) + DO i2 = LBOUND(InData%D_F_AM_M,2), UBOUND(InData%D_F_AM_M,2) + DO i1 = LBOUND(InData%D_F_AM_M,1), UBOUND(InData%D_F_AM_M,1) + ReKiBuf(Re_Xferred) = InData%D_F_AM_M(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%D_F_AM_MG) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7308,8 +7163,12 @@ SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_F_AM_MG,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D_F_AM_MG)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D_F_AM_MG))-1 ) = PACK(InData%D_F_AM_MG,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D_F_AM_MG) + DO i2 = LBOUND(InData%D_F_AM_MG,2), UBOUND(InData%D_F_AM_MG,2) + DO i1 = LBOUND(InData%D_F_AM_MG,1), UBOUND(InData%D_F_AM_MG,1) + ReKiBuf(Re_Xferred) = InData%D_F_AM_MG(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%D_F_AM_F) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7324,8 +7183,12 @@ SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_F_AM_F,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D_F_AM_F)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D_F_AM_F))-1 ) = PACK(InData%D_F_AM_F,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D_F_AM_F) + DO i2 = LBOUND(InData%D_F_AM_F,2), UBOUND(InData%D_F_AM_F,2) + DO i1 = LBOUND(InData%D_F_AM_F,1), UBOUND(InData%D_F_AM_F,1) + ReKiBuf(Re_Xferred) = InData%D_F_AM_F(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%D_FV) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7340,8 +7203,12 @@ SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_FV,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D_FV)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D_FV))-1 ) = PACK(InData%D_FV,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D_FV) + DO i2 = LBOUND(InData%D_FV,2), UBOUND(InData%D_FV,2) + DO i1 = LBOUND(InData%D_FV,1), UBOUND(InData%D_FV,1) + ReKiBuf(Re_Xferred) = InData%D_FV(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%D_FA) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7356,8 +7223,12 @@ SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_FA,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D_FA)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D_FA))-1 ) = PACK(InData%D_FA,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D_FA) + DO i2 = LBOUND(InData%D_FA,2), UBOUND(InData%D_FA,2) + DO i1 = LBOUND(InData%D_FA,1), UBOUND(InData%D_FA,1) + ReKiBuf(Re_Xferred) = InData%D_FA(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%D_FDynP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7369,8 +7240,10 @@ SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_FDynP,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D_FDynP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D_FDynP))-1 ) = PACK(InData%D_FDynP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D_FDynP) + DO i1 = LBOUND(InData%D_FDynP,1), UBOUND(InData%D_FDynP,1) + ReKiBuf(Re_Xferred) = InData%D_FDynP(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%L_F_B) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7385,8 +7258,12 @@ SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%L_F_B,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%L_F_B)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%L_F_B))-1 ) = PACK(InData%L_F_B,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%L_F_B) + DO i2 = LBOUND(InData%L_F_B,2), UBOUND(InData%L_F_B,2) + DO i1 = LBOUND(InData%L_F_B,1), UBOUND(InData%L_F_B,1) + ReKiBuf(Re_Xferred) = InData%L_F_B(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%L_F_D) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7401,8 +7278,12 @@ SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%L_F_D,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%L_F_D)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%L_F_D))-1 ) = PACK(InData%L_F_D,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%L_F_D) + DO i2 = LBOUND(InData%L_F_D,2), UBOUND(InData%L_F_D,2) + DO i1 = LBOUND(InData%L_F_D,1), UBOUND(InData%L_F_D,1) + ReKiBuf(Re_Xferred) = InData%L_F_D(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%L_F_I) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7417,8 +7298,12 @@ SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%L_F_I,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%L_F_I)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%L_F_I))-1 ) = PACK(InData%L_F_I,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%L_F_I) + DO i2 = LBOUND(InData%L_F_I,2), UBOUND(InData%L_F_I,2) + DO i1 = LBOUND(InData%L_F_I,1), UBOUND(InData%L_F_I,1) + ReKiBuf(Re_Xferred) = InData%L_F_I(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%L_F_DP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7433,8 +7318,12 @@ SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%L_F_DP,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%L_F_DP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%L_F_DP))-1 ) = PACK(InData%L_F_DP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%L_F_DP) + DO i2 = LBOUND(InData%L_F_DP,2), UBOUND(InData%L_F_DP,2) + DO i1 = LBOUND(InData%L_F_DP,1), UBOUND(InData%L_F_DP,1) + ReKiBuf(Re_Xferred) = InData%L_F_DP(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%L_F_AM) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7449,8 +7338,12 @@ SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%L_F_AM,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%L_F_AM)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%L_F_AM))-1 ) = PACK(InData%L_F_AM,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%L_F_AM) + DO i2 = LBOUND(InData%L_F_AM,2), UBOUND(InData%L_F_AM,2) + DO i1 = LBOUND(InData%L_F_AM,1), UBOUND(InData%L_F_AM,1) + ReKiBuf(Re_Xferred) = InData%L_F_AM(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%L_FV) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7465,8 +7358,12 @@ SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%L_FV,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%L_FV)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%L_FV))-1 ) = PACK(InData%L_FV,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%L_FV) + DO i2 = LBOUND(InData%L_FV,2), UBOUND(InData%L_FV,2) + DO i1 = LBOUND(InData%L_FV,1), UBOUND(InData%L_FV,1) + ReKiBuf(Re_Xferred) = InData%L_FV(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%L_FA) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7481,8 +7378,12 @@ SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%L_FA,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%L_FA)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%L_FA))-1 ) = PACK(InData%L_FA,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%L_FA) + DO i2 = LBOUND(InData%L_FA,2), UBOUND(InData%L_FA,2) + DO i1 = LBOUND(InData%L_FA,1), UBOUND(InData%L_FA,1) + ReKiBuf(Re_Xferred) = InData%L_FA(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%L_FDynP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7494,11 +7395,13 @@ SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%L_FDynP,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%L_FDynP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%L_FDynP))-1 ) = PACK(InData%L_FDynP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%L_FDynP) + DO i1 = LBOUND(InData%L_FDynP,1), UBOUND(InData%L_FDynP,1) + ReKiBuf(Re_Xferred) = InData%L_FDynP(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%LastIndWave - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%LastIndWave + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Morison_PackMisc SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -7514,12 +7417,6 @@ SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -7551,15 +7448,12 @@ SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_F_D.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%D_F_D)>0) OutData%D_F_D = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D_F_D))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D_F_D) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%D_F_D,2), UBOUND(OutData%D_F_D,2) + DO i1 = LBOUND(OutData%D_F_D,1), UBOUND(OutData%D_F_D,1) + OutData%D_F_D(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D_F_I not allocated Int_Xferred = Int_Xferred + 1 @@ -7577,15 +7471,12 @@ SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_F_I.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%D_F_I)>0) OutData%D_F_I = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D_F_I))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D_F_I) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%D_F_I,2), UBOUND(OutData%D_F_I,2) + DO i1 = LBOUND(OutData%D_F_I,1), UBOUND(OutData%D_F_I,1) + OutData%D_F_I(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D_F_B not allocated Int_Xferred = Int_Xferred + 1 @@ -7603,15 +7494,12 @@ SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_F_B.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%D_F_B)>0) OutData%D_F_B = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D_F_B))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D_F_B) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%D_F_B,2), UBOUND(OutData%D_F_B,2) + DO i1 = LBOUND(OutData%D_F_B,1), UBOUND(OutData%D_F_B,1) + OutData%D_F_B(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D_F_AM not allocated Int_Xferred = Int_Xferred + 1 @@ -7629,15 +7517,12 @@ SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_F_AM.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%D_F_AM)>0) OutData%D_F_AM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D_F_AM))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D_F_AM) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%D_F_AM,2), UBOUND(OutData%D_F_AM,2) + DO i1 = LBOUND(OutData%D_F_AM,1), UBOUND(OutData%D_F_AM,1) + OutData%D_F_AM(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D_F_AM_M not allocated Int_Xferred = Int_Xferred + 1 @@ -7655,15 +7540,12 @@ SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_F_AM_M.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%D_F_AM_M)>0) OutData%D_F_AM_M = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D_F_AM_M))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D_F_AM_M) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%D_F_AM_M,2), UBOUND(OutData%D_F_AM_M,2) + DO i1 = LBOUND(OutData%D_F_AM_M,1), UBOUND(OutData%D_F_AM_M,1) + OutData%D_F_AM_M(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D_F_AM_MG not allocated Int_Xferred = Int_Xferred + 1 @@ -7681,15 +7563,12 @@ SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_F_AM_MG.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%D_F_AM_MG)>0) OutData%D_F_AM_MG = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D_F_AM_MG))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D_F_AM_MG) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%D_F_AM_MG,2), UBOUND(OutData%D_F_AM_MG,2) + DO i1 = LBOUND(OutData%D_F_AM_MG,1), UBOUND(OutData%D_F_AM_MG,1) + OutData%D_F_AM_MG(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D_F_AM_F not allocated Int_Xferred = Int_Xferred + 1 @@ -7707,15 +7586,12 @@ SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_F_AM_F.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%D_F_AM_F)>0) OutData%D_F_AM_F = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D_F_AM_F))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D_F_AM_F) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%D_F_AM_F,2), UBOUND(OutData%D_F_AM_F,2) + DO i1 = LBOUND(OutData%D_F_AM_F,1), UBOUND(OutData%D_F_AM_F,1) + OutData%D_F_AM_F(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D_FV not allocated Int_Xferred = Int_Xferred + 1 @@ -7733,15 +7609,12 @@ SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_FV.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%D_FV)>0) OutData%D_FV = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D_FV))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D_FV) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%D_FV,2), UBOUND(OutData%D_FV,2) + DO i1 = LBOUND(OutData%D_FV,1), UBOUND(OutData%D_FV,1) + OutData%D_FV(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D_FA not allocated Int_Xferred = Int_Xferred + 1 @@ -7759,15 +7632,12 @@ SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_FA.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%D_FA)>0) OutData%D_FA = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D_FA))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D_FA) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%D_FA,2), UBOUND(OutData%D_FA,2) + DO i1 = LBOUND(OutData%D_FA,1), UBOUND(OutData%D_FA,1) + OutData%D_FA(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D_FDynP not allocated Int_Xferred = Int_Xferred + 1 @@ -7782,15 +7652,10 @@ SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_FDynP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%D_FDynP)>0) OutData%D_FDynP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D_FDynP))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D_FDynP) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%D_FDynP,1), UBOUND(OutData%D_FDynP,1) + OutData%D_FDynP(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! L_F_B not allocated Int_Xferred = Int_Xferred + 1 @@ -7808,15 +7673,12 @@ SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%L_F_B.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%L_F_B)>0) OutData%L_F_B = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%L_F_B))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%L_F_B) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%L_F_B,2), UBOUND(OutData%L_F_B,2) + DO i1 = LBOUND(OutData%L_F_B,1), UBOUND(OutData%L_F_B,1) + OutData%L_F_B(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! L_F_D not allocated Int_Xferred = Int_Xferred + 1 @@ -7834,15 +7696,12 @@ SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%L_F_D.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%L_F_D)>0) OutData%L_F_D = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%L_F_D))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%L_F_D) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%L_F_D,2), UBOUND(OutData%L_F_D,2) + DO i1 = LBOUND(OutData%L_F_D,1), UBOUND(OutData%L_F_D,1) + OutData%L_F_D(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! L_F_I not allocated Int_Xferred = Int_Xferred + 1 @@ -7860,15 +7719,12 @@ SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%L_F_I.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%L_F_I)>0) OutData%L_F_I = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%L_F_I))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%L_F_I) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%L_F_I,2), UBOUND(OutData%L_F_I,2) + DO i1 = LBOUND(OutData%L_F_I,1), UBOUND(OutData%L_F_I,1) + OutData%L_F_I(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! L_F_DP not allocated Int_Xferred = Int_Xferred + 1 @@ -7886,15 +7742,12 @@ SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%L_F_DP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%L_F_DP)>0) OutData%L_F_DP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%L_F_DP))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%L_F_DP) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%L_F_DP,2), UBOUND(OutData%L_F_DP,2) + DO i1 = LBOUND(OutData%L_F_DP,1), UBOUND(OutData%L_F_DP,1) + OutData%L_F_DP(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! L_F_AM not allocated Int_Xferred = Int_Xferred + 1 @@ -7912,15 +7765,12 @@ SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%L_F_AM.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%L_F_AM)>0) OutData%L_F_AM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%L_F_AM))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%L_F_AM) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%L_F_AM,2), UBOUND(OutData%L_F_AM,2) + DO i1 = LBOUND(OutData%L_F_AM,1), UBOUND(OutData%L_F_AM,1) + OutData%L_F_AM(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! L_FV not allocated Int_Xferred = Int_Xferred + 1 @@ -7938,15 +7788,12 @@ SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%L_FV.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%L_FV)>0) OutData%L_FV = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%L_FV))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%L_FV) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%L_FV,2), UBOUND(OutData%L_FV,2) + DO i1 = LBOUND(OutData%L_FV,1), UBOUND(OutData%L_FV,1) + OutData%L_FV(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! L_FA not allocated Int_Xferred = Int_Xferred + 1 @@ -7964,15 +7811,12 @@ SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%L_FA.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%L_FA)>0) OutData%L_FA = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%L_FA))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%L_FA) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%L_FA,2), UBOUND(OutData%L_FA,2) + DO i1 = LBOUND(OutData%L_FA,1), UBOUND(OutData%L_FA,1) + OutData%L_FA(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! L_FDynP not allocated Int_Xferred = Int_Xferred + 1 @@ -7987,18 +7831,13 @@ SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%L_FDynP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%L_FDynP)>0) OutData%L_FDynP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%L_FDynP))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%L_FDynP) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%L_FDynP,1), UBOUND(OutData%L_FDynP,1) + OutData%L_FDynP(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%LastIndWave = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%LastIndWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Morison_UnPackMisc SUBROUTINE Morison_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -8854,12 +8693,12 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NNodes - Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDens + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NNodes + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%Nodes) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -8917,8 +8756,14 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_F_I,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D_F_I)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D_F_I))-1 ) = PACK(InData%D_F_I,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D_F_I) + DO i3 = LBOUND(InData%D_F_I,3), UBOUND(InData%D_F_I,3) + DO i2 = LBOUND(InData%D_F_I,2), UBOUND(InData%D_F_I,2) + DO i1 = LBOUND(InData%D_F_I,1), UBOUND(InData%D_F_I,1) + ReKiBuf(Re_Xferred) = InData%D_F_I(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%D_F_DP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8936,8 +8781,14 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_F_DP,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D_F_DP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D_F_DP))-1 ) = PACK(InData%D_F_DP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D_F_DP) + DO i3 = LBOUND(InData%D_F_DP,3), UBOUND(InData%D_F_DP,3) + DO i2 = LBOUND(InData%D_F_DP,2), UBOUND(InData%D_F_DP,2) + DO i1 = LBOUND(InData%D_F_DP,1), UBOUND(InData%D_F_DP,1) + ReKiBuf(Re_Xferred) = InData%D_F_DP(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%D_dragConst) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8949,8 +8800,10 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_dragConst,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D_dragConst)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D_dragConst))-1 ) = PACK(InData%D_dragConst,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D_dragConst) + DO i1 = LBOUND(InData%D_dragConst,1), UBOUND(InData%D_dragConst,1) + ReKiBuf(Re_Xferred) = InData%D_dragConst(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%L_An) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8965,8 +8818,12 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%L_An,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%L_An)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%L_An))-1 ) = PACK(InData%L_An,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%L_An) + DO i2 = LBOUND(InData%L_An,2), UBOUND(InData%L_An,2) + DO i1 = LBOUND(InData%L_An,1), UBOUND(InData%L_An,1) + ReKiBuf(Re_Xferred) = InData%L_An(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%L_F_B) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8981,8 +8838,12 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%L_F_B,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%L_F_B)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%L_F_B))-1 ) = PACK(InData%L_F_B,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%L_F_B) + DO i2 = LBOUND(InData%L_F_B,2), UBOUND(InData%L_F_B,2) + DO i1 = LBOUND(InData%L_F_B,1), UBOUND(InData%L_F_B,1) + ReKiBuf(Re_Xferred) = InData%L_F_B(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%L_F_I) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -9000,8 +8861,14 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%L_F_I,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%L_F_I)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%L_F_I))-1 ) = PACK(InData%L_F_I,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%L_F_I) + DO i3 = LBOUND(InData%L_F_I,3), UBOUND(InData%L_F_I,3) + DO i2 = LBOUND(InData%L_F_I,2), UBOUND(InData%L_F_I,2) + DO i1 = LBOUND(InData%L_F_I,1), UBOUND(InData%L_F_I,1) + ReKiBuf(Re_Xferred) = InData%L_F_I(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%L_F_DP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -9019,8 +8886,14 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%L_F_DP,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%L_F_DP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%L_F_DP))-1 ) = PACK(InData%L_F_DP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%L_F_DP) + DO i3 = LBOUND(InData%L_F_DP,3), UBOUND(InData%L_F_DP,3) + DO i2 = LBOUND(InData%L_F_DP,2), UBOUND(InData%L_F_DP,2) + DO i1 = LBOUND(InData%L_F_DP,1), UBOUND(InData%L_F_DP,1) + ReKiBuf(Re_Xferred) = InData%L_F_DP(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%L_F_BF) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -9035,8 +8908,12 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%L_F_BF,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%L_F_BF)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%L_F_BF))-1 ) = PACK(InData%L_F_BF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%L_F_BF) + DO i2 = LBOUND(InData%L_F_BF,2), UBOUND(InData%L_F_BF,2) + DO i1 = LBOUND(InData%L_F_BF,1), UBOUND(InData%L_F_BF,1) + ReKiBuf(Re_Xferred) = InData%L_F_BF(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%L_AM_M) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -9054,8 +8931,14 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%L_AM_M,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%L_AM_M)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%L_AM_M))-1 ) = PACK(InData%L_AM_M,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%L_AM_M) + DO i3 = LBOUND(InData%L_AM_M,3), UBOUND(InData%L_AM_M,3) + DO i2 = LBOUND(InData%L_AM_M,2), UBOUND(InData%L_AM_M,2) + DO i1 = LBOUND(InData%L_AM_M,1), UBOUND(InData%L_AM_M,1) + ReKiBuf(Re_Xferred) = InData%L_AM_M(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%L_dragConst) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -9067,11 +8950,13 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%L_dragConst,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%L_dragConst)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%L_dragConst))-1 ) = PACK(InData%L_dragConst,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%L_dragConst) + DO i1 = LBOUND(InData%L_dragConst,1), UBOUND(InData%L_dragConst,1) + ReKiBuf(Re_Xferred) = InData%L_dragConst(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NDistribMarkers - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NDistribMarkers + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%distribToNodeIndx) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -9082,11 +8967,13 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%distribToNodeIndx,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%distribToNodeIndx)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%distribToNodeIndx))-1 ) = PACK(InData%distribToNodeIndx,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%distribToNodeIndx) + DO i1 = LBOUND(InData%distribToNodeIndx,1), UBOUND(InData%distribToNodeIndx,1) + IntKiBuf(Int_Xferred) = InData%distribToNodeIndx(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NLumpedMarkers - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NLumpedMarkers + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%lumpedToNodeIndx) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -9097,8 +8984,10 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%lumpedToNodeIndx,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%lumpedToNodeIndx)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%lumpedToNodeIndx))-1 ) = PACK(InData%lumpedToNodeIndx,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%lumpedToNodeIndx) + DO i1 = LBOUND(InData%lumpedToNodeIndx,1), UBOUND(InData%lumpedToNodeIndx,1) + IntKiBuf(Int_Xferred) = InData%lumpedToNodeIndx(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveVel) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -9116,8 +9005,14 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveVel)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveVel))-1 ) = PACK(InData%WaveVel,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveVel) + DO i3 = LBOUND(InData%WaveVel,3), UBOUND(InData%WaveVel,3) + DO i2 = LBOUND(InData%WaveVel,2), UBOUND(InData%WaveVel,2) + DO i1 = LBOUND(InData%WaveVel,1), UBOUND(InData%WaveVel,1) + ReKiBuf(Re_Xferred) = InData%WaveVel(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveAcc) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -9135,8 +9030,14 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveAcc)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveAcc))-1 ) = PACK(InData%WaveAcc,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveAcc) + DO i3 = LBOUND(InData%WaveAcc,3), UBOUND(InData%WaveAcc,3) + DO i2 = LBOUND(InData%WaveAcc,2), UBOUND(InData%WaveAcc,2) + DO i1 = LBOUND(InData%WaveAcc,1), UBOUND(InData%WaveAcc,1) + ReKiBuf(Re_Xferred) = InData%WaveAcc(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveDynP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -9151,8 +9052,12 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveDynP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveDynP))-1 ) = PACK(InData%WaveDynP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveDynP) + DO i2 = LBOUND(InData%WaveDynP,2), UBOUND(InData%WaveDynP,2) + DO i1 = LBOUND(InData%WaveDynP,1), UBOUND(InData%WaveDynP,1) + ReKiBuf(Re_Xferred) = InData%WaveDynP(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -9164,8 +9069,10 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveTime)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveTime))-1 ) = PACK(InData%WaveTime,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveTime) + DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) + ReKiBuf(Re_Xferred) = InData%WaveTime(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%elementWaterState) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -9180,8 +9087,12 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%elementWaterState,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%elementWaterState)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%elementWaterState))-1 ) = PACK(InData%elementWaterState,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%elementWaterState) + DO i2 = LBOUND(InData%elementWaterState,2), UBOUND(InData%elementWaterState,2) + DO i1 = LBOUND(InData%elementWaterState,1), UBOUND(InData%elementWaterState,1) + IntKiBuf(Int_Xferred) = InData%elementWaterState(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%elementFillState) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -9193,8 +9104,10 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%elementFillState,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%elementFillState)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%elementFillState))-1 ) = PACK(InData%elementFillState,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%elementFillState) + DO i1 = LBOUND(InData%elementFillState,1), UBOUND(InData%elementFillState,1) + IntKiBuf(Int_Xferred) = InData%elementFillState(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%nodeInWater) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -9209,8 +9122,12 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%nodeInWater,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%nodeInWater)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%nodeInWater))-1 ) = PACK(InData%nodeInWater,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%nodeInWater) + DO i2 = LBOUND(InData%nodeInWater,2), UBOUND(InData%nodeInWater,2) + DO i1 = LBOUND(InData%nodeInWater,1), UBOUND(InData%nodeInWater,1) + IntKiBuf(Int_Xferred) = InData%nodeInWater(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%D_F_B) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -9225,8 +9142,12 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_F_B,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D_F_B)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D_F_B))-1 ) = PACK(InData%D_F_B,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D_F_B) + DO i2 = LBOUND(InData%D_F_B,2), UBOUND(InData%D_F_B,2) + DO i1 = LBOUND(InData%D_F_B,1), UBOUND(InData%D_F_B,1) + ReKiBuf(Re_Xferred) = InData%D_F_B(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%D_F_BF) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -9241,8 +9162,12 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_F_BF,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D_F_BF)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D_F_BF))-1 ) = PACK(InData%D_F_BF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D_F_BF) + DO i2 = LBOUND(InData%D_F_BF,2), UBOUND(InData%D_F_BF,2) + DO i1 = LBOUND(InData%D_F_BF,1), UBOUND(InData%D_F_BF,1) + ReKiBuf(Re_Xferred) = InData%D_F_BF(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%D_F_MG) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -9257,8 +9182,12 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_F_MG,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D_F_MG)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D_F_MG))-1 ) = PACK(InData%D_F_MG,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D_F_MG) + DO i2 = LBOUND(InData%D_F_MG,2), UBOUND(InData%D_F_MG,2) + DO i1 = LBOUND(InData%D_F_MG,1), UBOUND(InData%D_F_MG,1) + ReKiBuf(Re_Xferred) = InData%D_F_MG(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%D_AM_M) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -9276,8 +9205,14 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_AM_M,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D_AM_M)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D_AM_M))-1 ) = PACK(InData%D_AM_M,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D_AM_M) + DO i3 = LBOUND(InData%D_AM_M,3), UBOUND(InData%D_AM_M,3) + DO i2 = LBOUND(InData%D_AM_M,2), UBOUND(InData%D_AM_M,2) + DO i1 = LBOUND(InData%D_AM_M,1), UBOUND(InData%D_AM_M,1) + ReKiBuf(Re_Xferred) = InData%D_AM_M(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%D_AM_MG) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -9289,8 +9224,10 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_AM_MG,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D_AM_MG)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D_AM_MG))-1 ) = PACK(InData%D_AM_MG,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D_AM_MG) + DO i1 = LBOUND(InData%D_AM_MG,1), UBOUND(InData%D_AM_MG,1) + ReKiBuf(Re_Xferred) = InData%D_AM_MG(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%D_AM_F) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -9302,13 +9239,15 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_AM_F,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D_AM_F)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D_AM_F))-1 ) = PACK(InData%D_AM_F,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D_AM_F) + DO i1 = LBOUND(InData%D_AM_F,1), UBOUND(InData%D_AM_F,1) + ReKiBuf(Re_Xferred) = InData%D_AM_F(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NMOutputs - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepWave + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NMOutputs + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%MOutLst) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -9350,8 +9289,8 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NJOutputs - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NJOutputs + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%JOutLst) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -9434,26 +9373,26 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOutAll - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%OutSwtch - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UnOutFile - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutSFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%Delim) - IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOutAll + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%OutSwtch + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%UnOutFile + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%OutFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%OutSFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%Delim) + IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE Morison_PackParam SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -9469,12 +9408,6 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -9491,12 +9424,12 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%WtrDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NNodes = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%WtrDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NNodes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Nodes not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -9572,15 +9505,14 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_F_I.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%D_F_I)>0) OutData%D_F_I = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D_F_I))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D_F_I) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%D_F_I,3), UBOUND(OutData%D_F_I,3) + DO i2 = LBOUND(OutData%D_F_I,2), UBOUND(OutData%D_F_I,2) + DO i1 = LBOUND(OutData%D_F_I,1), UBOUND(OutData%D_F_I,1) + OutData%D_F_I(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 ! D_F_DP not allocated Int_Xferred = Int_Xferred + 1 @@ -9601,15 +9533,14 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_F_DP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%D_F_DP)>0) OutData%D_F_DP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D_F_DP))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D_F_DP) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%D_F_DP,3), UBOUND(OutData%D_F_DP,3) + DO i2 = LBOUND(OutData%D_F_DP,2), UBOUND(OutData%D_F_DP,2) + DO i1 = LBOUND(OutData%D_F_DP,1), UBOUND(OutData%D_F_DP,1) + OutData%D_F_DP(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 ! D_dragConst not allocated Int_Xferred = Int_Xferred + 1 @@ -9624,15 +9555,10 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_dragConst.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%D_dragConst)>0) OutData%D_dragConst = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D_dragConst))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D_dragConst) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%D_dragConst,1), UBOUND(OutData%D_dragConst,1) + OutData%D_dragConst(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! L_An not allocated Int_Xferred = Int_Xferred + 1 @@ -9650,15 +9576,12 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%L_An.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%L_An)>0) OutData%L_An = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%L_An))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%L_An) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%L_An,2), UBOUND(OutData%L_An,2) + DO i1 = LBOUND(OutData%L_An,1), UBOUND(OutData%L_An,1) + OutData%L_An(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! L_F_B not allocated Int_Xferred = Int_Xferred + 1 @@ -9676,15 +9599,12 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%L_F_B.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%L_F_B)>0) OutData%L_F_B = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%L_F_B))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%L_F_B) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%L_F_B,2), UBOUND(OutData%L_F_B,2) + DO i1 = LBOUND(OutData%L_F_B,1), UBOUND(OutData%L_F_B,1) + OutData%L_F_B(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! L_F_I not allocated Int_Xferred = Int_Xferred + 1 @@ -9705,15 +9625,14 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%L_F_I.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%L_F_I)>0) OutData%L_F_I = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%L_F_I))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%L_F_I) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%L_F_I,3), UBOUND(OutData%L_F_I,3) + DO i2 = LBOUND(OutData%L_F_I,2), UBOUND(OutData%L_F_I,2) + DO i1 = LBOUND(OutData%L_F_I,1), UBOUND(OutData%L_F_I,1) + OutData%L_F_I(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 ! L_F_DP not allocated Int_Xferred = Int_Xferred + 1 @@ -9734,15 +9653,14 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%L_F_DP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%L_F_DP)>0) OutData%L_F_DP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%L_F_DP))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%L_F_DP) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%L_F_DP,3), UBOUND(OutData%L_F_DP,3) + DO i2 = LBOUND(OutData%L_F_DP,2), UBOUND(OutData%L_F_DP,2) + DO i1 = LBOUND(OutData%L_F_DP,1), UBOUND(OutData%L_F_DP,1) + OutData%L_F_DP(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 ! L_F_BF not allocated Int_Xferred = Int_Xferred + 1 @@ -9760,15 +9678,12 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%L_F_BF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%L_F_BF)>0) OutData%L_F_BF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%L_F_BF))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%L_F_BF) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%L_F_BF,2), UBOUND(OutData%L_F_BF,2) + DO i1 = LBOUND(OutData%L_F_BF,1), UBOUND(OutData%L_F_BF,1) + OutData%L_F_BF(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! L_AM_M not allocated Int_Xferred = Int_Xferred + 1 @@ -9789,15 +9704,14 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%L_AM_M.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%L_AM_M)>0) OutData%L_AM_M = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%L_AM_M))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%L_AM_M) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%L_AM_M,3), UBOUND(OutData%L_AM_M,3) + DO i2 = LBOUND(OutData%L_AM_M,2), UBOUND(OutData%L_AM_M,2) + DO i1 = LBOUND(OutData%L_AM_M,1), UBOUND(OutData%L_AM_M,1) + OutData%L_AM_M(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 ! L_dragConst not allocated Int_Xferred = Int_Xferred + 1 @@ -9812,18 +9726,13 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%L_dragConst.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%L_dragConst)>0) OutData%L_dragConst = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%L_dragConst))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%L_dragConst) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%L_dragConst,1), UBOUND(OutData%L_dragConst,1) + OutData%L_dragConst(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%NDistribMarkers = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NDistribMarkers = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! distribToNodeIndx not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -9837,18 +9746,13 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%distribToNodeIndx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%distribToNodeIndx)>0) OutData%distribToNodeIndx = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%distribToNodeIndx))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%distribToNodeIndx) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%distribToNodeIndx,1), UBOUND(OutData%distribToNodeIndx,1) + OutData%distribToNodeIndx(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF - OutData%NLumpedMarkers = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NLumpedMarkers = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! lumpedToNodeIndx not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -9862,15 +9766,10 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%lumpedToNodeIndx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%lumpedToNodeIndx)>0) OutData%lumpedToNodeIndx = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%lumpedToNodeIndx))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%lumpedToNodeIndx) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%lumpedToNodeIndx,1), UBOUND(OutData%lumpedToNodeIndx,1) + OutData%lumpedToNodeIndx(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel not allocated Int_Xferred = Int_Xferred + 1 @@ -9891,15 +9790,14 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%WaveVel)>0) OutData%WaveVel = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveVel))-1 ), mask3, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveVel) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%WaveVel,3), UBOUND(OutData%WaveVel,3) + DO i2 = LBOUND(OutData%WaveVel,2), UBOUND(OutData%WaveVel,2) + DO i1 = LBOUND(OutData%WaveVel,1), UBOUND(OutData%WaveVel,1) + OutData%WaveVel(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAcc not allocated Int_Xferred = Int_Xferred + 1 @@ -9920,15 +9818,14 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%WaveAcc)>0) OutData%WaveAcc = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveAcc))-1 ), mask3, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveAcc) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%WaveAcc,3), UBOUND(OutData%WaveAcc,3) + DO i2 = LBOUND(OutData%WaveAcc,2), UBOUND(OutData%WaveAcc,2) + DO i1 = LBOUND(OutData%WaveAcc,1), UBOUND(OutData%WaveAcc,1) + OutData%WaveAcc(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDynP not allocated Int_Xferred = Int_Xferred + 1 @@ -9946,15 +9843,12 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveDynP)>0) OutData%WaveDynP = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveDynP))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveDynP) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveDynP,2), UBOUND(OutData%WaveDynP,2) + DO i1 = LBOUND(OutData%WaveDynP,1), UBOUND(OutData%WaveDynP,1) + OutData%WaveDynP(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated Int_Xferred = Int_Xferred + 1 @@ -9969,15 +9863,10 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveTime)>0) OutData%WaveTime = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveTime))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveTime) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) + OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! elementWaterState not allocated Int_Xferred = Int_Xferred + 1 @@ -9995,15 +9884,12 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%elementWaterState.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%elementWaterState)>0) OutData%elementWaterState = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%elementWaterState))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%elementWaterState) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%elementWaterState,2), UBOUND(OutData%elementWaterState,2) + DO i1 = LBOUND(OutData%elementWaterState,1), UBOUND(OutData%elementWaterState,1) + OutData%elementWaterState(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! elementFillState not allocated Int_Xferred = Int_Xferred + 1 @@ -10018,15 +9904,10 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%elementFillState.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%elementFillState)>0) OutData%elementFillState = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%elementFillState))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%elementFillState) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%elementFillState,1), UBOUND(OutData%elementFillState,1) + OutData%elementFillState(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! nodeInWater not allocated Int_Xferred = Int_Xferred + 1 @@ -10044,15 +9925,12 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%nodeInWater.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%nodeInWater)>0) OutData%nodeInWater = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%nodeInWater))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%nodeInWater) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%nodeInWater,2), UBOUND(OutData%nodeInWater,2) + DO i1 = LBOUND(OutData%nodeInWater,1), UBOUND(OutData%nodeInWater,1) + OutData%nodeInWater(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D_F_B not allocated Int_Xferred = Int_Xferred + 1 @@ -10070,15 +9948,12 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_F_B.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%D_F_B)>0) OutData%D_F_B = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D_F_B))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D_F_B) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%D_F_B,2), UBOUND(OutData%D_F_B,2) + DO i1 = LBOUND(OutData%D_F_B,1), UBOUND(OutData%D_F_B,1) + OutData%D_F_B(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D_F_BF not allocated Int_Xferred = Int_Xferred + 1 @@ -10096,15 +9971,12 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_F_BF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%D_F_BF)>0) OutData%D_F_BF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D_F_BF))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D_F_BF) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%D_F_BF,2), UBOUND(OutData%D_F_BF,2) + DO i1 = LBOUND(OutData%D_F_BF,1), UBOUND(OutData%D_F_BF,1) + OutData%D_F_BF(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D_F_MG not allocated Int_Xferred = Int_Xferred + 1 @@ -10122,15 +9994,12 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_F_MG.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%D_F_MG)>0) OutData%D_F_MG = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D_F_MG))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D_F_MG) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%D_F_MG,2), UBOUND(OutData%D_F_MG,2) + DO i1 = LBOUND(OutData%D_F_MG,1), UBOUND(OutData%D_F_MG,1) + OutData%D_F_MG(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D_AM_M not allocated Int_Xferred = Int_Xferred + 1 @@ -10151,15 +10020,14 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_AM_M.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%D_AM_M)>0) OutData%D_AM_M = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D_AM_M))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D_AM_M) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%D_AM_M,3), UBOUND(OutData%D_AM_M,3) + DO i2 = LBOUND(OutData%D_AM_M,2), UBOUND(OutData%D_AM_M,2) + DO i1 = LBOUND(OutData%D_AM_M,1), UBOUND(OutData%D_AM_M,1) + OutData%D_AM_M(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 ! D_AM_MG not allocated Int_Xferred = Int_Xferred + 1 @@ -10174,15 +10042,10 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_AM_MG.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%D_AM_MG)>0) OutData%D_AM_MG = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D_AM_MG))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D_AM_MG) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%D_AM_MG,1), UBOUND(OutData%D_AM_MG,1) + OutData%D_AM_MG(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D_AM_F not allocated Int_Xferred = Int_Xferred + 1 @@ -10197,20 +10060,15 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_AM_F.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%D_AM_F)>0) OutData%D_AM_F = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D_AM_F))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D_AM_F) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%D_AM_F,1), UBOUND(OutData%D_AM_F,1) + OutData%D_AM_F(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%NStepWave = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NMOutputs = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NStepWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NMOutputs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MOutLst not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -10267,8 +10125,8 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%NJOutputs = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NJOutputs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! JOutLst not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -10381,26 +10239,26 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumOutAll = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%OutSwtch = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%UnOutFile = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutSFmt) - OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumOutAll = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%OutSwtch = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%UnOutFile = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%OutFmt) + OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%OutSFmt) + OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%Delim) + OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE Morison_UnPackParam SUBROUTINE Morison_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -10606,12 +10464,6 @@ SUBROUTINE Morison_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Morison_UnPackInput' @@ -10926,8 +10778,10 @@ SUBROUTINE Morison_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WriteOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE Morison_PackOutput @@ -10944,12 +10798,6 @@ SUBROUTINE Morison_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -11057,15 +10905,10 @@ SUBROUTINE Morison_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WriteOutput)>0) OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE Morison_UnPackOutput @@ -11144,8 +10987,8 @@ SUBROUTINE Morison_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, Err REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'Morison_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -11160,6 +11003,8 @@ SUBROUTINE Morison_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(u1%DistribMesh, u2%DistribMesh, tin, u_out%DistribMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL MeshExtrapInterp1(u1%LumpedMesh, u2%LumpedMesh, tin, u_out%LumpedMesh, tin_out, ErrStat2, ErrMsg2 ) @@ -11193,8 +11038,9 @@ SUBROUTINE Morison_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'Morison_Input_ExtrapInterp2' @@ -11216,6 +11062,8 @@ SUBROUTINE Morison_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(u1%DistribMesh, u2%DistribMesh, u3%DistribMesh, tin, u_out%DistribMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL MeshExtrapInterp2(u1%LumpedMesh, u2%LumpedMesh, u3%LumpedMesh, tin, u_out%LumpedMesh, tin_out, ErrStat2, ErrMsg2 ) @@ -11297,12 +11145,12 @@ SUBROUTINE Morison_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Er REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'Morison_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! 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 :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -11315,17 +11163,17 @@ SUBROUTINE Morison_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(y1%DistribMesh, y2%DistribMesh, tin, y_out%DistribMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL MeshExtrapInterp1(y1%LumpedMesh, y2%LumpedMesh, tin, y_out%LumpedMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END IF ! check if allocated END SUBROUTINE Morison_Output_ExtrapInterp1 @@ -11356,13 +11204,14 @@ SUBROUTINE Morison_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'Morison_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -11381,18 +11230,18 @@ SUBROUTINE Morison_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(y1%DistribMesh, y2%DistribMesh, y3%DistribMesh, tin, y_out%DistribMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL MeshExtrapInterp2(y1%LumpedMesh, y2%LumpedMesh, y3%LumpedMesh, tin, y_out%LumpedMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END IF ! check if allocated END SUBROUTINE Morison_Output_ExtrapInterp2 diff --git a/modules/hydrodyn/src/SS_Excitation_Types.f90 b/modules/hydrodyn/src/SS_Excitation_Types.f90 index d495950017..c67af350f5 100644 --- a/modules/hydrodyn/src/SS_Excitation_Types.f90 +++ b/modules/hydrodyn/src/SS_Excitation_Types.f90 @@ -237,14 +237,14 @@ SUBROUTINE SS_Exc_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WaveDir - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%InputFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + ReKiBuf(Re_Xferred) = InData%WaveDir + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepWave + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveElev0) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -255,8 +255,10 @@ SUBROUTINE SS_Exc_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev0,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElev0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElev0))-1 ) = PACK(InData%WaveElev0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElev0) + DO i1 = LBOUND(InData%WaveElev0,1), UBOUND(InData%WaveElev0,1) + ReKiBuf(Re_Xferred) = InData%WaveElev0(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -268,8 +270,10 @@ SUBROUTINE SS_Exc_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveTime)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveTime))-1 ) = PACK(InData%WaveTime,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveTime) + DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) + ReKiBuf(Re_Xferred) = InData%WaveTime(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE SS_Exc_PackInitInput @@ -286,12 +290,6 @@ SUBROUTINE SS_Exc_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -307,14 +305,14 @@ SUBROUTINE SS_Exc_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%WaveDir = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NStepWave = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%InputFile) + OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%WaveDir = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NStepWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev0 not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -328,15 +326,10 @@ SUBROUTINE SS_Exc_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveElev0)>0) OutData%WaveElev0 = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElev0))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElev0) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveElev0,1), UBOUND(OutData%WaveElev0,1) + OutData%WaveElev0(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated Int_Xferred = Int_Xferred + 1 @@ -351,15 +344,10 @@ SUBROUTINE SS_Exc_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveTime)>0) OutData%WaveTime = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveTime))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveTime) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) + OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE SS_Exc_UnPackInitInput @@ -458,17 +446,17 @@ SUBROUTINE SS_Exc_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_Xferred = 1 DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) - DO I = 1, LEN(InData%WriteOutputHdr) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdr(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 + DO I = 1, LEN(InData%WriteOutputHdr) + IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdr(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) - DO I = 1, LEN(InData%WriteOutputUnt) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUnt(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 + DO I = 1, LEN(InData%WriteOutputUnt) + IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUnt(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO END SUBROUTINE SS_Exc_PackInitOutput SUBROUTINE SS_Exc_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -484,12 +472,6 @@ SUBROUTINE SS_Exc_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -506,34 +488,20 @@ SUBROUTINE SS_Exc_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Xferred = 1 i1_l = LBOUND(OutData%WriteOutputHdr,1) i1_u = UBOUND(OutData%WriteOutputHdr,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) - DO I = 1, LEN(OutData%WriteOutputHdr) - OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - DEALLOCATE(mask1) + DO I = 1, LEN(OutData%WriteOutputHdr) + OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO i1_l = LBOUND(OutData%WriteOutputUnt,1) i1_u = UBOUND(OutData%WriteOutputUnt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) - DO I = 1, LEN(OutData%WriteOutputUnt) - OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - DEALLOCATE(mask1) + DO I = 1, LEN(OutData%WriteOutputUnt) + OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO END SUBROUTINE SS_Exc_UnPackInitOutput SUBROUTINE SS_Exc_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) @@ -656,8 +624,10 @@ SUBROUTINE SS_Exc_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%x)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%x))-1 ) = PACK(InData%x,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%x) + DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) + ReKiBuf(Re_Xferred) = InData%x(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE SS_Exc_PackContState @@ -674,12 +644,6 @@ SUBROUTINE SS_Exc_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -707,15 +671,10 @@ SUBROUTINE SS_Exc_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%x)>0) OutData%x = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%x))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%x) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) + OutData%x(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE SS_Exc_UnPackContState @@ -810,8 +769,8 @@ SUBROUTINE SS_Exc_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyDiscState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE SS_Exc_PackDiscState SUBROUTINE SS_Exc_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -827,12 +786,6 @@ SUBROUTINE SS_Exc_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_UnPackDiscState' @@ -846,8 +799,8 @@ SUBROUTINE SS_Exc_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyDiscState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyDiscState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE SS_Exc_UnPackDiscState SUBROUTINE SS_Exc_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -941,8 +894,8 @@ SUBROUTINE SS_Exc_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyConstrState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE SS_Exc_PackConstrState SUBROUTINE SS_Exc_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -958,12 +911,6 @@ SUBROUTINE SS_Exc_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_UnPackConstrState' @@ -977,8 +924,8 @@ SUBROUTINE SS_Exc_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyConstrState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyConstrState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE SS_Exc_UnPackConstrState SUBROUTINE SS_Exc_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -1101,8 +1048,8 @@ SUBROUTINE SS_Exc_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%n - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%n + Int_Xferred = Int_Xferred + 1 DO i1 = LBOUND(InData%xdot,1), UBOUND(InData%xdot,1) CALL SS_Exc_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdot(i1), ErrStat2, ErrMsg2, OnlySize ) ! xdot CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1148,12 +1095,6 @@ SUBROUTINE SS_Exc_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1168,8 +1109,8 @@ SUBROUTINE SS_Exc_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%n = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%n = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%xdot,1) i1_u = UBOUND(OutData%xdot,1) DO i1 = LBOUND(OutData%xdot,1), UBOUND(OutData%xdot,1) @@ -1307,8 +1248,8 @@ SUBROUTINE SS_Exc_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%LastIndWave - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%LastIndWave + Int_Xferred = Int_Xferred + 1 END SUBROUTINE SS_Exc_PackMisc SUBROUTINE SS_Exc_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1324,12 +1265,6 @@ SUBROUTINE SS_Exc_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_UnPackMisc' @@ -1343,8 +1278,8 @@ SUBROUTINE SS_Exc_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%LastIndWave = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%LastIndWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE SS_Exc_UnPackMisc SUBROUTINE SS_Exc_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -1552,12 +1487,14 @@ SUBROUTINE SS_Exc_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%spDOF))-1 ) = PACK(InData%spDOF,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%spDOF) + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepWave + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%spDOF,1), UBOUND(InData%spDOF,1) + IntKiBuf(Int_Xferred) = InData%spDOF(i1) + Int_Xferred = Int_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%A) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1571,8 +1508,12 @@ SUBROUTINE SS_Exc_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%A,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%A)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%A))-1 ) = PACK(InData%A,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%A) + DO i2 = LBOUND(InData%A,2), UBOUND(InData%A,2) + DO i1 = LBOUND(InData%A,1), UBOUND(InData%A,1) + ReKiBuf(Re_Xferred) = InData%A(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%B) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1584,8 +1525,10 @@ SUBROUTINE SS_Exc_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%B,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%B)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%B))-1 ) = PACK(InData%B,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%B) + DO i1 = LBOUND(InData%B,1), UBOUND(InData%B,1) + ReKiBuf(Re_Xferred) = InData%B(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%C) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1600,13 +1543,17 @@ SUBROUTINE SS_Exc_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%C)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%C))-1 ) = PACK(InData%C,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%C) + DO i2 = LBOUND(InData%C,2), UBOUND(InData%C,2) + DO i1 = LBOUND(InData%C,1), UBOUND(InData%C,1) + ReKiBuf(Re_Xferred) = InData%C(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%N - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%Tc - Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%N + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%Tc + Db_Xferred = Db_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveElev0) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1617,8 +1564,10 @@ SUBROUTINE SS_Exc_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev0,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElev0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElev0))-1 ) = PACK(InData%WaveElev0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElev0) + DO i1 = LBOUND(InData%WaveElev0,1), UBOUND(InData%WaveElev0,1) + ReKiBuf(Re_Xferred) = InData%WaveElev0(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1630,8 +1579,10 @@ SUBROUTINE SS_Exc_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveTime)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveTime))-1 ) = PACK(InData%WaveTime,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveTime) + DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) + ReKiBuf(Re_Xferred) = InData%WaveTime(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE SS_Exc_PackParam @@ -1648,12 +1599,6 @@ SUBROUTINE SS_Exc_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -1669,21 +1614,16 @@ SUBROUTINE SS_Exc_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%NStepWave = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%NStepWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%spDOF,1) i1_u = UBOUND(OutData%spDOF,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%spDOF = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%spDOF))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%spDOF) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%spDOF,1), UBOUND(OutData%spDOF,1) + OutData%spDOF(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! A not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1700,15 +1640,12 @@ SUBROUTINE SS_Exc_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%A.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%A)>0) OutData%A = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%A))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%A) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%A,2), UBOUND(OutData%A,2) + DO i1 = LBOUND(OutData%A,1), UBOUND(OutData%A,1) + OutData%A(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! B not allocated Int_Xferred = Int_Xferred + 1 @@ -1723,15 +1660,10 @@ SUBROUTINE SS_Exc_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%B.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%B)>0) OutData%B = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%B))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%B) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%B,1), UBOUND(OutData%B,1) + OutData%B(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C not allocated Int_Xferred = Int_Xferred + 1 @@ -1749,20 +1681,17 @@ SUBROUTINE SS_Exc_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%C)>0) OutData%C = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%C))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%C) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%C,2), UBOUND(OutData%C,2) + DO i1 = LBOUND(OutData%C,1), UBOUND(OutData%C,1) + OutData%C(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%N = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%Tc = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%N = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Tc = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev0 not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1776,15 +1705,10 @@ SUBROUTINE SS_Exc_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveElev0)>0) OutData%WaveElev0 = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElev0))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElev0) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveElev0,1), UBOUND(OutData%WaveElev0,1) + OutData%WaveElev0(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated Int_Xferred = Int_Xferred + 1 @@ -1799,15 +1723,10 @@ SUBROUTINE SS_Exc_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveTime)>0) OutData%WaveTime = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveTime))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveTime) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) + OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE SS_Exc_UnPackParam @@ -1902,8 +1821,8 @@ SUBROUTINE SS_Exc_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyInput - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyInput + Re_Xferred = Re_Xferred + 1 END SUBROUTINE SS_Exc_PackInput SUBROUTINE SS_Exc_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1919,12 +1838,6 @@ SUBROUTINE SS_Exc_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_UnPackInput' @@ -1938,8 +1851,8 @@ SUBROUTINE SS_Exc_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyInput = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyInput = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE SS_Exc_UnPackInput SUBROUTINE SS_Exc_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -2036,10 +1949,14 @@ SUBROUTINE SS_Exc_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%y))-1 ) = PACK(InData%y,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%y) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) + ReKiBuf(Re_Xferred) = InData%y(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE SS_Exc_PackOutput SUBROUTINE SS_Exc_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2055,12 +1972,6 @@ SUBROUTINE SS_Exc_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -2077,26 +1988,16 @@ SUBROUTINE SS_Exc_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Int_Xferred = 1 i1_l = LBOUND(OutData%y,1) i1_u = UBOUND(OutData%y,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%y = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%y))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%y) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%y,1), UBOUND(OutData%y,1) + OutData%y(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%WriteOutput,1) i1_u = UBOUND(OutData%WriteOutput,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE SS_Exc_UnPackOutput @@ -2174,8 +2075,8 @@ SUBROUTINE SS_Exc_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrM REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -2190,8 +2091,10 @@ SUBROUTINE SS_Exc_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = -(u1%DummyInput - u2%DummyInput)/t(2) - u_out%DummyInput = u1%DummyInput + b0 * t_out + + ScaleFactor = t_out / t(2) + b = -(u1%DummyInput - u2%DummyInput) + u_out%DummyInput = u1%DummyInput + b * ScaleFactor END SUBROUTINE SS_Exc_Input_ExtrapInterp1 @@ -2221,8 +2124,9 @@ SUBROUTINE SS_Exc_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_Input_ExtrapInterp2' @@ -2244,9 +2148,11 @@ SUBROUTINE SS_Exc_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = (t(3)**2*(u1%DummyInput - u2%DummyInput) + t(2)**2*(-u1%DummyInput + u3%DummyInput))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%DummyInput + t(3)*u2%DummyInput - t(2)*u3%DummyInput ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%DummyInput = u1%DummyInput + b0 * t_out + c0 * t_out**2 + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) + b = (t(3)**2*(u1%DummyInput - u2%DummyInput) + t(2)**2*(-u1%DummyInput + u3%DummyInput))* scaleFactor + c = ( (t(2)-t(3))*u1%DummyInput + t(3)*u2%DummyInput - t(2)*u3%DummyInput ) * scaleFactor + u_out%DummyInput = u1%DummyInput + b + c * t_out END SUBROUTINE SS_Exc_Input_ExtrapInterp2 @@ -2324,12 +2230,12 @@ SUBROUTINE SS_Exc_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Err REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! 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 :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -2342,18 +2248,16 @@ SUBROUTINE SS_Exc_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(b1(SIZE(y_out%y,1))) - ALLOCATE(c1(SIZE(y_out%y,1))) - b1 = -(y1%y - y2%y)/t(2) - y_out%y = y1%y + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + + ScaleFactor = t_out / t(2) + DO i1 = LBOUND(y_out%y,1),UBOUND(y_out%y,1) + b = -(y1%y(i1) - y2%y(i1)) + y_out%y(i1) = y1%y(i1) + b * ScaleFactor + END DO + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END SUBROUTINE SS_Exc_Output_ExtrapInterp1 @@ -2383,13 +2287,14 @@ SUBROUTINE SS_Exc_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -2408,20 +2313,18 @@ SUBROUTINE SS_Exc_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(b1(SIZE(y_out%y,1))) - ALLOCATE(c1(SIZE(y_out%y,1))) - b1 = (t(3)**2*(y1%y - y2%y) + t(2)**2*(-y1%y + y3%y))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%y + t(3)*y2%y - t(2)*y3%y ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%y = y1%y + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) + DO i1 = LBOUND(y_out%y,1),UBOUND(y_out%y,1) + b = (t(3)**2*(y1%y(i1) - y2%y(i1)) + t(2)**2*(-y1%y(i1) + y3%y(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%y(i1) + t(3)*y2%y(i1) - t(2)*y3%y(i1) ) * scaleFactor + y_out%y(i1) = y1%y(i1) + b + c * t_out + END DO + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END SUBROUTINE SS_Exc_Output_ExtrapInterp2 END MODULE SS_Excitation_Types diff --git a/modules/hydrodyn/src/SS_Radiation_Types.f90 b/modules/hydrodyn/src/SS_Radiation_Types.f90 index b61a5c4ac6..b792dc812f 100644 --- a/modules/hydrodyn/src/SS_Radiation_Types.f90 +++ b/modules/hydrodyn/src/SS_Radiation_Types.f90 @@ -188,12 +188,16 @@ SUBROUTINE SS_Rad_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DOFs))-1 ) = PACK(InData%DOFs,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DOFs) + DO I = 1, LEN(InData%InputFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO i2 = LBOUND(InData%DOFs,2), UBOUND(InData%DOFs,2) + DO i1 = LBOUND(InData%DOFs,1), UBOUND(InData%DOFs,1) + ReKiBuf(Re_Xferred) = InData%DOFs(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END SUBROUTINE SS_Rad_PackInitInput SUBROUTINE SS_Rad_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -209,12 +213,6 @@ SUBROUTINE SS_Rad_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -230,23 +228,20 @@ SUBROUTINE SS_Rad_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%InputFile) + OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I i1_l = LBOUND(OutData%DOFs,1) i1_u = UBOUND(OutData%DOFs,1) i2_l = LBOUND(OutData%DOFs,2) i2_u = UBOUND(OutData%DOFs,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%DOFs = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DOFs))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DOFs) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%DOFs,2), UBOUND(OutData%DOFs,2) + DO i1 = LBOUND(OutData%DOFs,1), UBOUND(OutData%DOFs,1) + OutData%DOFs(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END SUBROUTINE SS_Rad_UnPackInitInput SUBROUTINE SS_Rad_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -344,17 +339,17 @@ SUBROUTINE SS_Rad_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_Xferred = 1 DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) - DO I = 1, LEN(InData%WriteOutputHdr) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdr(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 + DO I = 1, LEN(InData%WriteOutputHdr) + IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdr(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) - DO I = 1, LEN(InData%WriteOutputUnt) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUnt(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 + DO I = 1, LEN(InData%WriteOutputUnt) + IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUnt(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO END SUBROUTINE SS_Rad_PackInitOutput SUBROUTINE SS_Rad_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -370,12 +365,6 @@ SUBROUTINE SS_Rad_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -392,34 +381,20 @@ SUBROUTINE SS_Rad_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Xferred = 1 i1_l = LBOUND(OutData%WriteOutputHdr,1) i1_u = UBOUND(OutData%WriteOutputHdr,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) - DO I = 1, LEN(OutData%WriteOutputHdr) - OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - DEALLOCATE(mask1) + DO I = 1, LEN(OutData%WriteOutputHdr) + OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO i1_l = LBOUND(OutData%WriteOutputUnt,1) i1_u = UBOUND(OutData%WriteOutputUnt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) - DO I = 1, LEN(OutData%WriteOutputUnt) - OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - DEALLOCATE(mask1) + DO I = 1, LEN(OutData%WriteOutputUnt) + OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO END SUBROUTINE SS_Rad_UnPackInitOutput SUBROUTINE SS_Rad_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) @@ -542,8 +517,10 @@ SUBROUTINE SS_Rad_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%x)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%x))-1 ) = PACK(InData%x,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%x) + DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) + ReKiBuf(Re_Xferred) = InData%x(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE SS_Rad_PackContState @@ -560,12 +537,6 @@ SUBROUTINE SS_Rad_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -593,15 +564,10 @@ SUBROUTINE SS_Rad_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%x)>0) OutData%x = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%x))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%x) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) + OutData%x(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE SS_Rad_UnPackContState @@ -696,8 +662,8 @@ SUBROUTINE SS_Rad_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyDiscState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE SS_Rad_PackDiscState SUBROUTINE SS_Rad_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -713,12 +679,6 @@ SUBROUTINE SS_Rad_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_UnPackDiscState' @@ -732,8 +692,8 @@ SUBROUTINE SS_Rad_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyDiscState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyDiscState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE SS_Rad_UnPackDiscState SUBROUTINE SS_Rad_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -827,8 +787,8 @@ SUBROUTINE SS_Rad_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyConstrState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE SS_Rad_PackConstrState SUBROUTINE SS_Rad_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -844,12 +804,6 @@ SUBROUTINE SS_Rad_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_UnPackConstrState' @@ -863,8 +817,8 @@ SUBROUTINE SS_Rad_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyConstrState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyConstrState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE SS_Rad_UnPackConstrState SUBROUTINE SS_Rad_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -987,8 +941,8 @@ SUBROUTINE SS_Rad_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%n - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%n + Int_Xferred = Int_Xferred + 1 DO i1 = LBOUND(InData%xdot,1), UBOUND(InData%xdot,1) CALL SS_Rad_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdot(i1), ErrStat2, ErrMsg2, OnlySize ) ! xdot CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1034,12 +988,6 @@ SUBROUTINE SS_Rad_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1054,8 +1002,8 @@ SUBROUTINE SS_Rad_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%n = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%n = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%xdot,1) i1_u = UBOUND(OutData%xdot,1) DO i1 = LBOUND(OutData%xdot,1), UBOUND(OutData%xdot,1) @@ -1193,8 +1141,8 @@ SUBROUTINE SS_Rad_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyMiscVar - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyMiscVar + Re_Xferred = Re_Xferred + 1 END SUBROUTINE SS_Rad_PackMisc SUBROUTINE SS_Rad_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1210,12 +1158,6 @@ SUBROUTINE SS_Rad_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_UnPackMisc' @@ -1229,8 +1171,8 @@ SUBROUTINE SS_Rad_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyMiscVar = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyMiscVar = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE SS_Rad_UnPackMisc SUBROUTINE SS_Rad_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -1396,8 +1338,8 @@ SUBROUTINE SS_Rad_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 IF ( .NOT. ALLOCATED(InData%A) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1411,8 +1353,12 @@ SUBROUTINE SS_Rad_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%A,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%A)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%A))-1 ) = PACK(InData%A,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%A) + DO i2 = LBOUND(InData%A,2), UBOUND(InData%A,2) + DO i1 = LBOUND(InData%A,1), UBOUND(InData%A,1) + ReKiBuf(Re_Xferred) = InData%A(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%B) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1427,8 +1373,12 @@ SUBROUTINE SS_Rad_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%B,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%B)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%B))-1 ) = PACK(InData%B,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%B) + DO i2 = LBOUND(InData%B,2), UBOUND(InData%B,2) + DO i1 = LBOUND(InData%B,1), UBOUND(InData%B,1) + ReKiBuf(Re_Xferred) = InData%B(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%C) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1443,13 +1393,19 @@ SUBROUTINE SS_Rad_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%C)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%C))-1 ) = PACK(InData%C,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%C) + DO i2 = LBOUND(InData%C,2), UBOUND(InData%C,2) + DO i1 = LBOUND(InData%C,1), UBOUND(InData%C,1) + ReKiBuf(Re_Xferred) = InData%C(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%N - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%spdof))-1 ) = PACK(InData%spdof,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%spdof) + IntKiBuf(Int_Xferred) = InData%N + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%spdof,1), UBOUND(InData%spdof,1) + IntKiBuf(Int_Xferred) = InData%spdof(i1) + Int_Xferred = Int_Xferred + 1 + END DO END SUBROUTINE SS_Rad_PackParam SUBROUTINE SS_Rad_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1465,12 +1421,6 @@ SUBROUTINE SS_Rad_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -1486,8 +1436,8 @@ SUBROUTINE SS_Rad_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! A not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1504,15 +1454,12 @@ SUBROUTINE SS_Rad_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%A.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%A)>0) OutData%A = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%A))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%A) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%A,2), UBOUND(OutData%A,2) + DO i1 = LBOUND(OutData%A,1), UBOUND(OutData%A,1) + OutData%A(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! B not allocated Int_Xferred = Int_Xferred + 1 @@ -1530,15 +1477,12 @@ SUBROUTINE SS_Rad_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%B.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%B)>0) OutData%B = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%B))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%B) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%B,2), UBOUND(OutData%B,2) + DO i1 = LBOUND(OutData%B,1), UBOUND(OutData%B,1) + OutData%B(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C not allocated Int_Xferred = Int_Xferred + 1 @@ -1556,29 +1500,21 @@ SUBROUTINE SS_Rad_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%C)>0) OutData%C = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%C))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%C) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%C,2), UBOUND(OutData%C,2) + DO i1 = LBOUND(OutData%C,1), UBOUND(OutData%C,1) + OutData%C(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%N = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%N = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%spdof,1) i1_u = UBOUND(OutData%spdof,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%spdof = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%spdof))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%spdof) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%spdof,1), UBOUND(OutData%spdof,1) + OutData%spdof(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END SUBROUTINE SS_Rad_UnPackParam SUBROUTINE SS_Rad_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -1673,8 +1609,10 @@ SUBROUTINE SS_Rad_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%dq))-1 ) = PACK(InData%dq,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%dq) + DO i1 = LBOUND(InData%dq,1), UBOUND(InData%dq,1) + ReKiBuf(Re_Xferred) = InData%dq(i1) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE SS_Rad_PackInput SUBROUTINE SS_Rad_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1690,12 +1628,6 @@ SUBROUTINE SS_Rad_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1712,15 +1644,10 @@ SUBROUTINE SS_Rad_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Int_Xferred = 1 i1_l = LBOUND(OutData%dq,1) i1_u = UBOUND(OutData%dq,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%dq = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%dq))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%dq) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%dq,1), UBOUND(OutData%dq,1) + OutData%dq(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE SS_Rad_UnPackInput SUBROUTINE SS_Rad_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -1817,10 +1744,14 @@ SUBROUTINE SS_Rad_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%y))-1 ) = PACK(InData%y,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%y) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) + ReKiBuf(Re_Xferred) = InData%y(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE SS_Rad_PackOutput SUBROUTINE SS_Rad_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1836,12 +1767,6 @@ SUBROUTINE SS_Rad_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1858,26 +1783,16 @@ SUBROUTINE SS_Rad_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Int_Xferred = 1 i1_l = LBOUND(OutData%y,1) i1_u = UBOUND(OutData%y,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%y = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%y))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%y) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%y,1), UBOUND(OutData%y,1) + OutData%y(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%WriteOutput,1) i1_u = UBOUND(OutData%WriteOutput,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE SS_Rad_UnPackOutput @@ -1955,12 +1870,12 @@ SUBROUTINE SS_Rad_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrM REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! 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 :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -1973,12 +1888,12 @@ SUBROUTINE SS_Rad_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(b1(SIZE(u_out%dq,1))) - ALLOCATE(c1(SIZE(u_out%dq,1))) - b1 = -(u1%dq - u2%dq)/t(2) - u_out%dq = u1%dq + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + + ScaleFactor = t_out / t(2) + DO i1 = LBOUND(u_out%dq,1),UBOUND(u_out%dq,1) + b = -(u1%dq(i1) - u2%dq(i1)) + u_out%dq(i1) = u1%dq(i1) + b * ScaleFactor + END DO END SUBROUTINE SS_Rad_Input_ExtrapInterp1 @@ -2008,13 +1923,14 @@ SUBROUTINE SS_Rad_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -2033,13 +1949,13 @@ SUBROUTINE SS_Rad_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(b1(SIZE(u_out%dq,1))) - ALLOCATE(c1(SIZE(u_out%dq,1))) - b1 = (t(3)**2*(u1%dq - u2%dq) + t(2)**2*(-u1%dq + u3%dq))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%dq + t(3)*u2%dq - t(2)*u3%dq ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%dq = u1%dq + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) + DO i1 = LBOUND(u_out%dq,1),UBOUND(u_out%dq,1) + b = (t(3)**2*(u1%dq(i1) - u2%dq(i1)) + t(2)**2*(-u1%dq(i1) + u3%dq(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%dq(i1) + t(3)*u2%dq(i1) - t(2)*u3%dq(i1) ) * scaleFactor + u_out%dq(i1) = u1%dq(i1) + b + c * t_out + END DO END SUBROUTINE SS_Rad_Input_ExtrapInterp2 @@ -2117,12 +2033,12 @@ SUBROUTINE SS_Rad_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Err REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! 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 :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -2135,18 +2051,16 @@ SUBROUTINE SS_Rad_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(b1(SIZE(y_out%y,1))) - ALLOCATE(c1(SIZE(y_out%y,1))) - b1 = -(y1%y - y2%y)/t(2) - y_out%y = y1%y + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + + ScaleFactor = t_out / t(2) + DO i1 = LBOUND(y_out%y,1),UBOUND(y_out%y,1) + b = -(y1%y(i1) - y2%y(i1)) + y_out%y(i1) = y1%y(i1) + b * ScaleFactor + END DO + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END SUBROUTINE SS_Rad_Output_ExtrapInterp1 @@ -2176,13 +2090,14 @@ SUBROUTINE SS_Rad_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -2201,20 +2116,18 @@ SUBROUTINE SS_Rad_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(b1(SIZE(y_out%y,1))) - ALLOCATE(c1(SIZE(y_out%y,1))) - b1 = (t(3)**2*(y1%y - y2%y) + t(2)**2*(-y1%y + y3%y))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%y + t(3)*y2%y - t(2)*y3%y ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%y = y1%y + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) + DO i1 = LBOUND(y_out%y,1),UBOUND(y_out%y,1) + b = (t(3)**2*(y1%y(i1) - y2%y(i1)) + t(2)**2*(-y1%y(i1) + y3%y(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%y(i1) + t(3)*y2%y(i1) - t(2)*y3%y(i1) ) * scaleFactor + y_out%y(i1) = y1%y(i1) + b + c * t_out + END DO + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END SUBROUTINE SS_Rad_Output_ExtrapInterp2 END MODULE SS_Radiation_Types diff --git a/modules/hydrodyn/src/WAMIT2_Types.f90 b/modules/hydrodyn/src/WAMIT2_Types.f90 index 6ad1409a2f..97724dd0a9 100644 --- a/modules/hydrodyn/src/WAMIT2_Types.f90 +++ b/modules/hydrodyn/src/WAMIT2_Types.f90 @@ -375,26 +375,26 @@ SUBROUTINE WAMIT2_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%HasWAMIT , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%WAMITFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%WAMITFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UnSum - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WAMITULEN - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RhoXg - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepWave2 - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WaveDOmega - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%HasWAMIT, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%WAMITFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%WAMITFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%UnSum + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WAMITULEN + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RhoXg + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepWave + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepWave2 + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WaveDOmega + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDens + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveElevC0) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -408,13 +408,17 @@ SUBROUTINE WAMIT2_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC0,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElevC0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElevC0))-1 ) = PACK(InData%WaveElevC0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElevC0) + DO i2 = LBOUND(InData%WaveElevC0,2), UBOUND(InData%WaveElevC0,2) + DO i1 = LBOUND(InData%WaveElevC0,1), UBOUND(InData%WaveElevC0,1) + ReKiBuf(Re_Xferred) = InData%WaveElevC0(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WaveDir - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%WaveMultiDir , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WaveDir + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%WaveMultiDir, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveDirArr) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -425,13 +429,15 @@ SUBROUTINE WAMIT2_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDirArr,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveDirArr)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveDirArr))-1 ) = PACK(InData%WaveDirArr,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveDirArr) + DO i1 = LBOUND(InData%WaveDirArr,1), UBOUND(InData%WaveDirArr,1) + ReKiBuf(Re_Xferred) = InData%WaveDirArr(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WaveDirMin - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WaveDirMax - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WaveDirMin + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WaveDirMax + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -442,63 +448,65 @@ SUBROUTINE WAMIT2_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveTime)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveTime))-1 ) = PACK(InData%WaveTime,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveTime) + DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) + ReKiBuf(Re_Xferred) = InData%WaveTime(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) - DO I = 1, LEN(InData%OutList) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%OutAll , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOutAll - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WaveMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmSgF2 , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmSwF2 , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmHvF2 , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmRF2 , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmPF2 , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmYF2 , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MnDrift - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NewmanApp - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DiffQTF - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%SumQTF - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%MnDriftF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%NewmanAppF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%DiffQTFF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%SumQTFF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WvLowCOff - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WvHiCOff - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WvLowCOffD - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WvHiCOffD - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WvLowCOffS - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WvHiCOffS - Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(InData%OutList) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + IntKiBuf(Int_Xferred) = TRANSFER(InData%OutAll, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOutAll + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WaveMod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmSgF2, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmSwF2, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmHvF2, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmRF2, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmPF2, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmYF2, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MnDrift + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NewmanApp + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DiffQTF + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%SumQTF + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%MnDriftF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%NewmanAppF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%DiffQTFF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%SumQTFF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WvLowCOff + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WvHiCOff + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WvLowCOffD + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WvHiCOffD + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WvLowCOffS + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WvHiCOffS + Re_Xferred = Re_Xferred + 1 END SUBROUTINE WAMIT2_PackInitInput SUBROUTINE WAMIT2_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -514,12 +522,6 @@ SUBROUTINE WAMIT2_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -535,26 +537,26 @@ SUBROUTINE WAMIT2_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%HasWAMIT = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%WAMITFile) - OutData%WAMITFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%UnSum = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%WAMITULEN = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RhoXg = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NStepWave = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NStepWave2 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%WaveDOmega = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%HasWAMIT = TRANSFER(IntKiBuf(Int_Xferred), OutData%HasWAMIT) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%WAMITFile) + OutData%WAMITFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%UnSum = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WAMITULEN = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RhoXg = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NStepWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NStepWave2 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WaveDOmega = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WtrDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevC0 not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -571,20 +573,17 @@ SUBROUTINE WAMIT2_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveElevC0)>0) OutData%WaveElevC0 = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElevC0))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElevC0) - DEALLOCATE(mask2) - END IF - OutData%WaveDir = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveMultiDir = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(OutData%WaveElevC0,2), UBOUND(OutData%WaveElevC0,2) + DO i1 = LBOUND(OutData%WaveElevC0,1), UBOUND(OutData%WaveElevC0,1) + OutData%WaveElevC0(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%WaveDir = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WaveMultiDir = TRANSFER(IntKiBuf(Int_Xferred), OutData%WaveMultiDir) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDirArr not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -598,20 +597,15 @@ SUBROUTINE WAMIT2_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDirArr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveDirArr)>0) OutData%WaveDirArr = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveDirArr))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveDirArr) - DEALLOCATE(mask1) - END IF - OutData%WaveDirMin = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveDirMax = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%WaveDirArr,1), UBOUND(OutData%WaveDirArr,1) + OutData%WaveDirArr(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%WaveDirMin = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WaveDirMax = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -625,79 +619,67 @@ SUBROUTINE WAMIT2_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveTime)>0) OutData%WaveTime = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveTime))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveTime) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) + OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF i1_l = LBOUND(OutData%OutList,1) i1_u = UBOUND(OutData%OutList,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) - DO I = 1, LEN(OutData%OutList) - OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - DEALLOCATE(mask1) - OutData%OutAll = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumOutAll = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%WaveMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmSgF2 = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmSwF2 = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmHvF2 = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmRF2 = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmPF2 = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmYF2 = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%MnDrift = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NewmanApp = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%DiffQTF = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%SumQTF = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%MnDriftF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NewmanAppF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%DiffQTFF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%SumQTFF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%WvLowCOff = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WvHiCOff = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WvLowCOffD = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WvHiCOffD = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WvLowCOffS = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WvHiCOffS = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(OutData%OutList) + OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + OutData%OutAll = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutAll) + Int_Xferred = Int_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumOutAll = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WaveMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%PtfmSgF2 = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmSgF2) + Int_Xferred = Int_Xferred + 1 + OutData%PtfmSwF2 = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmSwF2) + Int_Xferred = Int_Xferred + 1 + OutData%PtfmHvF2 = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmHvF2) + Int_Xferred = Int_Xferred + 1 + OutData%PtfmRF2 = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmRF2) + Int_Xferred = Int_Xferred + 1 + OutData%PtfmPF2 = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmPF2) + Int_Xferred = Int_Xferred + 1 + OutData%PtfmYF2 = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmYF2) + Int_Xferred = Int_Xferred + 1 + OutData%MnDrift = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NewmanApp = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%DiffQTF = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%SumQTF = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%MnDriftF = TRANSFER(IntKiBuf(Int_Xferred), OutData%MnDriftF) + Int_Xferred = Int_Xferred + 1 + OutData%NewmanAppF = TRANSFER(IntKiBuf(Int_Xferred), OutData%NewmanAppF) + Int_Xferred = Int_Xferred + 1 + OutData%DiffQTFF = TRANSFER(IntKiBuf(Int_Xferred), OutData%DiffQTFF) + Int_Xferred = Int_Xferred + 1 + OutData%SumQTFF = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumQTFF) + Int_Xferred = Int_Xferred + 1 + OutData%WvLowCOff = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WvHiCOff = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WvLowCOffD = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WvHiCOffD = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WvLowCOffS = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WvHiCOffS = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE WAMIT2_UnPackInitInput SUBROUTINE WAMIT2_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -840,12 +822,12 @@ SUBROUTINE WAMIT2_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) + DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) DO I = 1, LEN(InData%WriteOutputHdr) IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdr(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -857,12 +839,12 @@ SUBROUTINE WAMIT2_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) + DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) DO I = 1, LEN(InData%WriteOutputUnt) IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUnt(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF END SUBROUTINE WAMIT2_PackInitOutput @@ -879,12 +861,6 @@ SUBROUTINE WAMIT2_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -912,19 +888,12 @@ SUBROUTINE WAMIT2_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) DO I = 1, LEN(OutData%WriteOutputHdr) OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated Int_Xferred = Int_Xferred + 1 @@ -939,19 +908,12 @@ SUBROUTINE WAMIT2_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) DO I = 1, LEN(OutData%WriteOutputUnt) OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF END SUBROUTINE WAMIT2_UnPackInitOutput @@ -1046,8 +1008,8 @@ SUBROUTINE WAMIT2_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyContState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyContState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE WAMIT2_PackContState SUBROUTINE WAMIT2_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1063,12 +1025,6 @@ SUBROUTINE WAMIT2_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_UnPackContState' @@ -1082,8 +1038,8 @@ SUBROUTINE WAMIT2_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyContState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyContState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE WAMIT2_UnPackContState SUBROUTINE WAMIT2_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) @@ -1177,8 +1133,8 @@ SUBROUTINE WAMIT2_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyDiscState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE WAMIT2_PackDiscState SUBROUTINE WAMIT2_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1194,12 +1150,6 @@ SUBROUTINE WAMIT2_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_UnPackDiscState' @@ -1213,8 +1163,8 @@ SUBROUTINE WAMIT2_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyDiscState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyDiscState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE WAMIT2_UnPackDiscState SUBROUTINE WAMIT2_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -1308,8 +1258,8 @@ SUBROUTINE WAMIT2_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyConstrState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE WAMIT2_PackConstrState SUBROUTINE WAMIT2_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1325,12 +1275,6 @@ SUBROUTINE WAMIT2_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_UnPackConstrState' @@ -1344,8 +1288,8 @@ SUBROUTINE WAMIT2_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyConstrState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyConstrState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE WAMIT2_UnPackConstrState SUBROUTINE WAMIT2_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -1439,8 +1383,8 @@ SUBROUTINE WAMIT2_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DummyOtherState - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DummyOtherState + Int_Xferred = Int_Xferred + 1 END SUBROUTINE WAMIT2_PackOtherState SUBROUTINE WAMIT2_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1456,12 +1400,6 @@ SUBROUTINE WAMIT2_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_UnPackOtherState' @@ -1475,8 +1413,8 @@ SUBROUTINE WAMIT2_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyOtherState = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%DummyOtherState = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE WAMIT2_UnPackOtherState SUBROUTINE WAMIT2_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -1573,10 +1511,12 @@ SUBROUTINE WAMIT2_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%LastIndWave - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_Waves2))-1 ) = PACK(InData%F_Waves2,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_Waves2) + IntKiBuf(Int_Xferred) = InData%LastIndWave + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%F_Waves2,1), UBOUND(InData%F_Waves2,1) + ReKiBuf(Re_Xferred) = InData%F_Waves2(i1) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE WAMIT2_PackMisc SUBROUTINE WAMIT2_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1592,12 +1532,6 @@ SUBROUTINE WAMIT2_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1612,19 +1546,14 @@ SUBROUTINE WAMIT2_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%LastIndWave = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%LastIndWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%F_Waves2,1) i1_u = UBOUND(OutData%F_Waves2,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%F_Waves2 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_Waves2))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_Waves2) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%F_Waves2,1), UBOUND(OutData%F_Waves2,1) + OutData%F_Waves2(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE WAMIT2_UnPackMisc SUBROUTINE WAMIT2_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -1848,13 +1777,15 @@ SUBROUTINE WAMIT2_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveTime)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveTime))-1 ) = PACK(InData%WaveTime,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveTime) + DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) + ReKiBuf(Re_Xferred) = InData%WaveTime(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepWave + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveExctn2) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1868,25 +1799,37 @@ SUBROUTINE WAMIT2_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveExctn2,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveExctn2)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveExctn2))-1 ) = PACK(InData%WaveExctn2,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveExctn2) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%MnDriftDims)-1 ) = TRANSFER(PACK( InData%MnDriftDims ,.TRUE.), IntKiBuf(1), SIZE(InData%MnDriftDims)) - Int_Xferred = Int_Xferred + SIZE(InData%MnDriftDims) - IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%NewmanAppDims)-1 ) = TRANSFER(PACK( InData%NewmanAppDims ,.TRUE.), IntKiBuf(1), SIZE(InData%NewmanAppDims)) - Int_Xferred = Int_Xferred + SIZE(InData%NewmanAppDims) - IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%DiffQTFDims)-1 ) = TRANSFER(PACK( InData%DiffQTFDims ,.TRUE.), IntKiBuf(1), SIZE(InData%DiffQTFDims)) - Int_Xferred = Int_Xferred + SIZE(InData%DiffQTFDims) - IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%SumQTFDims)-1 ) = TRANSFER(PACK( InData%SumQTFDims ,.TRUE.), IntKiBuf(1), SIZE(InData%SumQTFDims)) - Int_Xferred = Int_Xferred + SIZE(InData%SumQTFDims) - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%MnDriftF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%NewmanAppF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%DiffQTFF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%SumQTFF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(InData%WaveExctn2,2), UBOUND(InData%WaveExctn2,2) + DO i1 = LBOUND(InData%WaveExctn2,1), UBOUND(InData%WaveExctn2,1) + ReKiBuf(Re_Xferred) = InData%WaveExctn2(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + DO i1 = LBOUND(InData%MnDriftDims,1), UBOUND(InData%MnDriftDims,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%MnDriftDims(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + DO i1 = LBOUND(InData%NewmanAppDims,1), UBOUND(InData%NewmanAppDims,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%NewmanAppDims(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + DO i1 = LBOUND(InData%DiffQTFDims,1), UBOUND(InData%DiffQTFDims,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%DiffQTFDims(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + DO i1 = LBOUND(InData%SumQTFDims,1), UBOUND(InData%SumQTFDims,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%SumQTFDims(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = TRANSFER(InData%MnDriftF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%NewmanAppF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%DiffQTFF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%SumQTFF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1928,24 +1871,24 @@ SUBROUTINE WAMIT2_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOutAll - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutSFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%Delim) - IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UnOutFile - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOutAll + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%OutFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%OutSFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%Delim) + IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%UnOutFile + Int_Xferred = Int_Xferred + 1 END SUBROUTINE WAMIT2_PackParam SUBROUTINE WAMIT2_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1961,12 +1904,6 @@ SUBROUTINE WAMIT2_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -1995,20 +1932,15 @@ SUBROUTINE WAMIT2_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveTime)>0) OutData%WaveTime = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveTime))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveTime) - DEALLOCATE(mask1) - END IF - OutData%NStepWave = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) + OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%NStepWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveExctn2 not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2025,68 +1957,45 @@ SUBROUTINE WAMIT2_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveExctn2.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveExctn2)>0) OutData%WaveExctn2 = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveExctn2))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveExctn2) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveExctn2,2), UBOUND(OutData%WaveExctn2,2) + DO i1 = LBOUND(OutData%WaveExctn2,1), UBOUND(OutData%WaveExctn2,1) + OutData%WaveExctn2(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF i1_l = LBOUND(OutData%MnDriftDims,1) i1_u = UBOUND(OutData%MnDriftDims,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%MnDriftDims = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%MnDriftDims))-1 ), OutData%MnDriftDims), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%MnDriftDims) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%MnDriftDims,1), UBOUND(OutData%MnDriftDims,1) + OutData%MnDriftDims(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%MnDriftDims(i1)) + Int_Xferred = Int_Xferred + 1 + END DO i1_l = LBOUND(OutData%NewmanAppDims,1) i1_u = UBOUND(OutData%NewmanAppDims,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%NewmanAppDims = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%NewmanAppDims))-1 ), OutData%NewmanAppDims), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%NewmanAppDims) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%NewmanAppDims,1), UBOUND(OutData%NewmanAppDims,1) + OutData%NewmanAppDims(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%NewmanAppDims(i1)) + Int_Xferred = Int_Xferred + 1 + END DO i1_l = LBOUND(OutData%DiffQTFDims,1) i1_u = UBOUND(OutData%DiffQTFDims,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%DiffQTFDims = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%DiffQTFDims))-1 ), OutData%DiffQTFDims), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%DiffQTFDims) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%DiffQTFDims,1), UBOUND(OutData%DiffQTFDims,1) + OutData%DiffQTFDims(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%DiffQTFDims(i1)) + Int_Xferred = Int_Xferred + 1 + END DO i1_l = LBOUND(OutData%SumQTFDims,1) i1_u = UBOUND(OutData%SumQTFDims,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%SumQTFDims = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%SumQTFDims))-1 ), OutData%SumQTFDims), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%SumQTFDims) - DEALLOCATE(mask1) - OutData%MnDriftF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NewmanAppF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%DiffQTFF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%SumQTFF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%SumQTFDims,1), UBOUND(OutData%SumQTFDims,1) + OutData%SumQTFDims(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumQTFDims(i1)) + Int_Xferred = Int_Xferred + 1 + END DO + OutData%MnDriftF = TRANSFER(IntKiBuf(Int_Xferred), OutData%MnDriftF) + Int_Xferred = Int_Xferred + 1 + OutData%NewmanAppF = TRANSFER(IntKiBuf(Int_Xferred), OutData%NewmanAppF) + Int_Xferred = Int_Xferred + 1 + OutData%DiffQTFF = TRANSFER(IntKiBuf(Int_Xferred), OutData%DiffQTFF) + Int_Xferred = Int_Xferred + 1 + OutData%SumQTFF = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumQTFF) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2143,24 +2052,24 @@ SUBROUTINE WAMIT2_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumOutAll = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutSFmt) - OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%UnOutFile = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumOutAll = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%OutFmt) + OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%OutSFmt) + OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%Delim) + OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%UnOutFile = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE WAMIT2_UnPackParam SUBROUTINE WAMIT2_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -2317,12 +2226,6 @@ SUBROUTINE WAMIT2_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_UnPackInput' @@ -2548,8 +2451,10 @@ SUBROUTINE WAMIT2_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WriteOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE WAMIT2_PackOutput @@ -2566,12 +2471,6 @@ SUBROUTINE WAMIT2_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -2639,15 +2538,10 @@ SUBROUTINE WAMIT2_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WriteOutput)>0) OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE WAMIT2_UnPackOutput @@ -2726,8 +2620,8 @@ SUBROUTINE WAMIT2_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrM REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -2742,6 +2636,8 @@ SUBROUTINE WAMIT2_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(u1%Mesh, u2%Mesh, tin, u_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE WAMIT2_Input_ExtrapInterp1 @@ -2773,8 +2669,9 @@ SUBROUTINE WAMIT2_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_Input_ExtrapInterp2' @@ -2796,6 +2693,8 @@ SUBROUTINE WAMIT2_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(u1%Mesh, u2%Mesh, u3%Mesh, tin, u_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE WAMIT2_Input_ExtrapInterp2 @@ -2875,12 +2774,12 @@ SUBROUTINE WAMIT2_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Err REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! 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 :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -2893,15 +2792,15 @@ SUBROUTINE WAMIT2_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(y1%Mesh, y2%Mesh, tin, y_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END IF ! check if allocated END SUBROUTINE WAMIT2_Output_ExtrapInterp1 @@ -2932,13 +2831,14 @@ SUBROUTINE WAMIT2_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -2957,16 +2857,16 @@ SUBROUTINE WAMIT2_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(y1%Mesh, y2%Mesh, y3%Mesh, tin, y_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END IF ! check if allocated END SUBROUTINE WAMIT2_Output_ExtrapInterp2 diff --git a/modules/hydrodyn/src/WAMIT_Types.f90 b/modules/hydrodyn/src/WAMIT_Types.f90 index 48f084d1f4..eeac9d4036 100644 --- a/modules/hydrodyn/src/WAMIT_Types.f90 +++ b/modules/hydrodyn/src/WAMIT_Types.f90 @@ -402,28 +402,28 @@ SUBROUTINE WAMIT_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmVol0 - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%HasWAMIT , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WAMITULEN - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmCOBxt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmCOByt - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%RdtnMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%ExctnMod - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%RdtnTMax - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WaveDir - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%WAMITFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%WAMITFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + ReKiBuf(Re_Xferred) = InData%PtfmVol0 + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%HasWAMIT, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WAMITULEN + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmCOBxt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmCOByt + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%RdtnMod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%ExctnMod + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%RdtnTMax + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WaveDir + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(InData%WAMITFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%WAMITFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I CALL Conv_Rdtn_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%Conv_Rdtn, ErrStat2, ErrMsg2, OnlySize ) ! Conv_Rdtn CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -452,14 +452,14 @@ SUBROUTINE WAMIT_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Rhoxg - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepWave2 - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WaveDOmega - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Rhoxg + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepWave + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepWave2 + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WaveDOmega + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveElev0) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -470,8 +470,10 @@ SUBROUTINE WAMIT_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev0,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElev0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElev0))-1 ) = PACK(InData%WaveElev0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElev0) + DO i1 = LBOUND(InData%WaveElev0,1), UBOUND(InData%WaveElev0,1) + ReKiBuf(Re_Xferred) = InData%WaveElev0(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveElevC0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -486,8 +488,12 @@ SUBROUTINE WAMIT_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC0,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElevC0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElevC0))-1 ) = PACK(InData%WaveElevC0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElevC0) + DO i2 = LBOUND(InData%WaveElevC0,2), UBOUND(InData%WaveElevC0,2) + DO i1 = LBOUND(InData%WaveElevC0,1), UBOUND(InData%WaveElevC0,1) + ReKiBuf(Re_Xferred) = InData%WaveElevC0(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -499,13 +505,15 @@ SUBROUTINE WAMIT_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveTime)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveTime))-1 ) = PACK(InData%WaveTime,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveTime) + DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) + ReKiBuf(Re_Xferred) = InData%WaveTime(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WaveMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WaveMod + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDens + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveDirArr) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -516,23 +524,25 @@ SUBROUTINE WAMIT_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDirArr,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveDirArr)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveDirArr))-1 ) = PACK(InData%WaveDirArr,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveDirArr) + DO i1 = LBOUND(InData%WaveDirArr,1), UBOUND(InData%WaveDirArr,1) + ReKiBuf(Re_Xferred) = InData%WaveDirArr(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WaveDirMin - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WaveDirMax - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WaveDirMin + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WaveDirMax + Re_Xferred = Re_Xferred + 1 DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) - DO I = 1, LEN(InData%OutList) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%OutAll , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%OutList) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + IntKiBuf(Int_Xferred) = TRANSFER(InData%OutAll, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 END SUBROUTINE WAMIT_PackInitInput SUBROUTINE WAMIT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -548,12 +558,6 @@ SUBROUTINE WAMIT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -569,28 +573,28 @@ SUBROUTINE WAMIT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%PtfmVol0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HasWAMIT = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%WAMITULEN = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmCOBxt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmCOByt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RdtnMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ExctnMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%RdtnTMax = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%WaveDir = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%WAMITFile) - OutData%WAMITFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + OutData%PtfmVol0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HasWAMIT = TRANSFER(IntKiBuf(Int_Xferred), OutData%HasWAMIT) + Int_Xferred = Int_Xferred + 1 + OutData%WAMITULEN = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmCOBxt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmCOByt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RdtnMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ExctnMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%RdtnTMax = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%WaveDir = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(OutData%WAMITFile) + OutData%WAMITFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -631,14 +635,14 @@ SUBROUTINE WAMIT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%Rhoxg = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NStepWave = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NStepWave2 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%WaveDOmega = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%Rhoxg = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NStepWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NStepWave2 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WaveDOmega = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev0 not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -652,15 +656,10 @@ SUBROUTINE WAMIT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveElev0)>0) OutData%WaveElev0 = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElev0))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElev0) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveElev0,1), UBOUND(OutData%WaveElev0,1) + OutData%WaveElev0(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevC0 not allocated Int_Xferred = Int_Xferred + 1 @@ -678,15 +677,12 @@ SUBROUTINE WAMIT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveElevC0)>0) OutData%WaveElevC0 = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElevC0))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElevC0) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveElevC0,2), UBOUND(OutData%WaveElevC0,2) + DO i1 = LBOUND(OutData%WaveElevC0,1), UBOUND(OutData%WaveElevC0,1) + OutData%WaveElevC0(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated Int_Xferred = Int_Xferred + 1 @@ -701,20 +697,15 @@ SUBROUTINE WAMIT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveTime)>0) OutData%WaveTime = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveTime))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveTime) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) + OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%WaveMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%WtrDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%WaveMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WtrDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDirArr not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -728,39 +719,27 @@ SUBROUTINE WAMIT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDirArr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveDirArr)>0) OutData%WaveDirArr = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveDirArr))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveDirArr) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveDirArr,1), UBOUND(OutData%WaveDirArr,1) + OutData%WaveDirArr(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%WaveDirMin = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveDirMax = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%WaveDirMin = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WaveDirMax = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%OutList,1) i1_u = UBOUND(OutData%OutList,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) - DO I = 1, LEN(OutData%OutList) - OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - DEALLOCATE(mask1) - OutData%OutAll = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%OutList) + OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + OutData%OutAll = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutAll) + Int_Xferred = Int_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE WAMIT_UnPackInitInput SUBROUTINE WAMIT_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -903,12 +882,12 @@ SUBROUTINE WAMIT_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) + DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) DO I = 1, LEN(InData%WriteOutputHdr) IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdr(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -920,12 +899,12 @@ SUBROUTINE WAMIT_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) + DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) DO I = 1, LEN(InData%WriteOutputUnt) IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUnt(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF END SUBROUTINE WAMIT_PackInitOutput @@ -942,12 +921,6 @@ SUBROUTINE WAMIT_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -975,19 +948,12 @@ SUBROUTINE WAMIT_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) DO I = 1, LEN(OutData%WriteOutputHdr) OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated Int_Xferred = Int_Xferred + 1 @@ -1002,19 +968,12 @@ SUBROUTINE WAMIT_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) DO I = 1, LEN(OutData%WriteOutputUnt) OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF END SUBROUTINE WAMIT_UnPackInitOutput @@ -1270,12 +1229,6 @@ SUBROUTINE WAMIT_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_UnPackContState' @@ -1663,12 +1616,6 @@ SUBROUTINE WAMIT_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_UnPackDiscState' @@ -2056,12 +2003,6 @@ SUBROUTINE WAMIT_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_UnPackConstrState' @@ -2449,12 +2390,6 @@ SUBROUTINE WAMIT_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_UnPackOtherState' @@ -2882,18 +2817,28 @@ SUBROUTINE WAMIT_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%LastIndWave - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_HS))-1 ) = PACK(InData%F_HS,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_HS) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_Waves1))-1 ) = PACK(InData%F_Waves1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_Waves1) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_Rdtn))-1 ) = PACK(InData%F_Rdtn,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_Rdtn) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_PtfmAdd))-1 ) = PACK(InData%F_PtfmAdd,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_PtfmAdd) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_PtfmAM))-1 ) = PACK(InData%F_PtfmAM,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_PtfmAM) + IntKiBuf(Int_Xferred) = InData%LastIndWave + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%F_HS,1), UBOUND(InData%F_HS,1) + ReKiBuf(Re_Xferred) = InData%F_HS(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%F_Waves1,1), UBOUND(InData%F_Waves1,1) + ReKiBuf(Re_Xferred) = InData%F_Waves1(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%F_Rdtn,1), UBOUND(InData%F_Rdtn,1) + ReKiBuf(Re_Xferred) = InData%F_Rdtn(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%F_PtfmAdd,1), UBOUND(InData%F_PtfmAdd,1) + ReKiBuf(Re_Xferred) = InData%F_PtfmAdd(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%F_PtfmAM,1), UBOUND(InData%F_PtfmAM,1) + ReKiBuf(Re_Xferred) = InData%F_PtfmAM(i1) + Re_Xferred = Re_Xferred + 1 + END DO CALL SS_Rad_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%SS_Rdtn, ErrStat2, ErrMsg2, OnlySize ) ! SS_Rdtn CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3161,12 +3106,6 @@ SUBROUTINE WAMIT_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -3181,63 +3120,38 @@ SUBROUTINE WAMIT_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%LastIndWave = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%LastIndWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%F_HS,1) i1_u = UBOUND(OutData%F_HS,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%F_HS = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_HS))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_HS) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%F_HS,1), UBOUND(OutData%F_HS,1) + OutData%F_HS(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%F_Waves1,1) i1_u = UBOUND(OutData%F_Waves1,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%F_Waves1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_Waves1))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_Waves1) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%F_Waves1,1), UBOUND(OutData%F_Waves1,1) + OutData%F_Waves1(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%F_Rdtn,1) i1_u = UBOUND(OutData%F_Rdtn,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%F_Rdtn = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_Rdtn))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_Rdtn) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%F_Rdtn,1), UBOUND(OutData%F_Rdtn,1) + OutData%F_Rdtn(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%F_PtfmAdd,1) i1_u = UBOUND(OutData%F_PtfmAdd,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%F_PtfmAdd = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_PtfmAdd))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_PtfmAdd) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%F_PtfmAdd,1), UBOUND(OutData%F_PtfmAdd,1) + OutData%F_PtfmAdd(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%F_PtfmAM,1) i1_u = UBOUND(OutData%F_PtfmAM,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%F_PtfmAM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_PtfmAM))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_PtfmAM) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%F_PtfmAM,1), UBOUND(OutData%F_PtfmAM,1) + OutData%F_PtfmAM(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -3886,20 +3800,28 @@ SUBROUTINE WAMIT_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%HdroAdMsI))-1 ) = PACK(InData%HdroAdMsI,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%HdroAdMsI) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%HdroSttc))-1 ) = PACK(InData%HdroSttc,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%HdroSttc) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmVol0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmCOBxt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmCOByt - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%RdtnMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%ExctnMod - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(InData%HdroAdMsI,2), UBOUND(InData%HdroAdMsI,2) + DO i1 = LBOUND(InData%HdroAdMsI,1), UBOUND(InData%HdroAdMsI,1) + ReKiBuf(Re_Xferred) = InData%HdroAdMsI(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%HdroSttc,2), UBOUND(InData%HdroSttc,2) + DO i1 = LBOUND(InData%HdroSttc,1), UBOUND(InData%HdroSttc,1) + ReKiBuf(Re_Xferred) = InData%HdroSttc(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + ReKiBuf(Re_Xferred) = InData%PtfmVol0 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmCOBxt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmCOByt + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%RdtnMod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%ExctnMod + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveExctn) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -3913,11 +3835,15 @@ SUBROUTINE WAMIT_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveExctn,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveExctn)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveExctn))-1 ) = PACK(InData%WaveExctn,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveExctn) + DO i2 = LBOUND(InData%WaveExctn,2), UBOUND(InData%WaveExctn,2) + DO i1 = LBOUND(InData%WaveExctn,1), UBOUND(InData%WaveExctn,1) + ReKiBuf(Re_Xferred) = InData%WaveExctn(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RhoXg - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RhoXg + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -3928,11 +3854,13 @@ SUBROUTINE WAMIT_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveTime)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveTime))-1 ) = PACK(InData%WaveTime,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveTime) + DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) + ReKiBuf(Re_Xferred) = InData%WaveTime(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepWave + Int_Xferred = Int_Xferred + 1 CALL Conv_Rdtn_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%Conv_Rdtn, ErrStat2, ErrMsg2, OnlySize ) ! Conv_Rdtn CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4017,20 +3945,20 @@ SUBROUTINE WAMIT_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmSgF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmSwF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmHvF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmRF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmPF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmYF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmSgF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmSwF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmHvF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmRF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmPF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmYF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4072,24 +4000,24 @@ SUBROUTINE WAMIT_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOutAll - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutSFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%Delim) - IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UnOutFile - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOutAll + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%OutFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%OutSFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%Delim) + IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%UnOutFile + Int_Xferred = Int_Xferred + 1 END SUBROUTINE WAMIT_PackParam SUBROUTINE WAMIT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -4105,12 +4033,6 @@ SUBROUTINE WAMIT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -4130,38 +4052,32 @@ SUBROUTINE WAMIT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM i1_u = UBOUND(OutData%HdroAdMsI,1) i2_l = LBOUND(OutData%HdroAdMsI,2) i2_u = UBOUND(OutData%HdroAdMsI,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%HdroAdMsI = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%HdroAdMsI))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%HdroAdMsI) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%HdroAdMsI,2), UBOUND(OutData%HdroAdMsI,2) + DO i1 = LBOUND(OutData%HdroAdMsI,1), UBOUND(OutData%HdroAdMsI,1) + OutData%HdroAdMsI(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%HdroSttc,1) i1_u = UBOUND(OutData%HdroSttc,1) i2_l = LBOUND(OutData%HdroSttc,2) i2_u = UBOUND(OutData%HdroSttc,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%HdroSttc = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%HdroSttc))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%HdroSttc) - DEALLOCATE(mask2) - OutData%PtfmVol0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmCOBxt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmCOByt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RdtnMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ExctnMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(OutData%HdroSttc,2), UBOUND(OutData%HdroSttc,2) + DO i1 = LBOUND(OutData%HdroSttc,1), UBOUND(OutData%HdroSttc,1) + OutData%HdroSttc(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + OutData%PtfmVol0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmCOBxt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmCOByt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RdtnMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ExctnMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveExctn not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -4178,18 +4094,15 @@ SUBROUTINE WAMIT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveExctn.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveExctn)>0) OutData%WaveExctn = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveExctn))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveExctn) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveExctn,2), UBOUND(OutData%WaveExctn,2) + DO i1 = LBOUND(OutData%WaveExctn,1), UBOUND(OutData%WaveExctn,1) + OutData%WaveExctn(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%RhoXg = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%RhoXg = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -4203,18 +4116,13 @@ SUBROUTINE WAMIT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveTime)>0) OutData%WaveTime = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveTime))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveTime) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) + OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%NStepWave = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NStepWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -4335,20 +4243,20 @@ SUBROUTINE WAMIT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%PtfmSgF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmSwF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmHvF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmRF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmPF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmYF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%PtfmSgF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmSgF) + Int_Xferred = Int_Xferred + 1 + OutData%PtfmSwF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmSwF) + Int_Xferred = Int_Xferred + 1 + OutData%PtfmHvF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmHvF) + Int_Xferred = Int_Xferred + 1 + OutData%PtfmRF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmRF) + Int_Xferred = Int_Xferred + 1 + OutData%PtfmPF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmPF) + Int_Xferred = Int_Xferred + 1 + OutData%PtfmYF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmYF) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -4405,24 +4313,24 @@ SUBROUTINE WAMIT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumOutAll = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutSFmt) - OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%UnOutFile = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumOutAll = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%OutFmt) + OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%OutSFmt) + OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%Delim) + OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%UnOutFile = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE WAMIT_UnPackParam SUBROUTINE WAMIT_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -4579,12 +4487,6 @@ SUBROUTINE WAMIT_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_UnPackInput' @@ -4810,8 +4712,10 @@ SUBROUTINE WAMIT_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WriteOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE WAMIT_PackOutput @@ -4828,12 +4732,6 @@ SUBROUTINE WAMIT_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -4901,15 +4799,10 @@ SUBROUTINE WAMIT_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WriteOutput)>0) OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE WAMIT_UnPackOutput @@ -4988,8 +4881,8 @@ SUBROUTINE WAMIT_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMs REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -5004,6 +4897,8 @@ SUBROUTINE WAMIT_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(u1%Mesh, u2%Mesh, tin, u_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE WAMIT_Input_ExtrapInterp1 @@ -5035,8 +4930,9 @@ SUBROUTINE WAMIT_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, E REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_Input_ExtrapInterp2' @@ -5058,6 +4954,8 @@ SUBROUTINE WAMIT_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, E CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(u1%Mesh, u2%Mesh, u3%Mesh, tin, u_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE WAMIT_Input_ExtrapInterp2 @@ -5137,12 +5035,12 @@ SUBROUTINE WAMIT_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrM REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! 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 :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -5155,15 +5053,15 @@ SUBROUTINE WAMIT_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(y1%Mesh, y2%Mesh, tin, y_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END IF ! check if allocated END SUBROUTINE WAMIT_Output_ExtrapInterp1 @@ -5194,13 +5092,14 @@ SUBROUTINE WAMIT_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -5219,16 +5118,16 @@ SUBROUTINE WAMIT_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(y1%Mesh, y2%Mesh, y3%Mesh, tin, y_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END IF ! check if allocated END SUBROUTINE WAMIT_Output_ExtrapInterp2 diff --git a/modules/hydrodyn/src/Waves2_Types.f90 b/modules/hydrodyn/src/Waves2_Types.f90 index 834dcd954f..8f4bb3ef64 100644 --- a/modules/hydrodyn/src/Waves2_Types.f90 +++ b/modules/hydrodyn/src/Waves2_Types.f90 @@ -460,24 +460,24 @@ SUBROUTINE Waves2_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UnSum - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepWave2 - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WaveDOmega - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WaveStMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%WaveMultiDir , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%UnSum + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Gravity + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDens + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDpth + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepWave + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepWave2 + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WaveDOmega + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WaveStMod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%WaveMultiDir, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveDirArr) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -488,8 +488,10 @@ SUBROUTINE Waves2_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDirArr,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveDirArr)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveDirArr))-1 ) = PACK(InData%WaveDirArr,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveDirArr) + DO i1 = LBOUND(InData%WaveDirArr,1), UBOUND(InData%WaveDirArr,1) + ReKiBuf(Re_Xferred) = InData%WaveDirArr(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveElevC0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -504,8 +506,12 @@ SUBROUTINE Waves2_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC0,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElevC0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElevC0))-1 ) = PACK(InData%WaveElevC0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElevC0) + DO i2 = LBOUND(InData%WaveElevC0,2), UBOUND(InData%WaveElevC0,2) + DO i1 = LBOUND(InData%WaveElevC0,1), UBOUND(InData%WaveElevC0,1) + ReKiBuf(Re_Xferred) = InData%WaveElevC0(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -517,11 +523,13 @@ SUBROUTINE Waves2_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveTime)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveTime))-1 ) = PACK(InData%WaveTime,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveTime) + DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) + ReKiBuf(Re_Xferred) = InData%WaveTime(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NWaveElev - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NWaveElev + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveElevxi) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -532,8 +540,10 @@ SUBROUTINE Waves2_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevxi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElevxi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElevxi))-1 ) = PACK(InData%WaveElevxi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElevxi) + DO i1 = LBOUND(InData%WaveElevxi,1), UBOUND(InData%WaveElevxi,1) + ReKiBuf(Re_Xferred) = InData%WaveElevxi(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveElevyi) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -545,8 +555,10 @@ SUBROUTINE Waves2_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevyi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElevyi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElevyi))-1 ) = PACK(InData%WaveElevyi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElevyi) + DO i1 = LBOUND(InData%WaveElevyi,1), UBOUND(InData%WaveElevyi,1) + ReKiBuf(Re_Xferred) = InData%WaveElevyi(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveElevXY) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -561,11 +573,15 @@ SUBROUTINE Waves2_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevXY,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElevXY)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElevXY))-1 ) = PACK(InData%WaveElevXY,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElevXY) + DO i2 = LBOUND(InData%WaveElevXY,2), UBOUND(InData%WaveElevXY,2) + DO i1 = LBOUND(InData%WaveElevXY,1), UBOUND(InData%WaveElevXY,1) + ReKiBuf(Re_Xferred) = InData%WaveElevXY(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NWaveKin - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NWaveKin + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveKinxi) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -576,8 +592,10 @@ SUBROUTINE Waves2_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveKinxi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveKinxi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveKinxi))-1 ) = PACK(InData%WaveKinxi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveKinxi) + DO i1 = LBOUND(InData%WaveKinxi,1), UBOUND(InData%WaveKinxi,1) + ReKiBuf(Re_Xferred) = InData%WaveKinxi(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveKinyi) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -589,8 +607,10 @@ SUBROUTINE Waves2_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveKinyi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveKinyi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveKinyi))-1 ) = PACK(InData%WaveKinyi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveKinyi) + DO i1 = LBOUND(InData%WaveKinyi,1), UBOUND(InData%WaveKinyi,1) + ReKiBuf(Re_Xferred) = InData%WaveKinyi(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveKinzi) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -602,33 +622,35 @@ SUBROUTINE Waves2_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveKinzi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveKinzi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveKinzi))-1 ) = PACK(InData%WaveKinzi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveKinzi) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%WvDiffQTFF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%WvSumQTFF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WvLowCOffD - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WvHiCOffD - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WvLowCOffS - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WvHiCOffS - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%WaveKinzi,1), UBOUND(InData%WaveKinzi,1) + ReKiBuf(Re_Xferred) = InData%WaveKinzi(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = TRANSFER(InData%WvDiffQTFF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%WvSumQTFF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WvLowCOffD + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WvHiCOffD + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WvLowCOffS + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WvHiCOffS + Re_Xferred = Re_Xferred + 1 DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) - DO I = 1, LEN(InData%OutList) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%OutAll , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOutAll - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%OutList) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + IntKiBuf(Int_Xferred) = TRANSFER(InData%OutAll, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOutAll + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Waves2_PackInitInput SUBROUTINE Waves2_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -644,12 +666,6 @@ SUBROUTINE Waves2_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -666,24 +682,24 @@ SUBROUTINE Waves2_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%UnSum = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%Gravity = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDpth = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%NStepWave = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NStepWave2 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%WaveDOmega = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveStMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%WaveMultiDir = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%UnSum = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Gravity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WtrDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WtrDpth = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%NStepWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NStepWave2 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WaveDOmega = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WaveStMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WaveMultiDir = TRANSFER(IntKiBuf(Int_Xferred), OutData%WaveMultiDir) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDirArr not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -697,15 +713,10 @@ SUBROUTINE Waves2_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDirArr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveDirArr)>0) OutData%WaveDirArr = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveDirArr))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveDirArr) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveDirArr,1), UBOUND(OutData%WaveDirArr,1) + OutData%WaveDirArr(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevC0 not allocated Int_Xferred = Int_Xferred + 1 @@ -723,15 +734,12 @@ SUBROUTINE Waves2_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveElevC0)>0) OutData%WaveElevC0 = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElevC0))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElevC0) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveElevC0,2), UBOUND(OutData%WaveElevC0,2) + DO i1 = LBOUND(OutData%WaveElevC0,1), UBOUND(OutData%WaveElevC0,1) + OutData%WaveElevC0(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated Int_Xferred = Int_Xferred + 1 @@ -746,18 +754,13 @@ SUBROUTINE Waves2_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveTime)>0) OutData%WaveTime = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveTime))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveTime) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) + OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%NWaveElev = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NWaveElev = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevxi not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -771,15 +774,10 @@ SUBROUTINE Waves2_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevxi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveElevxi)>0) OutData%WaveElevxi = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElevxi))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElevxi) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveElevxi,1), UBOUND(OutData%WaveElevxi,1) + OutData%WaveElevxi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevyi not allocated Int_Xferred = Int_Xferred + 1 @@ -794,15 +792,10 @@ SUBROUTINE Waves2_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevyi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveElevyi)>0) OutData%WaveElevyi = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElevyi))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElevyi) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveElevyi,1), UBOUND(OutData%WaveElevyi,1) + OutData%WaveElevyi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevXY not allocated Int_Xferred = Int_Xferred + 1 @@ -820,18 +813,15 @@ SUBROUTINE Waves2_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevXY.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveElevXY)>0) OutData%WaveElevXY = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElevXY))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElevXY) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveElevXY,2), UBOUND(OutData%WaveElevXY,2) + DO i1 = LBOUND(OutData%WaveElevXY,1), UBOUND(OutData%WaveElevXY,1) + OutData%WaveElevXY(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%NWaveKin = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NWaveKin = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveKinxi not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -845,15 +835,10 @@ SUBROUTINE Waves2_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinxi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveKinxi)>0) OutData%WaveKinxi = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveKinxi))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveKinxi) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveKinxi,1), UBOUND(OutData%WaveKinxi,1) + OutData%WaveKinxi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveKinyi not allocated Int_Xferred = Int_Xferred + 1 @@ -868,15 +853,10 @@ SUBROUTINE Waves2_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinyi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveKinyi)>0) OutData%WaveKinyi = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveKinyi))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveKinyi) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveKinyi,1), UBOUND(OutData%WaveKinyi,1) + OutData%WaveKinyi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveKinzi not allocated Int_Xferred = Int_Xferred + 1 @@ -891,49 +871,37 @@ SUBROUTINE Waves2_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinzi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveKinzi)>0) OutData%WaveKinzi = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveKinzi))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveKinzi) - DEALLOCATE(mask1) - END IF - OutData%WvDiffQTFF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%WvSumQTFF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%WvLowCOffD = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WvHiCOffD = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WvLowCOffS = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WvHiCOffS = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%WaveKinzi,1), UBOUND(OutData%WaveKinzi,1) + OutData%WaveKinzi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%WvDiffQTFF = TRANSFER(IntKiBuf(Int_Xferred), OutData%WvDiffQTFF) + Int_Xferred = Int_Xferred + 1 + OutData%WvSumQTFF = TRANSFER(IntKiBuf(Int_Xferred), OutData%WvSumQTFF) + Int_Xferred = Int_Xferred + 1 + OutData%WvLowCOffD = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WvHiCOffD = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WvLowCOffS = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WvHiCOffS = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%OutList,1) i1_u = UBOUND(OutData%OutList,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) - DO I = 1, LEN(OutData%OutList) - OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - DEALLOCATE(mask1) - OutData%OutAll = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumOutAll = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%OutList) + OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + OutData%OutAll = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutAll) + Int_Xferred = Int_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumOutAll = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Waves2_UnPackInitInput SUBROUTINE Waves2_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -1380,12 +1348,12 @@ SUBROUTINE Waves2_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) + DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) DO I = 1, LEN(InData%WriteOutputHdr) IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdr(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1397,12 +1365,12 @@ SUBROUTINE Waves2_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) + DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) DO I = 1, LEN(InData%WriteOutputUnt) IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUnt(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveElevSeries2) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1417,8 +1385,12 @@ SUBROUTINE Waves2_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevSeries2,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElevSeries2)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElevSeries2))-1 ) = PACK(InData%WaveElevSeries2,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElevSeries2) + DO i2 = LBOUND(InData%WaveElevSeries2,2), UBOUND(InData%WaveElevSeries2,2) + DO i1 = LBOUND(InData%WaveElevSeries2,1), UBOUND(InData%WaveElevSeries2,1) + ReKiBuf(Re_Xferred) = InData%WaveElevSeries2(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveAcc2D) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1436,8 +1408,14 @@ SUBROUTINE Waves2_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc2D,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveAcc2D)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveAcc2D))-1 ) = PACK(InData%WaveAcc2D,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveAcc2D) + DO i3 = LBOUND(InData%WaveAcc2D,3), UBOUND(InData%WaveAcc2D,3) + DO i2 = LBOUND(InData%WaveAcc2D,2), UBOUND(InData%WaveAcc2D,2) + DO i1 = LBOUND(InData%WaveAcc2D,1), UBOUND(InData%WaveAcc2D,1) + ReKiBuf(Re_Xferred) = InData%WaveAcc2D(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveDynP2D) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1452,8 +1430,12 @@ SUBROUTINE Waves2_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP2D,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveDynP2D)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveDynP2D))-1 ) = PACK(InData%WaveDynP2D,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveDynP2D) + DO i2 = LBOUND(InData%WaveDynP2D,2), UBOUND(InData%WaveDynP2D,2) + DO i1 = LBOUND(InData%WaveDynP2D,1), UBOUND(InData%WaveDynP2D,1) + ReKiBuf(Re_Xferred) = InData%WaveDynP2D(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveAcc2S) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1471,8 +1453,14 @@ SUBROUTINE Waves2_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc2S,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveAcc2S)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveAcc2S))-1 ) = PACK(InData%WaveAcc2S,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveAcc2S) + DO i3 = LBOUND(InData%WaveAcc2S,3), UBOUND(InData%WaveAcc2S,3) + DO i2 = LBOUND(InData%WaveAcc2S,2), UBOUND(InData%WaveAcc2S,2) + DO i1 = LBOUND(InData%WaveAcc2S,1), UBOUND(InData%WaveAcc2S,1) + ReKiBuf(Re_Xferred) = InData%WaveAcc2S(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveDynP2S) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1487,8 +1475,12 @@ SUBROUTINE Waves2_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP2S,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveDynP2S)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveDynP2S))-1 ) = PACK(InData%WaveDynP2S,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveDynP2S) + DO i2 = LBOUND(InData%WaveDynP2S,2), UBOUND(InData%WaveDynP2S,2) + DO i1 = LBOUND(InData%WaveDynP2S,1), UBOUND(InData%WaveDynP2S,1) + ReKiBuf(Re_Xferred) = InData%WaveDynP2S(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveVel2D) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1506,8 +1498,14 @@ SUBROUTINE Waves2_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel2D,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveVel2D)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveVel2D))-1 ) = PACK(InData%WaveVel2D,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveVel2D) + DO i3 = LBOUND(InData%WaveVel2D,3), UBOUND(InData%WaveVel2D,3) + DO i2 = LBOUND(InData%WaveVel2D,2), UBOUND(InData%WaveVel2D,2) + DO i1 = LBOUND(InData%WaveVel2D,1), UBOUND(InData%WaveVel2D,1) + ReKiBuf(Re_Xferred) = InData%WaveVel2D(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveVel2S) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1525,8 +1523,14 @@ SUBROUTINE Waves2_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel2S,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveVel2S)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveVel2S))-1 ) = PACK(InData%WaveVel2S,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveVel2S) + DO i3 = LBOUND(InData%WaveVel2S,3), UBOUND(InData%WaveVel2S,3) + DO i2 = LBOUND(InData%WaveVel2S,2), UBOUND(InData%WaveVel2S,2) + DO i1 = LBOUND(InData%WaveVel2S,1), UBOUND(InData%WaveVel2S,1) + ReKiBuf(Re_Xferred) = InData%WaveVel2S(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveAcc2D0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1544,8 +1548,14 @@ SUBROUTINE Waves2_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc2D0,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveAcc2D0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveAcc2D0))-1 ) = PACK(InData%WaveAcc2D0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveAcc2D0) + DO i3 = LBOUND(InData%WaveAcc2D0,3), UBOUND(InData%WaveAcc2D0,3) + DO i2 = LBOUND(InData%WaveAcc2D0,2), UBOUND(InData%WaveAcc2D0,2) + DO i1 = LBOUND(InData%WaveAcc2D0,1), UBOUND(InData%WaveAcc2D0,1) + ReKiBuf(Re_Xferred) = InData%WaveAcc2D0(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveDynP2D0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1560,8 +1570,12 @@ SUBROUTINE Waves2_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP2D0,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveDynP2D0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveDynP2D0))-1 ) = PACK(InData%WaveDynP2D0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveDynP2D0) + DO i2 = LBOUND(InData%WaveDynP2D0,2), UBOUND(InData%WaveDynP2D0,2) + DO i1 = LBOUND(InData%WaveDynP2D0,1), UBOUND(InData%WaveDynP2D0,1) + ReKiBuf(Re_Xferred) = InData%WaveDynP2D0(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveAcc2S0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1579,8 +1593,14 @@ SUBROUTINE Waves2_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc2S0,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveAcc2S0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveAcc2S0))-1 ) = PACK(InData%WaveAcc2S0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveAcc2S0) + DO i3 = LBOUND(InData%WaveAcc2S0,3), UBOUND(InData%WaveAcc2S0,3) + DO i2 = LBOUND(InData%WaveAcc2S0,2), UBOUND(InData%WaveAcc2S0,2) + DO i1 = LBOUND(InData%WaveAcc2S0,1), UBOUND(InData%WaveAcc2S0,1) + ReKiBuf(Re_Xferred) = InData%WaveAcc2S0(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveDynP2S0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1595,8 +1615,12 @@ SUBROUTINE Waves2_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP2S0,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveDynP2S0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveDynP2S0))-1 ) = PACK(InData%WaveDynP2S0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveDynP2S0) + DO i2 = LBOUND(InData%WaveDynP2S0,2), UBOUND(InData%WaveDynP2S0,2) + DO i1 = LBOUND(InData%WaveDynP2S0,1), UBOUND(InData%WaveDynP2S0,1) + ReKiBuf(Re_Xferred) = InData%WaveDynP2S0(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveVel2D0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1614,8 +1638,14 @@ SUBROUTINE Waves2_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel2D0,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveVel2D0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveVel2D0))-1 ) = PACK(InData%WaveVel2D0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveVel2D0) + DO i3 = LBOUND(InData%WaveVel2D0,3), UBOUND(InData%WaveVel2D0,3) + DO i2 = LBOUND(InData%WaveVel2D0,2), UBOUND(InData%WaveVel2D0,2) + DO i1 = LBOUND(InData%WaveVel2D0,1), UBOUND(InData%WaveVel2D0,1) + ReKiBuf(Re_Xferred) = InData%WaveVel2D0(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveVel2S0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1633,8 +1663,14 @@ SUBROUTINE Waves2_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel2S0,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveVel2S0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveVel2S0))-1 ) = PACK(InData%WaveVel2S0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveVel2S0) + DO i3 = LBOUND(InData%WaveVel2S0,3), UBOUND(InData%WaveVel2S0,3) + DO i2 = LBOUND(InData%WaveVel2S0,2), UBOUND(InData%WaveVel2S0,2) + DO i1 = LBOUND(InData%WaveVel2S0,1), UBOUND(InData%WaveVel2S0,1) + ReKiBuf(Re_Xferred) = InData%WaveVel2S0(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF END SUBROUTINE Waves2_PackInitOutput @@ -1651,12 +1687,6 @@ SUBROUTINE Waves2_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -1686,19 +1716,12 @@ SUBROUTINE Waves2_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) DO I = 1, LEN(OutData%WriteOutputHdr) OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated Int_Xferred = Int_Xferred + 1 @@ -1713,19 +1736,12 @@ SUBROUTINE Waves2_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) DO I = 1, LEN(OutData%WriteOutputUnt) OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevSeries2 not allocated Int_Xferred = Int_Xferred + 1 @@ -1743,15 +1759,12 @@ SUBROUTINE Waves2_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevSeries2.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveElevSeries2)>0) OutData%WaveElevSeries2 = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElevSeries2))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElevSeries2) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveElevSeries2,2), UBOUND(OutData%WaveElevSeries2,2) + DO i1 = LBOUND(OutData%WaveElevSeries2,1), UBOUND(OutData%WaveElevSeries2,1) + OutData%WaveElevSeries2(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAcc2D not allocated Int_Xferred = Int_Xferred + 1 @@ -1772,15 +1785,14 @@ SUBROUTINE Waves2_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc2D.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%WaveAcc2D)>0) OutData%WaveAcc2D = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveAcc2D))-1 ), mask3, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveAcc2D) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%WaveAcc2D,3), UBOUND(OutData%WaveAcc2D,3) + DO i2 = LBOUND(OutData%WaveAcc2D,2), UBOUND(OutData%WaveAcc2D,2) + DO i1 = LBOUND(OutData%WaveAcc2D,1), UBOUND(OutData%WaveAcc2D,1) + OutData%WaveAcc2D(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDynP2D not allocated Int_Xferred = Int_Xferred + 1 @@ -1798,15 +1810,12 @@ SUBROUTINE Waves2_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP2D.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveDynP2D)>0) OutData%WaveDynP2D = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveDynP2D))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveDynP2D) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveDynP2D,2), UBOUND(OutData%WaveDynP2D,2) + DO i1 = LBOUND(OutData%WaveDynP2D,1), UBOUND(OutData%WaveDynP2D,1) + OutData%WaveDynP2D(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAcc2S not allocated Int_Xferred = Int_Xferred + 1 @@ -1827,15 +1836,14 @@ SUBROUTINE Waves2_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc2S.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%WaveAcc2S)>0) OutData%WaveAcc2S = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveAcc2S))-1 ), mask3, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveAcc2S) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%WaveAcc2S,3), UBOUND(OutData%WaveAcc2S,3) + DO i2 = LBOUND(OutData%WaveAcc2S,2), UBOUND(OutData%WaveAcc2S,2) + DO i1 = LBOUND(OutData%WaveAcc2S,1), UBOUND(OutData%WaveAcc2S,1) + OutData%WaveAcc2S(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDynP2S not allocated Int_Xferred = Int_Xferred + 1 @@ -1853,15 +1861,12 @@ SUBROUTINE Waves2_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP2S.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveDynP2S)>0) OutData%WaveDynP2S = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveDynP2S))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveDynP2S) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveDynP2S,2), UBOUND(OutData%WaveDynP2S,2) + DO i1 = LBOUND(OutData%WaveDynP2S,1), UBOUND(OutData%WaveDynP2S,1) + OutData%WaveDynP2S(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel2D not allocated Int_Xferred = Int_Xferred + 1 @@ -1882,15 +1887,14 @@ SUBROUTINE Waves2_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel2D.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%WaveVel2D)>0) OutData%WaveVel2D = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveVel2D))-1 ), mask3, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveVel2D) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%WaveVel2D,3), UBOUND(OutData%WaveVel2D,3) + DO i2 = LBOUND(OutData%WaveVel2D,2), UBOUND(OutData%WaveVel2D,2) + DO i1 = LBOUND(OutData%WaveVel2D,1), UBOUND(OutData%WaveVel2D,1) + OutData%WaveVel2D(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel2S not allocated Int_Xferred = Int_Xferred + 1 @@ -1911,15 +1915,14 @@ SUBROUTINE Waves2_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel2S.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%WaveVel2S)>0) OutData%WaveVel2S = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveVel2S))-1 ), mask3, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveVel2S) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%WaveVel2S,3), UBOUND(OutData%WaveVel2S,3) + DO i2 = LBOUND(OutData%WaveVel2S,2), UBOUND(OutData%WaveVel2S,2) + DO i1 = LBOUND(OutData%WaveVel2S,1), UBOUND(OutData%WaveVel2S,1) + OutData%WaveVel2S(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAcc2D0 not allocated Int_Xferred = Int_Xferred + 1 @@ -1940,15 +1943,14 @@ SUBROUTINE Waves2_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc2D0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%WaveAcc2D0)>0) OutData%WaveAcc2D0 = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveAcc2D0))-1 ), mask3, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveAcc2D0) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%WaveAcc2D0,3), UBOUND(OutData%WaveAcc2D0,3) + DO i2 = LBOUND(OutData%WaveAcc2D0,2), UBOUND(OutData%WaveAcc2D0,2) + DO i1 = LBOUND(OutData%WaveAcc2D0,1), UBOUND(OutData%WaveAcc2D0,1) + OutData%WaveAcc2D0(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDynP2D0 not allocated Int_Xferred = Int_Xferred + 1 @@ -1966,15 +1968,12 @@ SUBROUTINE Waves2_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP2D0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveDynP2D0)>0) OutData%WaveDynP2D0 = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveDynP2D0))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveDynP2D0) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveDynP2D0,2), UBOUND(OutData%WaveDynP2D0,2) + DO i1 = LBOUND(OutData%WaveDynP2D0,1), UBOUND(OutData%WaveDynP2D0,1) + OutData%WaveDynP2D0(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAcc2S0 not allocated Int_Xferred = Int_Xferred + 1 @@ -1995,15 +1994,14 @@ SUBROUTINE Waves2_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc2S0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%WaveAcc2S0)>0) OutData%WaveAcc2S0 = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveAcc2S0))-1 ), mask3, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveAcc2S0) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%WaveAcc2S0,3), UBOUND(OutData%WaveAcc2S0,3) + DO i2 = LBOUND(OutData%WaveAcc2S0,2), UBOUND(OutData%WaveAcc2S0,2) + DO i1 = LBOUND(OutData%WaveAcc2S0,1), UBOUND(OutData%WaveAcc2S0,1) + OutData%WaveAcc2S0(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDynP2S0 not allocated Int_Xferred = Int_Xferred + 1 @@ -2021,15 +2019,12 @@ SUBROUTINE Waves2_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP2S0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveDynP2S0)>0) OutData%WaveDynP2S0 = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveDynP2S0))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveDynP2S0) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveDynP2S0,2), UBOUND(OutData%WaveDynP2S0,2) + DO i1 = LBOUND(OutData%WaveDynP2S0,1), UBOUND(OutData%WaveDynP2S0,1) + OutData%WaveDynP2S0(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel2D0 not allocated Int_Xferred = Int_Xferred + 1 @@ -2050,15 +2045,14 @@ SUBROUTINE Waves2_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel2D0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%WaveVel2D0)>0) OutData%WaveVel2D0 = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveVel2D0))-1 ), mask3, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveVel2D0) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%WaveVel2D0,3), UBOUND(OutData%WaveVel2D0,3) + DO i2 = LBOUND(OutData%WaveVel2D0,2), UBOUND(OutData%WaveVel2D0,2) + DO i1 = LBOUND(OutData%WaveVel2D0,1), UBOUND(OutData%WaveVel2D0,1) + OutData%WaveVel2D0(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel2S0 not allocated Int_Xferred = Int_Xferred + 1 @@ -2079,15 +2073,14 @@ SUBROUTINE Waves2_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel2S0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%WaveVel2S0)>0) OutData%WaveVel2S0 = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveVel2S0))-1 ), mask3, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveVel2S0) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%WaveVel2S0,3), UBOUND(OutData%WaveVel2S0,3) + DO i2 = LBOUND(OutData%WaveVel2S0,2), UBOUND(OutData%WaveVel2S0,2) + DO i1 = LBOUND(OutData%WaveVel2S0,1), UBOUND(OutData%WaveVel2S0,1) + OutData%WaveVel2S0(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF END SUBROUTINE Waves2_UnPackInitOutput @@ -2182,8 +2175,8 @@ SUBROUTINE Waves2_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyContState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyContState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Waves2_PackContState SUBROUTINE Waves2_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2199,12 +2192,6 @@ SUBROUTINE Waves2_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_UnPackContState' @@ -2218,8 +2205,8 @@ SUBROUTINE Waves2_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyContState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyContState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Waves2_UnPackContState SUBROUTINE Waves2_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) @@ -2313,8 +2300,8 @@ SUBROUTINE Waves2_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyDiscState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Waves2_PackDiscState SUBROUTINE Waves2_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2330,12 +2317,6 @@ SUBROUTINE Waves2_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_UnPackDiscState' @@ -2349,8 +2330,8 @@ SUBROUTINE Waves2_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyDiscState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyDiscState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Waves2_UnPackDiscState SUBROUTINE Waves2_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -2444,8 +2425,8 @@ SUBROUTINE Waves2_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyConstrState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Waves2_PackConstrState SUBROUTINE Waves2_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2461,12 +2442,6 @@ SUBROUTINE Waves2_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_UnPackConstrState' @@ -2480,8 +2455,8 @@ SUBROUTINE Waves2_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyConstrState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyConstrState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Waves2_UnPackConstrState SUBROUTINE Waves2_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -2575,8 +2550,8 @@ SUBROUTINE Waves2_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DummyOtherState - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DummyOtherState + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Waves2_PackOtherState SUBROUTINE Waves2_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2592,12 +2567,6 @@ SUBROUTINE Waves2_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_UnPackOtherState' @@ -2611,8 +2580,8 @@ SUBROUTINE Waves2_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyOtherState = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%DummyOtherState = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Waves2_UnPackOtherState SUBROUTINE Waves2_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -2706,8 +2675,8 @@ SUBROUTINE Waves2_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%LastIndWave - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%LastIndWave + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Waves2_PackMisc SUBROUTINE Waves2_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2723,12 +2692,6 @@ SUBROUTINE Waves2_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_UnPackMisc' @@ -2742,8 +2705,8 @@ SUBROUTINE Waves2_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%LastIndWave = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%LastIndWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Waves2_UnPackMisc SUBROUTINE Waves2_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -2949,18 +2912,18 @@ SUBROUTINE Waves2_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%WvDiffQTFF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%WvSumQTFF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NWaveElev - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepWave2 - Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%WvDiffQTFF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%WvSumQTFF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NWaveElev + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepWave + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepWave2 + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2971,8 +2934,10 @@ SUBROUTINE Waves2_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveTime)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveTime))-1 ) = PACK(InData%WaveTime,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveTime) + DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) + ReKiBuf(Re_Xferred) = InData%WaveTime(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveElev2) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2987,8 +2952,12 @@ SUBROUTINE Waves2_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev2,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElev2)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElev2))-1 ) = PACK(InData%WaveElev2,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElev2) + DO i2 = LBOUND(InData%WaveElev2,2), UBOUND(InData%WaveElev2,2) + DO i1 = LBOUND(InData%WaveElev2,1), UBOUND(InData%WaveElev2,1) + ReKiBuf(Re_Xferred) = InData%WaveElev2(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3031,24 +3000,24 @@ SUBROUTINE Waves2_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOutAll - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutSFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%Delim) - IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UnOutFile - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOutAll + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%OutFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%OutSFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%Delim) + IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%UnOutFile + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Waves2_PackParam SUBROUTINE Waves2_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -3064,12 +3033,6 @@ SUBROUTINE Waves2_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -3085,18 +3048,18 @@ SUBROUTINE Waves2_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%WvDiffQTFF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%WvSumQTFF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NWaveElev = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NStepWave = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NStepWave2 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%WvDiffQTFF = TRANSFER(IntKiBuf(Int_Xferred), OutData%WvDiffQTFF) + Int_Xferred = Int_Xferred + 1 + OutData%WvSumQTFF = TRANSFER(IntKiBuf(Int_Xferred), OutData%WvSumQTFF) + Int_Xferred = Int_Xferred + 1 + OutData%NWaveElev = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NStepWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NStepWave2 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3110,15 +3073,10 @@ SUBROUTINE Waves2_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveTime)>0) OutData%WaveTime = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveTime))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveTime) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) + OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev2 not allocated Int_Xferred = Int_Xferred + 1 @@ -3136,15 +3094,12 @@ SUBROUTINE Waves2_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev2.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveElev2)>0) OutData%WaveElev2 = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElev2))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElev2) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveElev2,2), UBOUND(OutData%WaveElev2,2) + DO i1 = LBOUND(OutData%WaveElev2,1), UBOUND(OutData%WaveElev2,1) + OutData%WaveElev2(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam not allocated Int_Xferred = Int_Xferred + 1 @@ -3202,24 +3157,24 @@ SUBROUTINE Waves2_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumOutAll = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutSFmt) - OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%UnOutFile = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumOutAll = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%OutFmt) + OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%OutSFmt) + OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%Delim) + OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%UnOutFile = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Waves2_UnPackParam SUBROUTINE Waves2_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -3313,8 +3268,8 @@ SUBROUTINE Waves2_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyInput - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyInput + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Waves2_PackInput SUBROUTINE Waves2_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -3330,12 +3285,6 @@ SUBROUTINE Waves2_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_UnPackInput' @@ -3349,8 +3298,8 @@ SUBROUTINE Waves2_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyInput = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyInput = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Waves2_UnPackInput SUBROUTINE Waves2_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -3473,8 +3422,10 @@ SUBROUTINE Waves2_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WriteOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE Waves2_PackOutput @@ -3491,12 +3442,6 @@ SUBROUTINE Waves2_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -3524,15 +3469,10 @@ SUBROUTINE Waves2_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WriteOutput)>0) OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE Waves2_UnPackOutput @@ -3611,8 +3551,8 @@ SUBROUTINE Waves2_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrM REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -3627,8 +3567,10 @@ SUBROUTINE Waves2_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = -(u1%DummyInput - u2%DummyInput)/t(2) - u_out%DummyInput = u1%DummyInput + b0 * t_out + + ScaleFactor = t_out / t(2) + b = -(u1%DummyInput - u2%DummyInput) + u_out%DummyInput = u1%DummyInput + b * ScaleFactor END SUBROUTINE Waves2_Input_ExtrapInterp1 @@ -3658,8 +3600,9 @@ SUBROUTINE Waves2_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_Input_ExtrapInterp2' @@ -3681,9 +3624,11 @@ SUBROUTINE Waves2_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = (t(3)**2*(u1%DummyInput - u2%DummyInput) + t(2)**2*(-u1%DummyInput + u3%DummyInput))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%DummyInput + t(3)*u2%DummyInput - t(2)*u3%DummyInput ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%DummyInput = u1%DummyInput + b0 * t_out + c0 * t_out**2 + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) + b = (t(3)**2*(u1%DummyInput - u2%DummyInput) + t(2)**2*(-u1%DummyInput + u3%DummyInput))* scaleFactor + c = ( (t(2)-t(3))*u1%DummyInput + t(3)*u2%DummyInput - t(2)*u3%DummyInput ) * scaleFactor + u_out%DummyInput = u1%DummyInput + b + c * t_out END SUBROUTINE Waves2_Input_ExtrapInterp2 @@ -3761,12 +3706,12 @@ SUBROUTINE Waves2_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Err REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! 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 :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -3779,13 +3724,13 @@ SUBROUTINE Waves2_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END IF ! check if allocated END SUBROUTINE Waves2_Output_ExtrapInterp1 @@ -3816,13 +3761,14 @@ SUBROUTINE Waves2_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -3841,14 +3787,14 @@ SUBROUTINE Waves2_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END IF ! check if allocated END SUBROUTINE Waves2_Output_ExtrapInterp2 diff --git a/modules/hydrodyn/src/Waves_Types.f90 b/modules/hydrodyn/src/Waves_Types.f90 index e5ecef1ea4..ede51633d8 100644 --- a/modules/hydrodyn/src/Waves_Types.f90 +++ b/modules/hydrodyn/src/Waves_Types.f90 @@ -471,76 +471,78 @@ SUBROUTINE Waves_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%DirRoot) - IntKiBuf(Int_Xferred) = ICHAR(InData%DirRoot(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%WvKinFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%WvKinFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%WriteWvKin , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UnSum - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MSL2SWL - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WvLowCOff - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WvHiCOff - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WaveDir - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WaveNDir - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%WaveMultiDir , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WaveDirMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WaveDirSpread - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WaveDirRange - Re_Xferred = Re_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%WaveDT - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WaveHs - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WaveMod - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%WaveModChr) - IntKiBuf(Int_Xferred) = ICHAR(InData%WaveModChr(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%WaveNDAmp , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WavePhase - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WavePkShp - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%WavePkShpChr) - IntKiBuf(Int_Xferred) = ICHAR(InData%WavePkShpChr(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%WaveSeed))-1 ) = PACK(InData%WaveSeed,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%WaveSeed) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WaveStMod - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%WaveTMax - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WaveTp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NWaveElev - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%InputFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%DirRoot) + IntKiBuf(Int_Xferred) = ICHAR(InData%DirRoot(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%WvKinFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%WvKinFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%WriteWvKin, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%UnSum + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Gravity + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MSL2SWL + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WvLowCOff + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WvHiCOff + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WaveDir + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WaveNDir + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%WaveMultiDir, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WaveDirMod + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WaveDirSpread + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WaveDirRange + Re_Xferred = Re_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%WaveDT + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WaveHs + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WaveMod + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%WaveModChr) + IntKiBuf(Int_Xferred) = ICHAR(InData%WaveModChr(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%WaveNDAmp, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WavePhase + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WavePkShp + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(InData%WavePkShpChr) + IntKiBuf(Int_Xferred) = ICHAR(InData%WavePkShpChr(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO i1 = LBOUND(InData%WaveSeed,1), UBOUND(InData%WaveSeed,1) + IntKiBuf(Int_Xferred) = InData%WaveSeed(i1) + Int_Xferred = Int_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%WaveStMod + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%WaveTMax + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WaveTp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDens + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDpth + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NWaveElev + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveElevxi) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -551,8 +553,10 @@ SUBROUTINE Waves_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevxi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElevxi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElevxi))-1 ) = PACK(InData%WaveElevxi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElevxi) + DO i1 = LBOUND(InData%WaveElevxi,1), UBOUND(InData%WaveElevxi,1) + ReKiBuf(Re_Xferred) = InData%WaveElevxi(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveElevyi) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -564,8 +568,10 @@ SUBROUTINE Waves_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevyi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElevyi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElevyi))-1 ) = PACK(InData%WaveElevyi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElevyi) + DO i1 = LBOUND(InData%WaveElevyi,1), UBOUND(InData%WaveElevyi,1) + ReKiBuf(Re_Xferred) = InData%WaveElevyi(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveElevXY) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -580,11 +586,15 @@ SUBROUTINE Waves_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevXY,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElevXY)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElevXY))-1 ) = PACK(InData%WaveElevXY,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElevXY) + DO i2 = LBOUND(InData%WaveElevXY,2), UBOUND(InData%WaveElevXY,2) + DO i1 = LBOUND(InData%WaveElevXY,1), UBOUND(InData%WaveElevXY,1) + ReKiBuf(Re_Xferred) = InData%WaveElevXY(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NWaveKin - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NWaveKin + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveKinxi) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -595,8 +605,10 @@ SUBROUTINE Waves_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveKinxi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveKinxi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveKinxi))-1 ) = PACK(InData%WaveKinxi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveKinxi) + DO i1 = LBOUND(InData%WaveKinxi,1), UBOUND(InData%WaveKinxi,1) + ReKiBuf(Re_Xferred) = InData%WaveKinxi(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveKinyi) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -608,8 +620,10 @@ SUBROUTINE Waves_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveKinyi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveKinyi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveKinyi))-1 ) = PACK(InData%WaveKinyi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveKinyi) + DO i1 = LBOUND(InData%WaveKinyi,1), UBOUND(InData%WaveKinyi,1) + ReKiBuf(Re_Xferred) = InData%WaveKinyi(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveKinzi) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -621,8 +635,10 @@ SUBROUTINE Waves_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveKinzi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveKinzi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveKinzi))-1 ) = PACK(InData%WaveKinzi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveKinzi) + DO i1 = LBOUND(InData%WaveKinzi,1), UBOUND(InData%WaveKinzi,1) + ReKiBuf(Re_Xferred) = InData%WaveKinzi(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%CurrVxi) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -634,8 +650,10 @@ SUBROUTINE Waves_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CurrVxi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CurrVxi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CurrVxi))-1 ) = PACK(InData%CurrVxi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CurrVxi) + DO i1 = LBOUND(InData%CurrVxi,1), UBOUND(InData%CurrVxi,1) + ReKiBuf(Re_Xferred) = InData%CurrVxi(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%CurrVyi) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -647,13 +665,15 @@ SUBROUTINE Waves_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CurrVyi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CurrVyi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CurrVyi))-1 ) = PACK(InData%CurrVyi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CurrVyi) + DO i1 = LBOUND(InData%CurrVyi,1), UBOUND(InData%CurrVyi,1) + ReKiBuf(Re_Xferred) = InData%CurrVyi(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PCurrVxiPz0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PCurrVyiPz0 - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PCurrVxiPz0 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PCurrVyiPz0 + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Waves_PackInitInput SUBROUTINE Waves_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -669,12 +689,6 @@ SUBROUTINE Waves_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -691,85 +705,80 @@ SUBROUTINE Waves_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%DirRoot) - OutData%DirRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%WvKinFile) - OutData%WvKinFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%WriteWvKin = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%UnSum = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%Gravity = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MSL2SWL = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WvLowCOff = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WvHiCOff = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveDir = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveNDir = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%WaveMultiDir = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%WaveDirMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%WaveDirSpread = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveDirRange = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveDT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%WaveHs = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%WaveModChr) - OutData%WaveModChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%WaveNDAmp = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%WavePhase = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WavePkShp = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%WavePkShpChr) - OutData%WavePkShpChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%InputFile) + OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%DirRoot) + OutData%DirRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%WvKinFile) + OutData%WvKinFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%WriteWvKin = TRANSFER(IntKiBuf(Int_Xferred), OutData%WriteWvKin) + Int_Xferred = Int_Xferred + 1 + OutData%UnSum = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Gravity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MSL2SWL = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WvLowCOff = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WvHiCOff = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WaveDir = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WaveNDir = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WaveMultiDir = TRANSFER(IntKiBuf(Int_Xferred), OutData%WaveMultiDir) + Int_Xferred = Int_Xferred + 1 + OutData%WaveDirMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WaveDirSpread = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WaveDirRange = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WaveDT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%WaveHs = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WaveMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%WaveModChr) + OutData%WaveModChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%WaveNDAmp = TRANSFER(IntKiBuf(Int_Xferred), OutData%WaveNDAmp) + Int_Xferred = Int_Xferred + 1 + OutData%WavePhase = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WavePkShp = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(OutData%WavePkShpChr) + OutData%WavePkShpChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I i1_l = LBOUND(OutData%WaveSeed,1) i1_u = UBOUND(OutData%WaveSeed,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%WaveSeed = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%WaveSeed))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%WaveSeed) - DEALLOCATE(mask1) - OutData%WaveStMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%WaveTMax = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%WaveTp = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDens = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDpth = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%NWaveElev = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%WaveSeed,1), UBOUND(OutData%WaveSeed,1) + OutData%WaveSeed(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + OutData%WaveStMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WaveTMax = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%WaveTp = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WtrDens = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WtrDpth = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%NWaveElev = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevxi not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -783,15 +792,10 @@ SUBROUTINE Waves_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevxi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveElevxi)>0) OutData%WaveElevxi = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElevxi))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElevxi) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveElevxi,1), UBOUND(OutData%WaveElevxi,1) + OutData%WaveElevxi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevyi not allocated Int_Xferred = Int_Xferred + 1 @@ -806,15 +810,10 @@ SUBROUTINE Waves_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevyi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveElevyi)>0) OutData%WaveElevyi = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElevyi))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElevyi) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveElevyi,1), UBOUND(OutData%WaveElevyi,1) + OutData%WaveElevyi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevXY not allocated Int_Xferred = Int_Xferred + 1 @@ -832,18 +831,15 @@ SUBROUTINE Waves_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevXY.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveElevXY)>0) OutData%WaveElevXY = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElevXY))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElevXY) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveElevXY,2), UBOUND(OutData%WaveElevXY,2) + DO i1 = LBOUND(OutData%WaveElevXY,1), UBOUND(OutData%WaveElevXY,1) + OutData%WaveElevXY(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%NWaveKin = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NWaveKin = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveKinxi not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -857,15 +853,10 @@ SUBROUTINE Waves_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinxi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveKinxi)>0) OutData%WaveKinxi = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveKinxi))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveKinxi) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveKinxi,1), UBOUND(OutData%WaveKinxi,1) + OutData%WaveKinxi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveKinyi not allocated Int_Xferred = Int_Xferred + 1 @@ -880,15 +871,10 @@ SUBROUTINE Waves_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinyi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveKinyi)>0) OutData%WaveKinyi = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveKinyi))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveKinyi) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveKinyi,1), UBOUND(OutData%WaveKinyi,1) + OutData%WaveKinyi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveKinzi not allocated Int_Xferred = Int_Xferred + 1 @@ -903,15 +889,10 @@ SUBROUTINE Waves_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinzi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveKinzi)>0) OutData%WaveKinzi = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveKinzi))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveKinzi) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveKinzi,1), UBOUND(OutData%WaveKinzi,1) + OutData%WaveKinzi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CurrVxi not allocated Int_Xferred = Int_Xferred + 1 @@ -926,15 +907,10 @@ SUBROUTINE Waves_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CurrVxi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%CurrVxi)>0) OutData%CurrVxi = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CurrVxi))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%CurrVxi) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%CurrVxi,1), UBOUND(OutData%CurrVxi,1) + OutData%CurrVxi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CurrVyi not allocated Int_Xferred = Int_Xferred + 1 @@ -949,20 +925,15 @@ SUBROUTINE Waves_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CurrVyi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%CurrVyi)>0) OutData%CurrVyi = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CurrVyi))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%CurrVyi) - DEALLOCATE(mask1) - END IF - OutData%PCurrVxiPz0 = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%PCurrVyiPz0 = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%CurrVyi,1), UBOUND(OutData%CurrVyi,1) + OutData%CurrVyi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%PCurrVxiPz0 = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%PCurrVyiPz0 = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Waves_UnPackInitInput SUBROUTINE Waves_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -1398,8 +1369,12 @@ SUBROUTINE Waves_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC0,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElevC0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElevC0))-1 ) = PACK(InData%WaveElevC0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElevC0) + DO i2 = LBOUND(InData%WaveElevC0,2), UBOUND(InData%WaveElevC0,2) + DO i1 = LBOUND(InData%WaveElevC0,1), UBOUND(InData%WaveElevC0,1) + ReKiBuf(Re_Xferred) = InData%WaveElevC0(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveDirArr) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1411,21 +1386,23 @@ SUBROUTINE Waves_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDirArr,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveDirArr)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveDirArr))-1 ) = PACK(InData%WaveDirArr,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveDirArr) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WaveDirMin - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WaveDirMax - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WaveDir - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WaveNDir - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%WaveMultiDir , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WaveDOmega - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%WaveDirArr,1), UBOUND(InData%WaveDirArr,1) + ReKiBuf(Re_Xferred) = InData%WaveDirArr(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%WaveDirMin + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WaveDirMax + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WaveDir + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WaveNDir + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%WaveMultiDir, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WaveDOmega + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveKinzi) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1436,8 +1413,10 @@ SUBROUTINE Waves_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveKinzi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveKinzi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveKinzi))-1 ) = PACK(InData%WaveKinzi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveKinzi) + DO i1 = LBOUND(InData%WaveKinzi,1), UBOUND(InData%WaveKinzi,1) + ReKiBuf(Re_Xferred) = InData%WaveKinzi(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%PWaveDynP0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1452,8 +1431,12 @@ SUBROUTINE Waves_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveDynP0,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PWaveDynP0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PWaveDynP0))-1 ) = PACK(InData%PWaveDynP0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PWaveDynP0) + DO i2 = LBOUND(InData%PWaveDynP0,2), UBOUND(InData%PWaveDynP0,2) + DO i1 = LBOUND(InData%PWaveDynP0,1), UBOUND(InData%PWaveDynP0,1) + ReKiBuf(Re_Xferred) = InData%PWaveDynP0(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveDynP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1468,8 +1451,12 @@ SUBROUTINE Waves_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveDynP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveDynP))-1 ) = PACK(InData%WaveDynP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveDynP) + DO i2 = LBOUND(InData%WaveDynP,2), UBOUND(InData%WaveDynP,2) + DO i1 = LBOUND(InData%WaveDynP,1), UBOUND(InData%WaveDynP,1) + ReKiBuf(Re_Xferred) = InData%WaveDynP(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveAcc) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1487,8 +1474,14 @@ SUBROUTINE Waves_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveAcc)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveAcc))-1 ) = PACK(InData%WaveAcc,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveAcc) + DO i3 = LBOUND(InData%WaveAcc,3), UBOUND(InData%WaveAcc,3) + DO i2 = LBOUND(InData%WaveAcc,2), UBOUND(InData%WaveAcc,2) + DO i1 = LBOUND(InData%WaveAcc,1), UBOUND(InData%WaveAcc,1) + ReKiBuf(Re_Xferred) = InData%WaveAcc(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PWaveAcc0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1506,8 +1499,14 @@ SUBROUTINE Waves_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAcc0,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PWaveAcc0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PWaveAcc0))-1 ) = PACK(InData%PWaveAcc0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PWaveAcc0) + DO i3 = LBOUND(InData%PWaveAcc0,3), UBOUND(InData%PWaveAcc0,3) + DO i2 = LBOUND(InData%PWaveAcc0,2), UBOUND(InData%PWaveAcc0,2) + DO i1 = LBOUND(InData%PWaveAcc0,1), UBOUND(InData%PWaveAcc0,1) + ReKiBuf(Re_Xferred) = InData%PWaveAcc0(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveVel) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1525,8 +1524,14 @@ SUBROUTINE Waves_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveVel)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveVel))-1 ) = PACK(InData%WaveVel,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveVel) + DO i3 = LBOUND(InData%WaveVel,3), UBOUND(InData%WaveVel,3) + DO i2 = LBOUND(InData%WaveVel,2), UBOUND(InData%WaveVel,2) + DO i1 = LBOUND(InData%WaveVel,1), UBOUND(InData%WaveVel,1) + ReKiBuf(Re_Xferred) = InData%WaveVel(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PWaveVel0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1544,8 +1549,14 @@ SUBROUTINE Waves_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveVel0,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PWaveVel0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PWaveVel0))-1 ) = PACK(InData%PWaveVel0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PWaveVel0) + DO i3 = LBOUND(InData%PWaveVel0,3), UBOUND(InData%PWaveVel0,3) + DO i2 = LBOUND(InData%PWaveVel0,2), UBOUND(InData%PWaveVel0,2) + DO i1 = LBOUND(InData%PWaveVel0,1), UBOUND(InData%PWaveVel0,1) + ReKiBuf(Re_Xferred) = InData%PWaveVel0(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveElev) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1560,8 +1571,12 @@ SUBROUTINE Waves_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElev)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElev))-1 ) = PACK(InData%WaveElev,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElev) + DO i2 = LBOUND(InData%WaveElev,2), UBOUND(InData%WaveElev,2) + DO i1 = LBOUND(InData%WaveElev,1), UBOUND(InData%WaveElev,1) + ReKiBuf(Re_Xferred) = InData%WaveElev(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveElev0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1573,8 +1588,10 @@ SUBROUTINE Waves_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev0,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElev0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElev0))-1 ) = PACK(InData%WaveElev0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElev0) + DO i1 = LBOUND(InData%WaveElev0,1), UBOUND(InData%WaveElev0,1) + ReKiBuf(Re_Xferred) = InData%WaveElev0(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveElevSeries) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1589,8 +1606,12 @@ SUBROUTINE Waves_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevSeries,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElevSeries)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElevSeries))-1 ) = PACK(InData%WaveElevSeries,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElevSeries) + DO i2 = LBOUND(InData%WaveElevSeries,2), UBOUND(InData%WaveElevSeries,2) + DO i1 = LBOUND(InData%WaveElevSeries,1), UBOUND(InData%WaveElevSeries,1) + ReKiBuf(Re_Xferred) = InData%WaveElevSeries(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1602,11 +1623,13 @@ SUBROUTINE Waves_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveTime)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveTime))-1 ) = PACK(InData%WaveTime,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveTime) + DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) + ReKiBuf(Re_Xferred) = InData%WaveTime(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%WaveTMax - Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%WaveTMax + Db_Xferred = Db_Xferred + 1 IF ( .NOT. ALLOCATED(InData%nodeInWater) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1620,15 +1643,19 @@ SUBROUTINE Waves_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%nodeInWater,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%nodeInWater)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%nodeInWater))-1 ) = PACK(InData%nodeInWater,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%nodeInWater) + DO i2 = LBOUND(InData%nodeInWater,2), UBOUND(InData%nodeInWater,2) + DO i1 = LBOUND(InData%nodeInWater,1), UBOUND(InData%nodeInWater,1) + IntKiBuf(Int_Xferred) = InData%nodeInWater(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RhoXg - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepWave2 - Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RhoXg + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepWave + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepWave2 + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Waves_PackInitOutput SUBROUTINE Waves_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1644,12 +1671,6 @@ SUBROUTINE Waves_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -1682,15 +1703,12 @@ SUBROUTINE Waves_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveElevC0)>0) OutData%WaveElevC0 = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElevC0))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElevC0) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveElevC0,2), UBOUND(OutData%WaveElevC0,2) + DO i1 = LBOUND(OutData%WaveElevC0,1), UBOUND(OutData%WaveElevC0,1) + OutData%WaveElevC0(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDirArr not allocated Int_Xferred = Int_Xferred + 1 @@ -1705,28 +1723,23 @@ SUBROUTINE Waves_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDirArr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveDirArr)>0) OutData%WaveDirArr = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveDirArr))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveDirArr) - DEALLOCATE(mask1) - END IF - OutData%WaveDirMin = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveDirMax = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveDir = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveNDir = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%WaveMultiDir = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%WaveDOmega = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%WaveDirArr,1), UBOUND(OutData%WaveDirArr,1) + OutData%WaveDirArr(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%WaveDirMin = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WaveDirMax = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WaveDir = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WaveNDir = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WaveMultiDir = TRANSFER(IntKiBuf(Int_Xferred), OutData%WaveMultiDir) + Int_Xferred = Int_Xferred + 1 + OutData%WaveDOmega = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveKinzi not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1740,15 +1753,10 @@ SUBROUTINE Waves_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinzi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveKinzi)>0) OutData%WaveKinzi = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveKinzi))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveKinzi) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveKinzi,1), UBOUND(OutData%WaveKinzi,1) + OutData%WaveKinzi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PWaveDynP0 not allocated Int_Xferred = Int_Xferred + 1 @@ -1766,15 +1774,12 @@ SUBROUTINE Waves_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveDynP0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PWaveDynP0)>0) OutData%PWaveDynP0 = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PWaveDynP0))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%PWaveDynP0) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PWaveDynP0,2), UBOUND(OutData%PWaveDynP0,2) + DO i1 = LBOUND(OutData%PWaveDynP0,1), UBOUND(OutData%PWaveDynP0,1) + OutData%PWaveDynP0(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDynP not allocated Int_Xferred = Int_Xferred + 1 @@ -1792,15 +1797,12 @@ SUBROUTINE Waves_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveDynP)>0) OutData%WaveDynP = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveDynP))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveDynP) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveDynP,2), UBOUND(OutData%WaveDynP,2) + DO i1 = LBOUND(OutData%WaveDynP,1), UBOUND(OutData%WaveDynP,1) + OutData%WaveDynP(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAcc not allocated Int_Xferred = Int_Xferred + 1 @@ -1821,15 +1823,14 @@ SUBROUTINE Waves_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%WaveAcc)>0) OutData%WaveAcc = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveAcc))-1 ), mask3, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveAcc) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%WaveAcc,3), UBOUND(OutData%WaveAcc,3) + DO i2 = LBOUND(OutData%WaveAcc,2), UBOUND(OutData%WaveAcc,2) + DO i1 = LBOUND(OutData%WaveAcc,1), UBOUND(OutData%WaveAcc,1) + OutData%WaveAcc(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PWaveAcc0 not allocated Int_Xferred = Int_Xferred + 1 @@ -1850,15 +1851,14 @@ SUBROUTINE Waves_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveAcc0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PWaveAcc0)>0) OutData%PWaveAcc0 = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PWaveAcc0))-1 ), mask3, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%PWaveAcc0) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PWaveAcc0,3), UBOUND(OutData%PWaveAcc0,3) + DO i2 = LBOUND(OutData%PWaveAcc0,2), UBOUND(OutData%PWaveAcc0,2) + DO i1 = LBOUND(OutData%PWaveAcc0,1), UBOUND(OutData%PWaveAcc0,1) + OutData%PWaveAcc0(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel not allocated Int_Xferred = Int_Xferred + 1 @@ -1879,15 +1879,14 @@ SUBROUTINE Waves_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%WaveVel)>0) OutData%WaveVel = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveVel))-1 ), mask3, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveVel) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%WaveVel,3), UBOUND(OutData%WaveVel,3) + DO i2 = LBOUND(OutData%WaveVel,2), UBOUND(OutData%WaveVel,2) + DO i1 = LBOUND(OutData%WaveVel,1), UBOUND(OutData%WaveVel,1) + OutData%WaveVel(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PWaveVel0 not allocated Int_Xferred = Int_Xferred + 1 @@ -1908,15 +1907,14 @@ SUBROUTINE Waves_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveVel0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PWaveVel0)>0) OutData%PWaveVel0 = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PWaveVel0))-1 ), mask3, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%PWaveVel0) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PWaveVel0,3), UBOUND(OutData%PWaveVel0,3) + DO i2 = LBOUND(OutData%PWaveVel0,2), UBOUND(OutData%PWaveVel0,2) + DO i1 = LBOUND(OutData%PWaveVel0,1), UBOUND(OutData%PWaveVel0,1) + OutData%PWaveVel0(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev not allocated Int_Xferred = Int_Xferred + 1 @@ -1934,15 +1932,12 @@ SUBROUTINE Waves_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveElev)>0) OutData%WaveElev = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElev))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElev) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveElev,2), UBOUND(OutData%WaveElev,2) + DO i1 = LBOUND(OutData%WaveElev,1), UBOUND(OutData%WaveElev,1) + OutData%WaveElev(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev0 not allocated Int_Xferred = Int_Xferred + 1 @@ -1957,15 +1952,10 @@ SUBROUTINE Waves_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveElev0)>0) OutData%WaveElev0 = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElev0))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElev0) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveElev0,1), UBOUND(OutData%WaveElev0,1) + OutData%WaveElev0(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevSeries not allocated Int_Xferred = Int_Xferred + 1 @@ -1983,15 +1973,12 @@ SUBROUTINE Waves_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevSeries.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveElevSeries)>0) OutData%WaveElevSeries = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElevSeries))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElevSeries) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveElevSeries,2), UBOUND(OutData%WaveElevSeries,2) + DO i1 = LBOUND(OutData%WaveElevSeries,1), UBOUND(OutData%WaveElevSeries,1) + OutData%WaveElevSeries(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated Int_Xferred = Int_Xferred + 1 @@ -2006,18 +1993,13 @@ SUBROUTINE Waves_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveTime)>0) OutData%WaveTime = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveTime))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveTime) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) + OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%WaveTMax = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%WaveTMax = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! nodeInWater not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2034,22 +2016,19 @@ SUBROUTINE Waves_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%nodeInWater.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%nodeInWater)>0) OutData%nodeInWater = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%nodeInWater))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%nodeInWater) - DEALLOCATE(mask2) - END IF - OutData%RhoXg = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%NStepWave = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NStepWave2 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(OutData%nodeInWater,2), UBOUND(OutData%nodeInWater,2) + DO i1 = LBOUND(OutData%nodeInWater,1), UBOUND(OutData%nodeInWater,1) + OutData%nodeInWater(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + OutData%RhoXg = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%NStepWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NStepWave2 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Waves_UnPackInitOutput SUBROUTINE Waves_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) @@ -2143,8 +2122,8 @@ SUBROUTINE Waves_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyContState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyContState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Waves_PackContState SUBROUTINE Waves_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2160,12 +2139,6 @@ SUBROUTINE Waves_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Waves_UnPackContState' @@ -2179,8 +2152,8 @@ SUBROUTINE Waves_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyContState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyContState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Waves_UnPackContState SUBROUTINE Waves_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) @@ -2274,8 +2247,8 @@ SUBROUTINE Waves_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyDiscState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Waves_PackDiscState SUBROUTINE Waves_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2291,12 +2264,6 @@ SUBROUTINE Waves_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Waves_UnPackDiscState' @@ -2310,8 +2277,8 @@ SUBROUTINE Waves_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyDiscState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyDiscState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Waves_UnPackDiscState SUBROUTINE Waves_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -2405,8 +2372,8 @@ SUBROUTINE Waves_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyConstrState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Waves_PackConstrState SUBROUTINE Waves_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2422,12 +2389,6 @@ SUBROUTINE Waves_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Waves_UnPackConstrState' @@ -2441,8 +2402,8 @@ SUBROUTINE Waves_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyConstrState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyConstrState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Waves_UnPackConstrState SUBROUTINE Waves_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -2536,8 +2497,8 @@ SUBROUTINE Waves_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DummyOtherState - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DummyOtherState + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Waves_PackOtherState SUBROUTINE Waves_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2553,12 +2514,6 @@ SUBROUTINE Waves_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Waves_UnPackOtherState' @@ -2572,8 +2527,8 @@ SUBROUTINE Waves_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyOtherState = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%DummyOtherState = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Waves_UnPackOtherState SUBROUTINE Waves_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -2667,8 +2622,8 @@ SUBROUTINE Waves_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DummyMiscVar - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DummyMiscVar + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Waves_PackMisc SUBROUTINE Waves_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2684,12 +2639,6 @@ SUBROUTINE Waves_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Waves_UnPackMisc' @@ -2703,8 +2652,8 @@ SUBROUTINE Waves_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyMiscVar = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%DummyMiscVar = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Waves_UnPackMisc SUBROUTINE Waves_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -2806,16 +2755,16 @@ SUBROUTINE Waves_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%WaveTMax - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WaveNDir - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%WaveMultiDir , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%WaveTMax + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepWave + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WaveNDir + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%WaveMultiDir, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Waves_PackParam SUBROUTINE Waves_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2831,12 +2780,6 @@ SUBROUTINE Waves_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Waves_UnPackParam' @@ -2850,16 +2793,16 @@ SUBROUTINE Waves_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%WaveTMax = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%NStepWave = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%WaveNDir = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%WaveMultiDir = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%WaveTMax = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%NStepWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WaveNDir = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WaveMultiDir = TRANSFER(IntKiBuf(Int_Xferred), OutData%WaveMultiDir) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Waves_UnPackParam SUBROUTINE Waves_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -2953,8 +2896,8 @@ SUBROUTINE Waves_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyInput - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyInput + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Waves_PackInput SUBROUTINE Waves_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2970,12 +2913,6 @@ SUBROUTINE Waves_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Waves_UnPackInput' @@ -2989,8 +2926,8 @@ SUBROUTINE Waves_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyInput = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyInput = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Waves_UnPackInput SUBROUTINE Waves_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -3084,8 +3021,8 @@ SUBROUTINE Waves_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyOutput - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyOutput + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Waves_PackOutput SUBROUTINE Waves_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -3101,12 +3038,6 @@ SUBROUTINE Waves_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Waves_UnPackOutput' @@ -3120,8 +3051,8 @@ SUBROUTINE Waves_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyOutput = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyOutput = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Waves_UnPackOutput @@ -3199,8 +3130,8 @@ SUBROUTINE Waves_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMs REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'Waves_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -3215,8 +3146,10 @@ SUBROUTINE Waves_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = -(u1%DummyInput - u2%DummyInput)/t(2) - u_out%DummyInput = u1%DummyInput + b0 * t_out + + ScaleFactor = t_out / t(2) + b = -(u1%DummyInput - u2%DummyInput) + u_out%DummyInput = u1%DummyInput + b * ScaleFactor END SUBROUTINE Waves_Input_ExtrapInterp1 @@ -3246,8 +3179,9 @@ SUBROUTINE Waves_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, E REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'Waves_Input_ExtrapInterp2' @@ -3269,9 +3203,11 @@ SUBROUTINE Waves_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, E CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = (t(3)**2*(u1%DummyInput - u2%DummyInput) + t(2)**2*(-u1%DummyInput + u3%DummyInput))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%DummyInput + t(3)*u2%DummyInput - t(2)*u3%DummyInput ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%DummyInput = u1%DummyInput + b0 * t_out + c0 * t_out**2 + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) + b = (t(3)**2*(u1%DummyInput - u2%DummyInput) + t(2)**2*(-u1%DummyInput + u3%DummyInput))* scaleFactor + c = ( (t(2)-t(3))*u1%DummyInput + t(3)*u2%DummyInput - t(2)*u3%DummyInput ) * scaleFactor + u_out%DummyInput = u1%DummyInput + b + c * t_out END SUBROUTINE Waves_Input_ExtrapInterp2 @@ -3349,8 +3285,8 @@ SUBROUTINE Waves_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrM REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'Waves_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -3365,8 +3301,10 @@ SUBROUTINE Waves_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = -(y1%DummyOutput - y2%DummyOutput)/t(2) - y_out%DummyOutput = y1%DummyOutput + b0 * t_out + + ScaleFactor = t_out / t(2) + b = -(y1%DummyOutput - y2%DummyOutput) + y_out%DummyOutput = y1%DummyOutput + b * ScaleFactor END SUBROUTINE Waves_Output_ExtrapInterp1 @@ -3396,8 +3334,9 @@ SUBROUTINE Waves_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'Waves_Output_ExtrapInterp2' @@ -3419,9 +3358,11 @@ SUBROUTINE Waves_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = (t(3)**2*(y1%DummyOutput - y2%DummyOutput) + t(2)**2*(-y1%DummyOutput + y3%DummyOutput))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%DummyOutput + t(3)*y2%DummyOutput - t(2)*y3%DummyOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%DummyOutput = y1%DummyOutput + b0 * t_out + c0 * t_out**2 + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) + b = (t(3)**2*(y1%DummyOutput - y2%DummyOutput) + t(2)**2*(-y1%DummyOutput + y3%DummyOutput))* scaleFactor + c = ( (t(2)-t(3))*y1%DummyOutput + t(3)*y2%DummyOutput - t(2)*y3%DummyOutput ) * scaleFactor + y_out%DummyOutput = y1%DummyOutput + b + c * t_out END SUBROUTINE Waves_Output_ExtrapInterp2 END MODULE Waves_Types diff --git a/modules/icedyn/src/IceDyn_Types.f90 b/modules/icedyn/src/IceDyn_Types.f90 index cdc9cf05c0..5a676fa8b3 100644 --- a/modules/icedyn/src/IceDyn_Types.f90 +++ b/modules/icedyn/src/IceDyn_Types.f90 @@ -489,28 +489,28 @@ SUBROUTINE IceD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%IceModel - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%IceSubModel - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%h - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%v - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%InitLoc - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%t0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rhow - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rhoi - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Seed1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Seed2 - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumLegs - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%IceModel + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%IceSubModel + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%h + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%v + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%InitLoc + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%t0 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rhow + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rhoi + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Seed1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Seed2 + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumLegs + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%LegPosX) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -521,8 +521,10 @@ SUBROUTINE IceD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LegPosX,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LegPosX)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LegPosX))-1 ) = PACK(InData%LegPosX,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LegPosX) + DO i1 = LBOUND(InData%LegPosX,1), UBOUND(InData%LegPosX,1) + ReKiBuf(Re_Xferred) = InData%LegPosX(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LegPosY) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -534,8 +536,10 @@ SUBROUTINE IceD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LegPosY,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LegPosY)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LegPosY))-1 ) = PACK(InData%LegPosY,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LegPosY) + DO i1 = LBOUND(InData%LegPosY,1), UBOUND(InData%LegPosY,1) + ReKiBuf(Re_Xferred) = InData%LegPosY(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%StrWd) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -547,101 +551,103 @@ SUBROUTINE IceD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StrWd,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%StrWd)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%StrWd))-1 ) = PACK(InData%StrWd,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%StrWd) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Ikm - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Ag - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Qg - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Rg - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Tice - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%nu - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%phi - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SigNm - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Eice - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%IceStr2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Delmax2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Pitch - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%miuh - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%varh - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%miuv - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%varv - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%miut - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%miubr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%varbr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%miuDelm - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%varDelm - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%miuP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%varP - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Zn1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Zn2 - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ZonePitch - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PrflMean - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PrflSig - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%IceStr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Delmax - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%alpha - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Dwl - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Dtp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%hr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%mu - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%sigf - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%StrLim - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%StrRtLim - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UorD - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Ll - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Lw - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cpa - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dpa - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Fdr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Kic - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FspN - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%StrWd,1), UBOUND(InData%StrWd,1) + ReKiBuf(Re_Xferred) = InData%StrWd(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%Ikm + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Ag + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Qg + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Rg + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Tice + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%nu + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%phi + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SigNm + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Eice + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%IceStr2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Delmax2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Pitch + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%miuh + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%varh + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%miuv + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%varv + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%miut + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%miubr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%varbr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%miuDelm + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%varDelm + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%miuP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%varP + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Zn1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Zn2 + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ZonePitch + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PrflMean + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PrflSig + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%IceStr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Delmax + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%alpha + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Dwl + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Dtp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%hr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%mu + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%sigf + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%StrLim + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%StrRtLim + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%UorD + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Ll + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Lw + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cpa + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dpa + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Fdr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Kic + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FspN + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IceD_PackInputFile SUBROUTINE IceD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -657,12 +663,6 @@ SUBROUTINE IceD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -677,28 +677,28 @@ SUBROUTINE IceD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%IceModel = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%IceSubModel = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%h = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%v = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%InitLoc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%t0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rhow = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rhoi = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Seed1 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%Seed2 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumLegs = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%IceModel = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%IceSubModel = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%h = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%v = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%InitLoc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%t0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rhow = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rhoi = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Seed1 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Seed2 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumLegs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LegPosX not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -712,15 +712,10 @@ SUBROUTINE IceD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LegPosX.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LegPosX)>0) OutData%LegPosX = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LegPosX))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LegPosX) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LegPosX,1), UBOUND(OutData%LegPosX,1) + OutData%LegPosX(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LegPosY not allocated Int_Xferred = Int_Xferred + 1 @@ -735,15 +730,10 @@ SUBROUTINE IceD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LegPosY.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LegPosY)>0) OutData%LegPosY = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LegPosY))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LegPosY) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LegPosY,1), UBOUND(OutData%LegPosY,1) + OutData%LegPosY(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StrWd not allocated Int_Xferred = Int_Xferred + 1 @@ -758,108 +748,103 @@ SUBROUTINE IceD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StrWd.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%StrWd)>0) OutData%StrWd = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%StrWd))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%StrWd) - DEALLOCATE(mask1) - END IF - OutData%Ikm = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Ag = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Qg = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Rg = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Tice = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%nu = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%phi = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SigNm = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Eice = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%IceStr2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Delmax2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Pitch = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%miuh = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%varh = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%miuv = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%varv = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%miut = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%miubr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%varbr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%miuDelm = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%varDelm = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%miuP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%varP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Zn1 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%Zn2 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ZonePitch = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PrflMean = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PrflSig = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%IceStr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Delmax = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%alpha = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Dwl = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Dtp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%hr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%mu = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%sigf = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%StrLim = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%StrRtLim = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%UorD = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%Ll = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Lw = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cpa = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%dpa = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Fdr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Kic = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%FspN = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%StrWd,1), UBOUND(OutData%StrWd,1) + OutData%StrWd(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%Ikm = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Ag = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Qg = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Rg = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Tice = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%nu = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%phi = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SigNm = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Eice = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%IceStr2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Delmax2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Pitch = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%miuh = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%varh = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%miuv = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%varv = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%miut = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%miubr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%varbr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%miuDelm = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%varDelm = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%miuP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%varP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Zn1 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Zn2 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ZonePitch = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PrflMean = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PrflSig = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%IceStr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Delmax = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%alpha = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Dwl = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Dtp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%hr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%mu = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%sigf = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%StrLim = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%StrRtLim = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%UorD = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Ll = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Lw = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cpa = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%dpa = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Fdr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Kic = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%FspN = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IceD_UnPackInputFile SUBROUTINE IceD_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) @@ -965,24 +950,24 @@ SUBROUTINE IceD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MSL2SWL - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%gravity - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%LegNum - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TMax - Db_Xferred = Db_Xferred + 1 + DO I = 1, LEN(InData%InputFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + ReKiBuf(Re_Xferred) = InData%MSL2SWL + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDens + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%gravity + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%LegNum + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%TMax + Db_Xferred = Db_Xferred + 1 END SUBROUTINE IceD_PackInitInput SUBROUTINE IceD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -998,12 +983,6 @@ SUBROUTINE IceD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IceD_UnPackInitInput' @@ -1017,24 +996,24 @@ SUBROUTINE IceD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%MSL2SWL = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%gravity = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%LegNum = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TMax = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + DO I = 1, LEN(OutData%InputFile) + OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%MSL2SWL = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WtrDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%gravity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LegNum = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TMax = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 END SUBROUTINE IceD_UnPackInitInput SUBROUTINE IceD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -1201,12 +1180,12 @@ SUBROUTINE IceD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) + DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) DO I = 1, LEN(InData%WriteOutputHdr) IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdr(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1218,15 +1197,15 @@ SUBROUTINE IceD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) + DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) DO I = 1, LEN(InData%WriteOutputUnt) IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUnt(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%numLegs - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%numLegs + Int_Xferred = Int_Xferred + 1 CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1270,12 +1249,6 @@ SUBROUTINE IceD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1303,19 +1276,12 @@ SUBROUTINE IceD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) DO I = 1, LEN(OutData%WriteOutputHdr) OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated Int_Xferred = Int_Xferred + 1 @@ -1330,22 +1296,15 @@ SUBROUTINE IceD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) DO I = 1, LEN(OutData%WriteOutputUnt) OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF - OutData%numLegs = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%numLegs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -1481,10 +1440,10 @@ SUBROUTINE IceD_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%q - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dqdt - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%q + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dqdt + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IceD_PackContState SUBROUTINE IceD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1500,12 +1459,6 @@ SUBROUTINE IceD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IceD_UnPackContState' @@ -1519,10 +1472,10 @@ SUBROUTINE IceD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%q = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%dqdt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%q = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%dqdt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IceD_UnPackContState SUBROUTINE IceD_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) @@ -1616,8 +1569,8 @@ SUBROUTINE IceD_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyDiscState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IceD_PackDiscState SUBROUTINE IceD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1633,12 +1586,6 @@ SUBROUTINE IceD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IceD_UnPackDiscState' @@ -1652,8 +1599,8 @@ SUBROUTINE IceD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyDiscState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyDiscState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IceD_UnPackDiscState SUBROUTINE IceD_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -1747,8 +1694,8 @@ SUBROUTINE IceD_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyConstrState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IceD_PackConstrState SUBROUTINE IceD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1764,12 +1711,6 @@ SUBROUTINE IceD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IceD_UnPackConstrState' @@ -1783,8 +1724,8 @@ SUBROUTINE IceD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyConstrState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyConstrState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IceD_UnPackConstrState SUBROUTINE IceD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -1995,8 +1936,8 @@ SUBROUTINE IceD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%IceTthNo2 - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%IceTthNo2 + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%Nc) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2007,8 +1948,10 @@ SUBROUTINE IceD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nc,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Nc)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%Nc))-1 ) = PACK(InData%Nc,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%Nc) + DO i1 = LBOUND(InData%Nc,1), UBOUND(InData%Nc,1) + IntKiBuf(Int_Xferred) = InData%Nc(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%Psum) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2020,8 +1963,10 @@ SUBROUTINE IceD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Psum,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Psum)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Psum))-1 ) = PACK(InData%Psum,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Psum) + DO i1 = LBOUND(InData%Psum,1), UBOUND(InData%Psum,1) + ReKiBuf(Re_Xferred) = InData%Psum(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%IceTthNo) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2033,17 +1978,19 @@ SUBROUTINE IceD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IceTthNo,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%IceTthNo)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%IceTthNo))-1 ) = PACK(InData%IceTthNo,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%IceTthNo) + DO i1 = LBOUND(InData%IceTthNo,1), UBOUND(InData%IceTthNo,1) + IntKiBuf(Int_Xferred) = InData%IceTthNo(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Beta - Re_Xferred = Re_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%Tinit - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Splitf - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dxc - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Beta + Re_Xferred = Re_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%Tinit + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Splitf + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dxc + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%xdot) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2085,8 +2032,8 @@ SUBROUTINE IceD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%n - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%n + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IceD_PackOtherState SUBROUTINE IceD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2102,12 +2049,6 @@ SUBROUTINE IceD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -2122,8 +2063,8 @@ SUBROUTINE IceD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%IceTthNo2 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%IceTthNo2 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Nc not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2137,15 +2078,10 @@ SUBROUTINE IceD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nc.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Nc)>0) OutData%Nc = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%Nc))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%Nc) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Nc,1), UBOUND(OutData%Nc,1) + OutData%Nc(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Psum not allocated Int_Xferred = Int_Xferred + 1 @@ -2160,15 +2096,10 @@ SUBROUTINE IceD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Psum.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Psum)>0) OutData%Psum = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Psum))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Psum) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Psum,1), UBOUND(OutData%Psum,1) + OutData%Psum(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IceTthNo not allocated Int_Xferred = Int_Xferred + 1 @@ -2183,24 +2114,19 @@ SUBROUTINE IceD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IceTthNo.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%IceTthNo)>0) OutData%IceTthNo = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%IceTthNo))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%IceTthNo) - DEALLOCATE(mask1) - END IF - OutData%Beta = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Tinit = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%Splitf = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%dxc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%IceTthNo,1), UBOUND(OutData%IceTthNo,1) + OutData%IceTthNo(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + OutData%Beta = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Tinit = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%Splitf = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%dxc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xdot not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2257,8 +2183,8 @@ SUBROUTINE IceD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%n = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%n = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IceD_UnPackOtherState SUBROUTINE IceD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -2352,8 +2278,8 @@ SUBROUTINE IceD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DummyMiscVar - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DummyMiscVar + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IceD_PackMisc SUBROUTINE IceD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2369,12 +2295,6 @@ SUBROUTINE IceD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IceD_UnPackMisc' @@ -2388,8 +2308,8 @@ SUBROUTINE IceD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyMiscVar = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%DummyMiscVar = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IceD_UnPackMisc SUBROUTINE IceD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -2778,34 +2698,34 @@ SUBROUTINE IceD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%h - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%v - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%t0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%StrWd - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%InitLoc - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%tolerance - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Tmax - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%verif - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%ModNo - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%SubModNo - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%method - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TmStep - Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%h + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%v + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%t0 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%StrWd + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%InitLoc + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%tolerance + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Tmax + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%verif + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%ModNo + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%SubModNo + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%method + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TmStep + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%OutName) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2816,12 +2736,12 @@ SUBROUTINE IceD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutName,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%OutName,1), UBOUND(InData%OutName,1) + DO i1 = LBOUND(InData%OutName,1), UBOUND(InData%OutName,1) DO I = 1, LEN(InData%OutName) IntKiBuf(Int_Xferred) = ICHAR(InData%OutName(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%OutUnit) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2833,41 +2753,41 @@ SUBROUTINE IceD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutUnit,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%OutUnit,1), UBOUND(InData%OutUnit,1) + DO i1 = LBOUND(InData%OutUnit,1), UBOUND(InData%OutUnit,1) DO I = 1, LEN(InData%OutUnit) IntKiBuf(Int_Xferred) = ICHAR(InData%OutUnit(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%tm1a - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%tm1b - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%tm1c - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Fmax1a - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Fmax1b - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Fmax1c - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Ikm - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cstr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%EiPa - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Delmax2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Pitch - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Kice2 - Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + ReKiBuf(Re_Xferred) = InData%tm1a + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%tm1b + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%tm1c + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Fmax1a + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Fmax1b + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Fmax1c + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Ikm + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cstr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%EiPa + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Delmax2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Pitch + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Kice2 + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%rdmFm) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2878,8 +2798,10 @@ SUBROUTINE IceD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rdmFm,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rdmFm)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%rdmFm))-1 ) = PACK(InData%rdmFm,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%rdmFm) + DO i1 = LBOUND(InData%rdmFm,1), UBOUND(InData%rdmFm,1) + ReKiBuf(Re_Xferred) = InData%rdmFm(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%rdmt0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2891,8 +2813,10 @@ SUBROUTINE IceD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rdmt0,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rdmt0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%rdmt0))-1 ) = PACK(InData%rdmt0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%rdmt0) + DO i1 = LBOUND(InData%rdmt0,1), UBOUND(InData%rdmt0,1) + ReKiBuf(Re_Xferred) = InData%rdmt0(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%rdmtm) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2904,8 +2828,10 @@ SUBROUTINE IceD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rdmtm,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rdmtm)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%rdmtm))-1 ) = PACK(InData%rdmtm,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%rdmtm) + DO i1 = LBOUND(InData%rdmtm,1), UBOUND(InData%rdmtm,1) + ReKiBuf(Re_Xferred) = InData%rdmtm(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%rdmDm) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2917,8 +2843,10 @@ SUBROUTINE IceD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rdmDm,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rdmDm)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%rdmDm))-1 ) = PACK(InData%rdmDm,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%rdmDm) + DO i1 = LBOUND(InData%rdmDm,1), UBOUND(InData%rdmDm,1) + ReKiBuf(Re_Xferred) = InData%rdmDm(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%rdmP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2930,8 +2858,10 @@ SUBROUTINE IceD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rdmP,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rdmP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%rdmP))-1 ) = PACK(InData%rdmP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%rdmP) + DO i1 = LBOUND(InData%rdmP,1), UBOUND(InData%rdmP,1) + ReKiBuf(Re_Xferred) = InData%rdmP(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%rdmKi) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2943,15 +2873,17 @@ SUBROUTINE IceD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rdmKi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rdmKi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%rdmKi))-1 ) = PACK(InData%rdmKi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%rdmKi) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ZonePitch - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Kice - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Delmax - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%rdmKi,1), UBOUND(InData%rdmKi,1) + ReKiBuf(Re_Xferred) = InData%rdmKi(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%ZonePitch + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Kice + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Delmax + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%Y0) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2962,8 +2894,10 @@ SUBROUTINE IceD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Y0,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Y0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Y0))-1 ) = PACK(InData%Y0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Y0) + DO i1 = LBOUND(InData%Y0,1), UBOUND(InData%Y0,1) + ReKiBuf(Re_Xferred) = InData%Y0(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%ContPrfl) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2975,45 +2909,47 @@ SUBROUTINE IceD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ContPrfl,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ContPrfl)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%ContPrfl))-1 ) = PACK(InData%ContPrfl,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%ContPrfl) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Zn - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rhoi - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rhow - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%alphaR - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Dwl - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Zr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RHbr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RVbr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Lbr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%LovR - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%mu - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Wri - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WL - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cpa - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dpa - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FdrN - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Mice - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Fsp - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%ContPrfl,1), UBOUND(InData%ContPrfl,1) + ReKiBuf(Re_Xferred) = InData%ContPrfl(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = InData%Zn + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rhoi + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rhow + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%alphaR + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Dwl + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Zr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RHbr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RVbr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Lbr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%LovR + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%mu + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Wri + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WL + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cpa + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dpa + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FdrN + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Mice + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Fsp + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IceD_PackParam SUBROUTINE IceD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -3029,12 +2965,6 @@ SUBROUTINE IceD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -3049,34 +2979,34 @@ SUBROUTINE IceD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%h = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%v = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%t0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%StrWd = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%dt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%InitLoc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%tolerance = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Tmax = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%verif = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ModNo = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%SubModNo = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%method = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TmStep = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%h = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%v = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%t0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%StrWd = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%dt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%InitLoc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%tolerance = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Tmax = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%verif = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ModNo = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%SubModNo = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%method = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TmStep = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutName not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3090,19 +3020,12 @@ SUBROUTINE IceD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutName.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%OutName,1), UBOUND(OutData%OutName,1) + DO i1 = LBOUND(OutData%OutName,1), UBOUND(OutData%OutName,1) DO I = 1, LEN(OutData%OutName) OutData%OutName(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutUnit not allocated Int_Xferred = Int_Xferred + 1 @@ -3117,48 +3040,41 @@ SUBROUTINE IceD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutUnit.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%OutUnit,1), UBOUND(OutData%OutUnit,1) + DO i1 = LBOUND(OutData%OutUnit,1), UBOUND(OutData%OutUnit,1) DO I = 1, LEN(OutData%OutUnit) OutData%OutUnit(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%tm1a = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%tm1b = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%tm1c = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Fmax1a = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Fmax1b = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Fmax1c = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Ikm = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cstr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%EiPa = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Delmax2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Pitch = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Kice2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%tm1a = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%tm1b = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%tm1c = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Fmax1a = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Fmax1b = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Fmax1c = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Ikm = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cstr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%EiPa = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Delmax2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Pitch = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Kice2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rdmFm not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3172,15 +3088,10 @@ SUBROUTINE IceD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdmFm.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%rdmFm)>0) OutData%rdmFm = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%rdmFm))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%rdmFm) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rdmFm,1), UBOUND(OutData%rdmFm,1) + OutData%rdmFm(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rdmt0 not allocated Int_Xferred = Int_Xferred + 1 @@ -3195,15 +3106,10 @@ SUBROUTINE IceD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdmt0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%rdmt0)>0) OutData%rdmt0 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%rdmt0))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%rdmt0) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rdmt0,1), UBOUND(OutData%rdmt0,1) + OutData%rdmt0(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rdmtm not allocated Int_Xferred = Int_Xferred + 1 @@ -3218,15 +3124,10 @@ SUBROUTINE IceD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdmtm.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%rdmtm)>0) OutData%rdmtm = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%rdmtm))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%rdmtm) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rdmtm,1), UBOUND(OutData%rdmtm,1) + OutData%rdmtm(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rdmDm not allocated Int_Xferred = Int_Xferred + 1 @@ -3241,15 +3142,10 @@ SUBROUTINE IceD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdmDm.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%rdmDm)>0) OutData%rdmDm = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%rdmDm))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%rdmDm) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rdmDm,1), UBOUND(OutData%rdmDm,1) + OutData%rdmDm(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rdmP not allocated Int_Xferred = Int_Xferred + 1 @@ -3264,15 +3160,10 @@ SUBROUTINE IceD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdmP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%rdmP)>0) OutData%rdmP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%rdmP))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%rdmP) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rdmP,1), UBOUND(OutData%rdmP,1) + OutData%rdmP(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rdmKi not allocated Int_Xferred = Int_Xferred + 1 @@ -3287,22 +3178,17 @@ SUBROUTINE IceD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdmKi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%rdmKi)>0) OutData%rdmKi = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%rdmKi))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%rdmKi) - DEALLOCATE(mask1) - END IF - OutData%ZonePitch = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Kice = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Delmax = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%rdmKi,1), UBOUND(OutData%rdmKi,1) + OutData%rdmKi(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%ZonePitch = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Kice = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Delmax = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Y0 not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3316,15 +3202,10 @@ SUBROUTINE IceD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Y0)>0) OutData%Y0 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Y0))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Y0) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Y0,1), UBOUND(OutData%Y0,1) + OutData%Y0(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ContPrfl not allocated Int_Xferred = Int_Xferred + 1 @@ -3339,52 +3220,47 @@ SUBROUTINE IceD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ContPrfl.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%ContPrfl)>0) OutData%ContPrfl = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%ContPrfl))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%ContPrfl) - DEALLOCATE(mask1) - END IF - OutData%Zn = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%rhoi = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rhow = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%alphaR = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Dwl = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Zr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RHbr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RVbr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Lbr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%LovR = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%mu = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Wri = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WL = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cpa = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%dpa = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%FdrN = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Mice = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Fsp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%ContPrfl,1), UBOUND(OutData%ContPrfl,1) + OutData%ContPrfl(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%Zn = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%rhoi = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rhow = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%alphaR = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Dwl = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Zr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RHbr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RVbr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Lbr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LovR = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%mu = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Wri = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WL = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cpa = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%dpa = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%FdrN = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Mice = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Fsp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IceD_UnPackParam SUBROUTINE IceD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -3541,12 +3417,6 @@ SUBROUTINE IceD_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IceD_UnPackInput' @@ -3772,8 +3642,10 @@ SUBROUTINE IceD_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WriteOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE IceD_PackOutput @@ -3790,12 +3662,6 @@ SUBROUTINE IceD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -3863,15 +3729,10 @@ SUBROUTINE IceD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WriteOutput)>0) OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE IceD_UnPackOutput @@ -3950,8 +3811,8 @@ SUBROUTINE IceD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'IceD_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -3966,6 +3827,8 @@ SUBROUTINE IceD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(u1%PointMesh, u2%PointMesh, tin, u_out%PointMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE IceD_Input_ExtrapInterp1 @@ -3997,8 +3860,9 @@ SUBROUTINE IceD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'IceD_Input_ExtrapInterp2' @@ -4020,6 +3884,8 @@ SUBROUTINE IceD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(u1%PointMesh, u2%PointMesh, u3%PointMesh, tin, u_out%PointMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE IceD_Input_ExtrapInterp2 @@ -4099,12 +3965,12 @@ SUBROUTINE IceD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'IceD_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! 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 :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -4117,15 +3983,15 @@ SUBROUTINE IceD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(y1%PointMesh, y2%PointMesh, tin, y_out%PointMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END IF ! check if allocated END SUBROUTINE IceD_Output_ExtrapInterp1 @@ -4156,13 +4022,14 @@ SUBROUTINE IceD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'IceD_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -4181,16 +4048,16 @@ SUBROUTINE IceD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(y1%PointMesh, y2%PointMesh, y3%PointMesh, tin, y_out%PointMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END IF ! check if allocated END SUBROUTINE IceD_Output_ExtrapInterp2 diff --git a/modules/icefloe/src/icefloe/IceFloe_Types.f90 b/modules/icefloe/src/icefloe/IceFloe_Types.f90 index cc860d0a58..630cf872cc 100644 --- a/modules/icefloe/src/icefloe/IceFloe_Types.f90 +++ b/modules/icefloe/src/icefloe/IceFloe_Types.f90 @@ -210,20 +210,20 @@ SUBROUTINE IceFloe_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%simLength - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MSL2SWL - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%gravity - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(InData%InputFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + ReKiBuf(Re_Xferred) = InData%simLength + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MSL2SWL + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%gravity + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE IceFloe_PackInitInput SUBROUTINE IceFloe_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -239,12 +239,6 @@ SUBROUTINE IceFloe_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -260,20 +254,20 @@ SUBROUTINE IceFloe_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%simLength = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MSL2SWL = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%gravity = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%InputFile) + OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%simLength = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MSL2SWL = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%gravity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE IceFloe_UnPackInitInput SUBROUTINE IceFloe_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -438,12 +432,12 @@ SUBROUTINE IceFloe_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) + DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) DO I = 1, LEN(InData%WriteOutputHdr) IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdr(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -455,12 +449,12 @@ SUBROUTINE IceFloe_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) + DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) DO I = 1, LEN(InData%WriteOutputUnt) IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUnt(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -505,12 +499,6 @@ SUBROUTINE IceFloe_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -538,19 +526,12 @@ SUBROUTINE IceFloe_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) DO I = 1, LEN(OutData%WriteOutputHdr) OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated Int_Xferred = Int_Xferred + 1 @@ -565,19 +546,12 @@ SUBROUTINE IceFloe_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) DO I = 1, LEN(OutData%WriteOutputUnt) OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -712,8 +686,8 @@ SUBROUTINE IceFloe_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyContStateVar - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyContStateVar + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IceFloe_PackContState SUBROUTINE IceFloe_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -729,12 +703,6 @@ SUBROUTINE IceFloe_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_UnPackContState' @@ -748,8 +716,8 @@ SUBROUTINE IceFloe_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyContStateVar = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyContStateVar = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IceFloe_UnPackContState SUBROUTINE IceFloe_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) @@ -843,8 +811,8 @@ SUBROUTINE IceFloe_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyDiscStateVar - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyDiscStateVar + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IceFloe_PackDiscState SUBROUTINE IceFloe_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -860,12 +828,6 @@ SUBROUTINE IceFloe_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_UnPackDiscState' @@ -879,8 +841,8 @@ SUBROUTINE IceFloe_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyDiscStateVar = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyDiscStateVar = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IceFloe_UnPackDiscState SUBROUTINE IceFloe_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -974,8 +936,8 @@ SUBROUTINE IceFloe_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstrStateVar - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyConstrStateVar + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IceFloe_PackConstrState SUBROUTINE IceFloe_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -991,12 +953,6 @@ SUBROUTINE IceFloe_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_UnPackConstrState' @@ -1010,8 +966,8 @@ SUBROUTINE IceFloe_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyConstrStateVar = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyConstrStateVar = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IceFloe_UnPackConstrState SUBROUTINE IceFloe_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -1105,8 +1061,8 @@ SUBROUTINE IceFloe_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DummyOtherState - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DummyOtherState + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IceFloe_PackOtherState SUBROUTINE IceFloe_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1122,12 +1078,6 @@ SUBROUTINE IceFloe_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_UnPackOtherState' @@ -1141,8 +1091,8 @@ SUBROUTINE IceFloe_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyOtherState = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%DummyOtherState = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IceFloe_UnPackOtherState SUBROUTINE IceFloe_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -1236,8 +1186,8 @@ SUBROUTINE IceFloe_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DummyMiscVar - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DummyMiscVar + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IceFloe_PackMisc SUBROUTINE IceFloe_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1253,12 +1203,6 @@ SUBROUTINE IceFloe_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_UnPackMisc' @@ -1272,8 +1216,8 @@ SUBROUTINE IceFloe_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyMiscVar = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%DummyMiscVar = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IceFloe_UnPackMisc SUBROUTINE IceFloe_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -1492,29 +1436,33 @@ SUBROUTINE IceFloe_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%loadSeries,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%loadSeries)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%loadSeries))-1 ) = PACK(InData%loadSeries,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%loadSeries) + DO i2 = LBOUND(InData%loadSeries,2), UBOUND(InData%loadSeries,2) + DO i1 = LBOUND(InData%loadSeries,1), UBOUND(InData%loadSeries,1) + ReKiBuf(Re_Xferred) = InData%loadSeries(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%iceVel - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%iceDirection - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%minStrength - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%minStrengthNegVel - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%defaultArea - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%crushArea - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%coeffStressRate - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%C(4) - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rampTime - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%iceVel + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%iceDirection + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%minStrength + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%minStrengthNegVel + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%defaultArea + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%crushArea + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%coeffStressRate + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%C(4) + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rampTime + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%legX) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1525,8 +1473,10 @@ SUBROUTINE IceFloe_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%legX,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%legX)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%legX))-1 ) = PACK(InData%legX,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%legX) + DO i1 = LBOUND(InData%legX,1), UBOUND(InData%legX,1) + ReKiBuf(Re_Xferred) = InData%legX(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%legY) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1538,8 +1488,10 @@ SUBROUTINE IceFloe_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%legY,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%legY)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%legY))-1 ) = PACK(InData%legY,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%legY) + DO i1 = LBOUND(InData%legY,1), UBOUND(InData%legY,1) + ReKiBuf(Re_Xferred) = InData%legY(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%ks) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1551,19 +1503,21 @@ SUBROUTINE IceFloe_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ks,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ks)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%ks))-1 ) = PACK(InData%ks,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%ks) + DO i1 = LBOUND(InData%ks,1), UBOUND(InData%ks,1) + ReKiBuf(Re_Xferred) = InData%ks(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%numLegs - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%iceType - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%logUnitNum - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%singleLoad , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%initFlag , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%numLegs + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%iceType + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%logUnitNum + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%singleLoad, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%initFlag, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IceFloe_PackParam SUBROUTINE IceFloe_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1579,12 +1533,6 @@ SUBROUTINE IceFloe_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -1616,36 +1564,33 @@ SUBROUTINE IceFloe_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%loadSeries.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%loadSeries)>0) OutData%loadSeries = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%loadSeries))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%loadSeries) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%loadSeries,2), UBOUND(OutData%loadSeries,2) + DO i1 = LBOUND(OutData%loadSeries,1), UBOUND(OutData%loadSeries,1) + OutData%loadSeries(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%iceVel = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%iceDirection = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%minStrength = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%minStrengthNegVel = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%defaultArea = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%crushArea = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%coeffStressRate = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%C(4) = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%dt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rampTime = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%iceVel = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%iceDirection = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%minStrength = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%minStrengthNegVel = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%defaultArea = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%crushArea = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%coeffStressRate = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%C(4) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%dt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rampTime = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! legX not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1659,15 +1604,10 @@ SUBROUTINE IceFloe_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%legX.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%legX)>0) OutData%legX = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%legX))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%legX) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%legX,1), UBOUND(OutData%legX,1) + OutData%legX(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! legY not allocated Int_Xferred = Int_Xferred + 1 @@ -1682,15 +1622,10 @@ SUBROUTINE IceFloe_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%legY.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%legY)>0) OutData%legY = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%legY))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%legY) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%legY,1), UBOUND(OutData%legY,1) + OutData%legY(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ks not allocated Int_Xferred = Int_Xferred + 1 @@ -1705,26 +1640,21 @@ SUBROUTINE IceFloe_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ks.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%ks)>0) OutData%ks = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%ks))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%ks) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%ks,1), UBOUND(OutData%ks,1) + OutData%ks(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%numLegs = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%iceType = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%logUnitNum = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%singleLoad = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%initFlag = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%numLegs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%iceType = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%logUnitNum = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%singleLoad = TRANSFER(IntKiBuf(Int_Xferred), OutData%singleLoad) + Int_Xferred = Int_Xferred + 1 + OutData%initFlag = TRANSFER(IntKiBuf(Int_Xferred), OutData%initFlag) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IceFloe_UnPackParam SUBROUTINE IceFloe_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -1881,12 +1811,6 @@ SUBROUTINE IceFloe_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_UnPackInput' @@ -2112,8 +2036,10 @@ SUBROUTINE IceFloe_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WriteOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE IceFloe_PackOutput @@ -2130,12 +2056,6 @@ SUBROUTINE IceFloe_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -2203,15 +2123,10 @@ SUBROUTINE IceFloe_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WriteOutput)>0) OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE IceFloe_UnPackOutput @@ -2290,8 +2205,8 @@ SUBROUTINE IceFloe_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, Err REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -2306,6 +2221,8 @@ SUBROUTINE IceFloe_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(u1%iceMesh, u2%iceMesh, tin, u_out%iceMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE IceFloe_Input_ExtrapInterp1 @@ -2337,8 +2254,9 @@ SUBROUTINE IceFloe_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_Input_ExtrapInterp2' @@ -2360,6 +2278,8 @@ SUBROUTINE IceFloe_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(u1%iceMesh, u2%iceMesh, u3%iceMesh, tin, u_out%iceMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE IceFloe_Input_ExtrapInterp2 @@ -2439,12 +2359,12 @@ SUBROUTINE IceFloe_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Er REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! 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 :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -2457,15 +2377,15 @@ SUBROUTINE IceFloe_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(y1%iceMesh, y2%iceMesh, tin, y_out%iceMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END IF ! check if allocated END SUBROUTINE IceFloe_Output_ExtrapInterp1 @@ -2496,13 +2416,14 @@ SUBROUTINE IceFloe_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -2521,16 +2442,16 @@ SUBROUTINE IceFloe_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(y1%iceMesh, y2%iceMesh, y3%iceMesh, tin, y_out%iceMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END IF ! check if allocated END SUBROUTINE IceFloe_Output_ExtrapInterp2 diff --git a/modules/inflowwind/src/IfW_4Dext_Types.f90 b/modules/inflowwind/src/IfW_4Dext_Types.f90 index f34008bcb5..b87a4e1fe4 100644 --- a/modules/inflowwind/src/IfW_4Dext_Types.f90 +++ b/modules/inflowwind/src/IfW_4Dext_Types.f90 @@ -159,12 +159,18 @@ SUBROUTINE IfW_4Dext_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%n))-1 ) = PACK(InData%n,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%n) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%delta))-1 ) = PACK(InData%delta,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%delta) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%pZero))-1 ) = PACK(InData%pZero,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%pZero) + DO i1 = LBOUND(InData%n,1), UBOUND(InData%n,1) + IntKiBuf(Int_Xferred) = InData%n(i1) + Int_Xferred = Int_Xferred + 1 + END DO + DO i1 = LBOUND(InData%delta,1), UBOUND(InData%delta,1) + ReKiBuf(Re_Xferred) = InData%delta(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%pZero,1), UBOUND(InData%pZero,1) + ReKiBuf(Re_Xferred) = InData%pZero(i1) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE IfW_4Dext_PackInitInput SUBROUTINE IfW_4Dext_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -180,12 +186,6 @@ SUBROUTINE IfW_4Dext_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -206,37 +206,22 @@ SUBROUTINE IfW_4Dext_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Int_Xferred = 1 i1_l = LBOUND(OutData%n,1) i1_u = UBOUND(OutData%n,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%n = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%n))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%n) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%n,1), UBOUND(OutData%n,1) + OutData%n(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO i1_l = LBOUND(OutData%delta,1) i1_u = UBOUND(OutData%delta,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%delta = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%delta))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%delta) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%delta,1), UBOUND(OutData%delta,1) + OutData%delta(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%pZero,1) i1_u = UBOUND(OutData%pZero,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%pZero = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%pZero))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%pZero) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%pZero,1), UBOUND(OutData%pZero,1) + OutData%pZero(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE IfW_4Dext_UnPackInitInput SUBROUTINE IfW_4Dext_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -393,12 +378,6 @@ SUBROUTINE IfW_4Dext_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IfW_4Dext_UnPackInitOutput' @@ -600,11 +579,21 @@ SUBROUTINE IfW_4Dext_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V,5) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%V)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%V))-1 ) = PACK(InData%V,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%V) + DO i5 = LBOUND(InData%V,5), UBOUND(InData%V,5) + DO i4 = LBOUND(InData%V,4), UBOUND(InData%V,4) + DO i3 = LBOUND(InData%V,3), UBOUND(InData%V,3) + DO i2 = LBOUND(InData%V,2), UBOUND(InData%V,2) + DO i1 = LBOUND(InData%V,1), UBOUND(InData%V,1) + ReKiBuf(Re_Xferred) = InData%V(i1,i2,i3,i4,i5) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TgridStart - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TgridStart + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IfW_4Dext_PackMisc SUBROUTINE IfW_4Dext_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -620,12 +609,6 @@ SUBROUTINE IfW_4Dext_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -669,18 +652,21 @@ SUBROUTINE IfW_4Dext_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%V.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask5(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask5.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask5 = .TRUE. - IF (SIZE(OutData%V)>0) OutData%V = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%V))-1 ), mask5, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%V) - DEALLOCATE(mask5) + DO i5 = LBOUND(OutData%V,5), UBOUND(OutData%V,5) + DO i4 = LBOUND(OutData%V,4), UBOUND(OutData%V,4) + DO i3 = LBOUND(OutData%V,3), UBOUND(OutData%V,3) + DO i2 = LBOUND(OutData%V,2), UBOUND(OutData%V,2) + DO i1 = LBOUND(OutData%V,1), UBOUND(OutData%V,1) + OutData%V(i1,i2,i3,i4,i5) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END DO END IF - OutData%TgridStart = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%TgridStart = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IfW_4Dext_UnPackMisc SUBROUTINE IfW_4Dext_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -779,12 +765,18 @@ SUBROUTINE IfW_4Dext_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%n))-1 ) = PACK(InData%n,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%n) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%delta))-1 ) = PACK(InData%delta,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%delta) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%pZero))-1 ) = PACK(InData%pZero,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%pZero) + DO i1 = LBOUND(InData%n,1), UBOUND(InData%n,1) + IntKiBuf(Int_Xferred) = InData%n(i1) + Int_Xferred = Int_Xferred + 1 + END DO + DO i1 = LBOUND(InData%delta,1), UBOUND(InData%delta,1) + ReKiBuf(Re_Xferred) = InData%delta(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%pZero,1), UBOUND(InData%pZero,1) + ReKiBuf(Re_Xferred) = InData%pZero(i1) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE IfW_4Dext_PackParam SUBROUTINE IfW_4Dext_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -800,12 +792,6 @@ SUBROUTINE IfW_4Dext_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -822,37 +808,22 @@ SUBROUTINE IfW_4Dext_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Xferred = 1 i1_l = LBOUND(OutData%n,1) i1_u = UBOUND(OutData%n,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%n = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%n))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%n) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%n,1), UBOUND(OutData%n,1) + OutData%n(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO i1_l = LBOUND(OutData%delta,1) i1_u = UBOUND(OutData%delta,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%delta = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%delta))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%delta) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%delta,1), UBOUND(OutData%delta,1) + OutData%delta(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%pZero,1) i1_u = UBOUND(OutData%pZero,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%pZero = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%pZero))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%pZero) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%pZero,1), UBOUND(OutData%pZero,1) + OutData%pZero(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE IfW_4Dext_UnPackParam END MODULE IfW_4Dext_Types diff --git a/modules/inflowwind/src/IfW_BladedFFWind_Types.f90 b/modules/inflowwind/src/IfW_BladedFFWind_Types.f90 index 74d536e638..fd15ba6f7d 100644 --- a/modules/inflowwind/src/IfW_BladedFFWind_Types.f90 +++ b/modules/inflowwind/src/IfW_BladedFFWind_Types.f90 @@ -178,14 +178,14 @@ SUBROUTINE IfW_BladedFFWind_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, E Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%WindFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%WindFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TowerFileExist , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%SumFileUnit - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%WindFileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%WindFileName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%TowerFileExist, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%SumFileUnit + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IfW_BladedFFWind_PackInitInput SUBROUTINE IfW_BladedFFWind_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -201,12 +201,6 @@ SUBROUTINE IfW_BladedFFWind_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -224,14 +218,14 @@ SUBROUTINE IfW_BladedFFWind_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%WindFileName) - OutData%WindFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%TowerFileExist = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%SumFileUnit = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%WindFileName) + OutData%WindFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%TowerFileExist = TRANSFER(IntKiBuf(Int_Xferred), OutData%TowerFileExist) + Int_Xferred = Int_Xferred + 1 + OutData%SumFileUnit = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IfW_BladedFFWind_UnPackInitInput SUBROUTINE IfW_BladedFFWind_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -376,8 +370,10 @@ SUBROUTINE IfW_BladedFFWind_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TI))-1 ) = PACK(InData%TI,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TI) + DO i1 = LBOUND(InData%TI,1), UBOUND(InData%TI,1) + ReKiBuf(Re_Xferred) = InData%TI(i1) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE IfW_BladedFFWind_PackInitOutput SUBROUTINE IfW_BladedFFWind_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -393,12 +389,6 @@ SUBROUTINE IfW_BladedFFWind_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -455,15 +445,10 @@ SUBROUTINE IfW_BladedFFWind_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdat IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) i1_l = LBOUND(OutData%TI,1) i1_u = UBOUND(OutData%TI,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%TI = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TI))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TI) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TI,1), UBOUND(OutData%TI,1) + OutData%TI(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE IfW_BladedFFWind_UnPackInitOutput SUBROUTINE IfW_BladedFFWind_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -557,8 +542,8 @@ SUBROUTINE IfW_BladedFFWind_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TimeIndex - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TimeIndex + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IfW_BladedFFWind_PackMisc SUBROUTINE IfW_BladedFFWind_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -574,12 +559,6 @@ SUBROUTINE IfW_BladedFFWind_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IfW_BladedFFWind_UnPackMisc' @@ -593,8 +572,8 @@ SUBROUTINE IfW_BladedFFWind_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%TimeIndex = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%TimeIndex = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IfW_BladedFFWind_UnPackMisc SUBROUTINE IfW_BladedFFWind_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -782,12 +761,12 @@ SUBROUTINE IfW_BladedFFWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Periodic , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TowerDataExist , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%Periodic, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TowerDataExist, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 IF ( .NOT. ALLOCATED(InData%FFData) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -807,8 +786,16 @@ SUBROUTINE IfW_BladedFFWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FFData,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FFData)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FFData))-1 ) = PACK(InData%FFData,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FFData) + DO i4 = LBOUND(InData%FFData,4), UBOUND(InData%FFData,4) + DO i3 = LBOUND(InData%FFData,3), UBOUND(InData%FFData,3) + DO i2 = LBOUND(InData%FFData,2), UBOUND(InData%FFData,2) + DO i1 = LBOUND(InData%FFData,1), UBOUND(InData%FFData,1) + ReKiBuf(Re_Xferred) = InData%FFData(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FFTower) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -826,45 +813,51 @@ SUBROUTINE IfW_BladedFFWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FFTower,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FFTower)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FFTower))-1 ) = PACK(InData%FFTower,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FFTower) + DO i3 = LBOUND(InData%FFTower,3), UBOUND(InData%FFTower,3) + DO i2 = LBOUND(InData%FFTower,2), UBOUND(InData%FFTower,2) + DO i1 = LBOUND(InData%FFTower,1), UBOUND(InData%FFTower,1) + ReKiBuf(Re_Xferred) = InData%FFTower(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FFDTime - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FFRate - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FFYHWid - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FFZHWid - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RefHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GridBase - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%InitXPosition - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%InvFFYD - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%InvFFZD - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%InvMFFWS - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MeanFFWS - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TotalTime - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NFFComp - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NFFSteps - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NYGrids - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NZGrids - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NTGrids - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WindFileFormat - Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FFDTime + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FFRate + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FFYHWid + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FFZHWid + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RefHt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GridBase + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%InitXPosition + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%InvFFYD + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%InvFFZD + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%InvMFFWS + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MeanFFWS + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TotalTime + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NFFComp + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NFFSteps + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NYGrids + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NZGrids + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NTGrids + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WindFileFormat + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IfW_BladedFFWind_PackParam SUBROUTINE IfW_BladedFFWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -880,12 +873,6 @@ SUBROUTINE IfW_BladedFFWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -903,12 +890,12 @@ SUBROUTINE IfW_BladedFFWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%Periodic = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%TowerDataExist = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%Periodic = TRANSFER(IntKiBuf(Int_Xferred), OutData%Periodic) + Int_Xferred = Int_Xferred + 1 + OutData%TowerDataExist = TRANSFER(IntKiBuf(Int_Xferred), OutData%TowerDataExist) + Int_Xferred = Int_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FFData not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -931,15 +918,16 @@ SUBROUTINE IfW_BladedFFWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FFData.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%FFData)>0) OutData%FFData = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FFData))-1 ), mask4, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%FFData) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%FFData,4), UBOUND(OutData%FFData,4) + DO i3 = LBOUND(OutData%FFData,3), UBOUND(OutData%FFData,3) + DO i2 = LBOUND(OutData%FFData,2), UBOUND(OutData%FFData,2) + DO i1 = LBOUND(OutData%FFData,1), UBOUND(OutData%FFData,1) + OutData%FFData(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FFTower not allocated Int_Xferred = Int_Xferred + 1 @@ -960,52 +948,51 @@ SUBROUTINE IfW_BladedFFWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FFTower.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%FFTower)>0) OutData%FFTower = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FFTower))-1 ), mask3, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%FFTower) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%FFTower,3), UBOUND(OutData%FFTower,3) + DO i2 = LBOUND(OutData%FFTower,2), UBOUND(OutData%FFTower,2) + DO i1 = LBOUND(OutData%FFTower,1), UBOUND(OutData%FFTower,1) + OutData%FFTower(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - OutData%FFDTime = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%FFRate = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%FFYHWid = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%FFZHWid = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RefHt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GridBase = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%InitXPosition = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%InvFFYD = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%InvFFZD = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%InvMFFWS = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MeanFFWS = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TotalTime = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NFFComp = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NFFSteps = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NYGrids = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NZGrids = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NTGrids = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%WindFileFormat = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%FFDTime = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%FFRate = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%FFYHWid = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%FFZHWid = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RefHt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GridBase = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%InitXPosition = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%InvFFYD = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%InvFFZD = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%InvMFFWS = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MeanFFWS = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TotalTime = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NFFComp = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NFFSteps = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NYGrids = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NZGrids = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NTGrids = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WindFileFormat = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IfW_BladedFFWind_UnPackParam END MODULE IfW_BladedFFWind_Types diff --git a/modules/inflowwind/src/IfW_HAWCWind_Types.f90 b/modules/inflowwind/src/IfW_HAWCWind_Types.f90 index 18a96ae642..afe0c244f5 100644 --- a/modules/inflowwind/src/IfW_HAWCWind_Types.f90 +++ b/modules/inflowwind/src/IfW_HAWCWind_Types.f90 @@ -233,41 +233,45 @@ SUBROUTINE IfW_HAWCWind_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt Int_Xferred = 1 DO i1 = LBOUND(InData%WindFileName,1), UBOUND(InData%WindFileName,1) - DO I = 1, LEN(InData%WindFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%WindFileName(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%SumFileUnit - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%nx - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%ny - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%nz - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%ScaleMethod - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SF))-1 ) = PACK(InData%SF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SF) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SigmaF))-1 ) = PACK(InData%SigmaF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SigmaF) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dx - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dy - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dz - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WindProfileType - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RefHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%URef - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PLExp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Z0 - Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(InData%WindFileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%WindFileName(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + IntKiBuf(Int_Xferred) = InData%SumFileUnit + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nx + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%ny + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nz + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%ScaleMethod + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%SF,1), UBOUND(InData%SF,1) + ReKiBuf(Re_Xferred) = InData%SF(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%SigmaF,1), UBOUND(InData%SigmaF,1) + ReKiBuf(Re_Xferred) = InData%SigmaF(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%dx + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dy + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dz + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WindProfileType + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RefHt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%URef + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PLExp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Z0 + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IfW_HAWCWind_PackInitInput SUBROUTINE IfW_HAWCWind_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -283,12 +287,6 @@ SUBROUTINE IfW_HAWCWind_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -308,67 +306,50 @@ SUBROUTINE IfW_HAWCWind_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er Int_Xferred = 1 i1_l = LBOUND(OutData%WindFileName,1) i1_u = UBOUND(OutData%WindFileName,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. DO i1 = LBOUND(OutData%WindFileName,1), UBOUND(OutData%WindFileName,1) - DO I = 1, LEN(OutData%WindFileName) - OutData%WindFileName(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - DEALLOCATE(mask1) - OutData%SumFileUnit = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%nx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ny = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%nz = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ScaleMethod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%WindFileName) + OutData%WindFileName(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + OutData%SumFileUnit = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ny = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nz = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ScaleMethod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%SF,1) i1_u = UBOUND(OutData%SF,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%SF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SF))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SF) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%SF,1), UBOUND(OutData%SF,1) + OutData%SF(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%SigmaF,1) i1_u = UBOUND(OutData%SigmaF,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%SigmaF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SigmaF))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SigmaF) - DEALLOCATE(mask1) - OutData%dx = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%dy = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%dz = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WindProfileType = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%RefHt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%URef = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PLExp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Z0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%SigmaF,1), UBOUND(OutData%SigmaF,1) + OutData%SigmaF(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%dx = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%dy = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%dz = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WindProfileType = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%RefHt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%URef = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PLExp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Z0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IfW_HAWCWind_UnPackInitInput SUBROUTINE IfW_HAWCWind_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -513,8 +494,10 @@ SUBROUTINE IfW_HAWCWind_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrS ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SF))-1 ) = PACK(InData%SF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SF) + DO i1 = LBOUND(InData%SF,1), UBOUND(InData%SF,1) + ReKiBuf(Re_Xferred) = InData%SF(i1) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE IfW_HAWCWind_PackInitOutput SUBROUTINE IfW_HAWCWind_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -530,12 +513,6 @@ SUBROUTINE IfW_HAWCWind_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -592,15 +569,10 @@ SUBROUTINE IfW_HAWCWind_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, E IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) i1_l = LBOUND(OutData%SF,1) i1_u = UBOUND(OutData%SF,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%SF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SF))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SF) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%SF,1), UBOUND(OutData%SF,1) + OutData%SF(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE IfW_HAWCWind_UnPackInitOutput SUBROUTINE IfW_HAWCWind_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) @@ -694,8 +666,8 @@ SUBROUTINE IfW_HAWCWind_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyContState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyContState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IfW_HAWCWind_PackContState SUBROUTINE IfW_HAWCWind_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -711,12 +683,6 @@ SUBROUTINE IfW_HAWCWind_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IfW_HAWCWind_UnPackContState' @@ -730,8 +696,8 @@ SUBROUTINE IfW_HAWCWind_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyContState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyContState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IfW_HAWCWind_UnPackContState SUBROUTINE IfW_HAWCWind_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) @@ -825,8 +791,8 @@ SUBROUTINE IfW_HAWCWind_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyDiscState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IfW_HAWCWind_PackDiscState SUBROUTINE IfW_HAWCWind_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -842,12 +808,6 @@ SUBROUTINE IfW_HAWCWind_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IfW_HAWCWind_UnPackDiscState' @@ -861,8 +821,8 @@ SUBROUTINE IfW_HAWCWind_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyDiscState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyDiscState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IfW_HAWCWind_UnPackDiscState SUBROUTINE IfW_HAWCWind_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -956,8 +916,8 @@ SUBROUTINE IfW_HAWCWind_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Err Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyConstrState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IfW_HAWCWind_PackConstrState SUBROUTINE IfW_HAWCWind_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -973,12 +933,6 @@ SUBROUTINE IfW_HAWCWind_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IfW_HAWCWind_UnPackConstrState' @@ -992,8 +946,8 @@ SUBROUTINE IfW_HAWCWind_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyConstrState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyConstrState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IfW_HAWCWind_UnPackConstrState SUBROUTINE IfW_HAWCWind_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -1087,8 +1041,8 @@ SUBROUTINE IfW_HAWCWind_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrS Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyOtherState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyOtherState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IfW_HAWCWind_PackOtherState SUBROUTINE IfW_HAWCWind_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1104,12 +1058,6 @@ SUBROUTINE IfW_HAWCWind_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IfW_HAWCWind_UnPackOtherState' @@ -1123,8 +1071,8 @@ SUBROUTINE IfW_HAWCWind_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyOtherState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyOtherState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IfW_HAWCWind_UnPackOtherState SUBROUTINE IfW_HAWCWind_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -1218,8 +1166,8 @@ SUBROUTINE IfW_HAWCWind_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyMiscVar - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyMiscVar + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IfW_HAWCWind_PackMisc SUBROUTINE IfW_HAWCWind_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1235,12 +1183,6 @@ SUBROUTINE IfW_HAWCWind_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IfW_HAWCWind_UnPackMisc' @@ -1254,8 +1196,8 @@ SUBROUTINE IfW_HAWCWind_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyMiscVar = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyMiscVar = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IfW_HAWCWind_UnPackMisc SUBROUTINE IfW_HAWCWind_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -1401,14 +1343,14 @@ SUBROUTINE IfW_HAWCWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%nx - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%ny - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%nz - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RefHt - Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nx + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%ny + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nz + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RefHt + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%HAWCData) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1428,25 +1370,35 @@ SUBROUTINE IfW_HAWCWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HAWCData,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%HAWCData)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%HAWCData))-1 ) = PACK(InData%HAWCData,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%HAWCData) + DO i4 = LBOUND(InData%HAWCData,4), UBOUND(InData%HAWCData,4) + DO i3 = LBOUND(InData%HAWCData,3), UBOUND(InData%HAWCData,3) + DO i2 = LBOUND(InData%HAWCData,2), UBOUND(InData%HAWCData,2) + DO i1 = LBOUND(InData%HAWCData,1), UBOUND(InData%HAWCData,1) + ReKiBuf(Re_Xferred) = InData%HAWCData(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%InitPosition))-1 ) = PACK(InData%InitPosition,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%InitPosition) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GridBase - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%LengthX - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%LengthYHalf - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%deltaXInv - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%deltaYInv - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%deltaZInv - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%URef - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%InitPosition,1), UBOUND(InData%InitPosition,1) + ReKiBuf(Re_Xferred) = InData%InitPosition(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%GridBase + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%LengthX + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%LengthYHalf + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%deltaXInv + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%deltaYInv + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%deltaZInv + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%URef + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IfW_HAWCWind_PackParam SUBROUTINE IfW_HAWCWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1462,12 +1414,6 @@ SUBROUTINE IfW_HAWCWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -1485,14 +1431,14 @@ SUBROUTINE IfW_HAWCWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%nx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ny = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%nz = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%RefHt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%nx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ny = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nz = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%RefHt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! HAWCData not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1515,41 +1461,37 @@ SUBROUTINE IfW_HAWCWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%HAWCData.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%HAWCData)>0) OutData%HAWCData = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%HAWCData))-1 ), mask4, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%HAWCData) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%HAWCData,4), UBOUND(OutData%HAWCData,4) + DO i3 = LBOUND(OutData%HAWCData,3), UBOUND(OutData%HAWCData,3) + DO i2 = LBOUND(OutData%HAWCData,2), UBOUND(OutData%HAWCData,2) + DO i1 = LBOUND(OutData%HAWCData,1), UBOUND(OutData%HAWCData,1) + OutData%HAWCData(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF i1_l = LBOUND(OutData%InitPosition,1) i1_u = UBOUND(OutData%InitPosition,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%InitPosition = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%InitPosition))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%InitPosition) - DEALLOCATE(mask1) - OutData%GridBase = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%LengthX = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%LengthYHalf = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%deltaXInv = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%deltaYInv = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%deltaZInv = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%URef = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%InitPosition,1), UBOUND(OutData%InitPosition,1) + OutData%InitPosition(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%GridBase = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LengthX = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LengthYHalf = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%deltaXInv = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%deltaYInv = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%deltaZInv = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%URef = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IfW_HAWCWind_UnPackParam SUBROUTINE IfW_HAWCWind_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -1678,8 +1620,12 @@ SUBROUTINE IfW_HAWCWind_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Position,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Position)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Position))-1 ) = PACK(InData%Position,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Position) + DO i2 = LBOUND(InData%Position,2), UBOUND(InData%Position,2) + DO i1 = LBOUND(InData%Position,1), UBOUND(InData%Position,1) + ReKiBuf(Re_Xferred) = InData%Position(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE IfW_HAWCWind_PackInput @@ -1696,12 +1642,6 @@ SUBROUTINE IfW_HAWCWind_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -1733,15 +1673,12 @@ SUBROUTINE IfW_HAWCWind_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Position.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Position)>0) OutData%Position = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Position))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Position) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Position,2), UBOUND(OutData%Position,2) + DO i1 = LBOUND(OutData%Position,1), UBOUND(OutData%Position,1) + OutData%Position(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE IfW_HAWCWind_UnPackInput diff --git a/modules/inflowwind/src/IfW_TSFFWind_Types.f90 b/modules/inflowwind/src/IfW_TSFFWind_Types.f90 index 5184d52280..687f7eb742 100644 --- a/modules/inflowwind/src/IfW_TSFFWind_Types.f90 +++ b/modules/inflowwind/src/IfW_TSFFWind_Types.f90 @@ -174,12 +174,12 @@ SUBROUTINE IfW_TSFFWind_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%WindFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%WindFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%SumFileUnit - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%WindFileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%WindFileName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%SumFileUnit + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IfW_TSFFWind_PackInitInput SUBROUTINE IfW_TSFFWind_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -195,12 +195,6 @@ SUBROUTINE IfW_TSFFWind_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -218,12 +212,12 @@ SUBROUTINE IfW_TSFFWind_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%WindFileName) - OutData%WindFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%SumFileUnit = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%WindFileName) + OutData%WindFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%SumFileUnit = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IfW_TSFFWind_UnPackInitInput SUBROUTINE IfW_TSFFWind_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -380,12 +374,6 @@ SUBROUTINE IfW_TSFFWind_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IfW_TSFFWind_UnPackInitOutput' @@ -532,8 +520,8 @@ SUBROUTINE IfW_TSFFWind_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TimeIndex - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TimeIndex + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IfW_TSFFWind_PackMisc SUBROUTINE IfW_TSFFWind_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -549,12 +537,6 @@ SUBROUTINE IfW_TSFFWind_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IfW_TSFFWind_UnPackMisc' @@ -568,8 +550,8 @@ SUBROUTINE IfW_TSFFWind_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%TimeIndex = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%TimeIndex = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IfW_TSFFWind_UnPackMisc SUBROUTINE IfW_TSFFWind_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -757,12 +739,12 @@ SUBROUTINE IfW_TSFFWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TowerDataExist , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Periodic , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TowerDataExist, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%Periodic, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%FFData) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -782,8 +764,16 @@ SUBROUTINE IfW_TSFFWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FFData,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FFData)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FFData))-1 ) = PACK(InData%FFData,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FFData) + DO i4 = LBOUND(InData%FFData,4), UBOUND(InData%FFData,4) + DO i3 = LBOUND(InData%FFData,3), UBOUND(InData%FFData,3) + DO i2 = LBOUND(InData%FFData,2), UBOUND(InData%FFData,2) + DO i1 = LBOUND(InData%FFData,1), UBOUND(InData%FFData,1) + ReKiBuf(Re_Xferred) = InData%FFData(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FFTower) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -801,45 +791,51 @@ SUBROUTINE IfW_TSFFWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FFTower,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FFTower)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FFTower))-1 ) = PACK(InData%FFTower,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FFTower) + DO i3 = LBOUND(InData%FFTower,3), UBOUND(InData%FFTower,3) + DO i2 = LBOUND(InData%FFTower,2), UBOUND(InData%FFTower,2) + DO i1 = LBOUND(InData%FFTower,1), UBOUND(InData%FFTower,1) + ReKiBuf(Re_Xferred) = InData%FFTower(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FFDTime - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FFRate - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FFYHWid - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FFZHWid - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RefHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GridBase - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%InitXPosition - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%InvFFYD - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%InvFFZD - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%InvMFFWS - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MeanFFWS - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TotalTime - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NFFComp - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NFFSteps - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NYGrids - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NZGrids - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NTGrids - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WindFileFormat - Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FFDTime + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FFRate + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FFYHWid + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FFZHWid + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RefHt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GridBase + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%InitXPosition + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%InvFFYD + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%InvFFZD + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%InvMFFWS + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MeanFFWS + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TotalTime + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NFFComp + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NFFSteps + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NYGrids + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NZGrids + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NTGrids + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WindFileFormat + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IfW_TSFFWind_PackParam SUBROUTINE IfW_TSFFWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -855,12 +851,6 @@ SUBROUTINE IfW_TSFFWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -878,12 +868,12 @@ SUBROUTINE IfW_TSFFWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%TowerDataExist = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%Periodic = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%TowerDataExist = TRANSFER(IntKiBuf(Int_Xferred), OutData%TowerDataExist) + Int_Xferred = Int_Xferred + 1 + OutData%Periodic = TRANSFER(IntKiBuf(Int_Xferred), OutData%Periodic) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FFData not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -906,15 +896,16 @@ SUBROUTINE IfW_TSFFWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FFData.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%FFData)>0) OutData%FFData = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FFData))-1 ), mask4, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%FFData) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%FFData,4), UBOUND(OutData%FFData,4) + DO i3 = LBOUND(OutData%FFData,3), UBOUND(OutData%FFData,3) + DO i2 = LBOUND(OutData%FFData,2), UBOUND(OutData%FFData,2) + DO i1 = LBOUND(OutData%FFData,1), UBOUND(OutData%FFData,1) + OutData%FFData(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FFTower not allocated Int_Xferred = Int_Xferred + 1 @@ -935,52 +926,51 @@ SUBROUTINE IfW_TSFFWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FFTower.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%FFTower)>0) OutData%FFTower = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FFTower))-1 ), mask3, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%FFTower) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%FFTower,3), UBOUND(OutData%FFTower,3) + DO i2 = LBOUND(OutData%FFTower,2), UBOUND(OutData%FFTower,2) + DO i1 = LBOUND(OutData%FFTower,1), UBOUND(OutData%FFTower,1) + OutData%FFTower(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - OutData%FFDTime = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%FFRate = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%FFYHWid = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%FFZHWid = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RefHt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GridBase = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%InitXPosition = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%InvFFYD = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%InvFFZD = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%InvMFFWS = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MeanFFWS = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TotalTime = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NFFComp = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NFFSteps = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NYGrids = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NZGrids = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NTGrids = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%WindFileFormat = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%FFDTime = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%FFRate = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%FFYHWid = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%FFZHWid = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RefHt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GridBase = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%InitXPosition = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%InvFFYD = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%InvFFZD = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%InvMFFWS = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MeanFFWS = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TotalTime = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NFFComp = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NFFSteps = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NYGrids = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NZGrids = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NTGrids = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WindFileFormat = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IfW_TSFFWind_UnPackParam END MODULE IfW_TSFFWind_Types diff --git a/modules/inflowwind/src/IfW_UniformWind_Types.f90 b/modules/inflowwind/src/IfW_UniformWind_Types.f90 index 740539a6f2..882554e796 100644 --- a/modules/inflowwind/src/IfW_UniformWind_Types.f90 +++ b/modules/inflowwind/src/IfW_UniformWind_Types.f90 @@ -180,16 +180,16 @@ SUBROUTINE IfW_UniformWind_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Er Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%WindFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%WindFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ReferenceHeight - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RefLength - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%SumFileUnit - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%WindFileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%WindFileName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + ReKiBuf(Re_Xferred) = InData%ReferenceHeight + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RefLength + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%SumFileUnit + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IfW_UniformWind_PackInitInput SUBROUTINE IfW_UniformWind_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -205,12 +205,6 @@ SUBROUTINE IfW_UniformWind_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -225,16 +219,16 @@ SUBROUTINE IfW_UniformWind_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%WindFileName) - OutData%WindFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%ReferenceHeight = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RefLength = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SumFileUnit = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%WindFileName) + OutData%WindFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%ReferenceHeight = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RefLength = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SumFileUnit = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IfW_UniformWind_UnPackInitInput SUBROUTINE IfW_UniformWind_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -385,14 +379,16 @@ SUBROUTINE IfW_UniformWind_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, E ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%WindFileDT - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WindFileTRange))-1 ) = PACK(InData%WindFileTRange,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WindFileTRange) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WindFileNumTSteps - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%WindFileConstantDT , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%WindFileDT + Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(InData%WindFileTRange,1), UBOUND(InData%WindFileTRange,1) + ReKiBuf(Re_Xferred) = InData%WindFileTRange(i1) + Re_Xferred = Re_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%WindFileNumTSteps + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%WindFileConstantDT, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IfW_UniformWind_PackInitOutput SUBROUTINE IfW_UniformWind_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -408,12 +404,6 @@ SUBROUTINE IfW_UniformWind_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -468,23 +458,18 @@ SUBROUTINE IfW_UniformWind_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%WindFileDT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%WindFileDT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 i1_l = LBOUND(OutData%WindFileTRange,1) i1_u = UBOUND(OutData%WindFileTRange,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%WindFileTRange = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WindFileTRange))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WindFileTRange) - DEALLOCATE(mask1) - OutData%WindFileNumTSteps = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%WindFileConstantDT = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%WindFileTRange,1), UBOUND(OutData%WindFileTRange,1) + OutData%WindFileTRange(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%WindFileNumTSteps = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WindFileConstantDT = TRANSFER(IntKiBuf(Int_Xferred), OutData%WindFileConstantDT) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IfW_UniformWind_UnPackInitOutput SUBROUTINE IfW_UniformWind_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -578,8 +563,8 @@ SUBROUTINE IfW_UniformWind_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TimeIndex - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TimeIndex + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IfW_UniformWind_PackMisc SUBROUTINE IfW_UniformWind_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -595,12 +580,6 @@ SUBROUTINE IfW_UniformWind_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IfW_UniformWind_UnPackMisc' @@ -614,8 +593,8 @@ SUBROUTINE IfW_UniformWind_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%TimeIndex = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%TimeIndex = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IfW_UniformWind_UnPackMisc SUBROUTINE IfW_UniformWind_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -884,8 +863,10 @@ SUBROUTINE IfW_UniformWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TData,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TData)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TData))-1 ) = PACK(InData%TData,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TData) + DO i1 = LBOUND(InData%TData,1), UBOUND(InData%TData,1) + ReKiBuf(Re_Xferred) = InData%TData(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%DELTA) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -897,8 +878,10 @@ SUBROUTINE IfW_UniformWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DELTA,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DELTA)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DELTA))-1 ) = PACK(InData%DELTA,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DELTA) + DO i1 = LBOUND(InData%DELTA,1), UBOUND(InData%DELTA,1) + ReKiBuf(Re_Xferred) = InData%DELTA(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%V) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -910,8 +893,10 @@ SUBROUTINE IfW_UniformWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%V)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%V))-1 ) = PACK(InData%V,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%V) + DO i1 = LBOUND(InData%V,1), UBOUND(InData%V,1) + ReKiBuf(Re_Xferred) = InData%V(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%VZ) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -923,8 +908,10 @@ SUBROUTINE IfW_UniformWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VZ,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%VZ)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%VZ))-1 ) = PACK(InData%VZ,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%VZ) + DO i1 = LBOUND(InData%VZ,1), UBOUND(InData%VZ,1) + ReKiBuf(Re_Xferred) = InData%VZ(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%HSHR) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -936,8 +923,10 @@ SUBROUTINE IfW_UniformWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HSHR,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%HSHR)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%HSHR))-1 ) = PACK(InData%HSHR,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%HSHR) + DO i1 = LBOUND(InData%HSHR,1), UBOUND(InData%HSHR,1) + ReKiBuf(Re_Xferred) = InData%HSHR(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%VSHR) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -949,8 +938,10 @@ SUBROUTINE IfW_UniformWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VSHR,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%VSHR)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%VSHR))-1 ) = PACK(InData%VSHR,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%VSHR) + DO i1 = LBOUND(InData%VSHR,1), UBOUND(InData%VSHR,1) + ReKiBuf(Re_Xferred) = InData%VSHR(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%VLINSHR) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -962,8 +953,10 @@ SUBROUTINE IfW_UniformWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VLINSHR,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%VLINSHR)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%VLINSHR))-1 ) = PACK(InData%VLINSHR,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%VLINSHR) + DO i1 = LBOUND(InData%VLINSHR,1), UBOUND(InData%VLINSHR,1) + ReKiBuf(Re_Xferred) = InData%VLINSHR(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%VGUST) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -975,15 +968,17 @@ SUBROUTINE IfW_UniformWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VGUST,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%VGUST)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%VGUST))-1 ) = PACK(InData%VGUST,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%VGUST) + DO i1 = LBOUND(InData%VGUST,1), UBOUND(InData%VGUST,1) + ReKiBuf(Re_Xferred) = InData%VGUST(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RefHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RefLength - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumDataLines - Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RefHt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RefLength + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumDataLines + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IfW_UniformWind_PackParam SUBROUTINE IfW_UniformWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -999,12 +994,6 @@ SUBROUTINE IfW_UniformWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1032,15 +1021,10 @@ SUBROUTINE IfW_UniformWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TData.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TData)>0) OutData%TData = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TData))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TData) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TData,1), UBOUND(OutData%TData,1) + OutData%TData(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DELTA not allocated Int_Xferred = Int_Xferred + 1 @@ -1055,15 +1039,10 @@ SUBROUTINE IfW_UniformWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DELTA.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%DELTA)>0) OutData%DELTA = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DELTA))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DELTA) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%DELTA,1), UBOUND(OutData%DELTA,1) + OutData%DELTA(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! V not allocated Int_Xferred = Int_Xferred + 1 @@ -1078,15 +1057,10 @@ SUBROUTINE IfW_UniformWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%V.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%V)>0) OutData%V = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%V))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%V) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%V,1), UBOUND(OutData%V,1) + OutData%V(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VZ not allocated Int_Xferred = Int_Xferred + 1 @@ -1101,15 +1075,10 @@ SUBROUTINE IfW_UniformWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VZ.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%VZ)>0) OutData%VZ = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%VZ))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%VZ) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%VZ,1), UBOUND(OutData%VZ,1) + OutData%VZ(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! HSHR not allocated Int_Xferred = Int_Xferred + 1 @@ -1124,15 +1093,10 @@ SUBROUTINE IfW_UniformWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%HSHR.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%HSHR)>0) OutData%HSHR = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%HSHR))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%HSHR) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%HSHR,1), UBOUND(OutData%HSHR,1) + OutData%HSHR(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VSHR not allocated Int_Xferred = Int_Xferred + 1 @@ -1147,15 +1111,10 @@ SUBROUTINE IfW_UniformWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VSHR.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%VSHR)>0) OutData%VSHR = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%VSHR))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%VSHR) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%VSHR,1), UBOUND(OutData%VSHR,1) + OutData%VSHR(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VLINSHR not allocated Int_Xferred = Int_Xferred + 1 @@ -1170,15 +1129,10 @@ SUBROUTINE IfW_UniformWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VLINSHR.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%VLINSHR)>0) OutData%VLINSHR = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%VLINSHR))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%VLINSHR) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%VLINSHR,1), UBOUND(OutData%VLINSHR,1) + OutData%VLINSHR(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VGUST not allocated Int_Xferred = Int_Xferred + 1 @@ -1193,22 +1147,17 @@ SUBROUTINE IfW_UniformWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VGUST.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%VGUST)>0) OutData%VGUST = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%VGUST))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%VGUST) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%VGUST,1), UBOUND(OutData%VGUST,1) + OutData%VGUST(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%RefHt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RefLength = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NumDataLines = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%RefHt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RefLength = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NumDataLines = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IfW_UniformWind_UnPackParam SUBROUTINE IfW_UniformWind_CopyIntrp( SrcIntrpData, DstIntrpData, CtrlCode, ErrStat, ErrMsg ) @@ -1314,20 +1263,20 @@ SUBROUTINE IfW_UniformWind_PackIntrp( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DELTA - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%V - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%VZ - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HSHR - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%VSHR - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%VLINSHR - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%VGUST - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DELTA + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%V + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VZ + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HSHR + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VSHR + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VLINSHR + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VGUST + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IfW_UniformWind_PackIntrp SUBROUTINE IfW_UniformWind_UnPackIntrp( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1343,12 +1292,6 @@ SUBROUTINE IfW_UniformWind_UnPackIntrp( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IfW_UniformWind_UnPackIntrp' @@ -1362,20 +1305,20 @@ SUBROUTINE IfW_UniformWind_UnPackIntrp( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DELTA = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%V = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%VZ = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HSHR = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%VSHR = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%VLINSHR = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%VGUST = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DELTA = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%V = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%VZ = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HSHR = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%VSHR = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%VLINSHR = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%VGUST = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IfW_UniformWind_UnPackIntrp END MODULE IfW_UniformWind_Types diff --git a/modules/inflowwind/src/IfW_UserWind_Types.f90 b/modules/inflowwind/src/IfW_UserWind_Types.f90 index a46c2f44c1..1fa5c484ac 100644 --- a/modules/inflowwind/src/IfW_UserWind_Types.f90 +++ b/modules/inflowwind/src/IfW_UserWind_Types.f90 @@ -145,10 +145,10 @@ SUBROUTINE IfW_UserWind_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%WindFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%WindFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(InData%WindFileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%WindFileName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE IfW_UserWind_PackInitInput SUBROUTINE IfW_UserWind_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -164,12 +164,6 @@ SUBROUTINE IfW_UserWind_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IfW_UserWind_UnPackInitInput' @@ -183,10 +177,10 @@ SUBROUTINE IfW_UserWind_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%WindFileName) - OutData%WindFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%WindFileName) + OutData%WindFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE IfW_UserWind_UnPackInitInput SUBROUTINE IfW_UserWind_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -343,12 +337,6 @@ SUBROUTINE IfW_UserWind_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IfW_UserWind_UnPackInitOutput' @@ -495,8 +483,8 @@ SUBROUTINE IfW_UserWind_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyMiscVar - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyMiscVar + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IfW_UserWind_PackMisc SUBROUTINE IfW_UserWind_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -512,12 +500,6 @@ SUBROUTINE IfW_UserWind_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IfW_UserWind_UnPackMisc' @@ -531,8 +513,8 @@ SUBROUTINE IfW_UserWind_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyMiscVar = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyMiscVar = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IfW_UserWind_UnPackMisc SUBROUTINE IfW_UserWind_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -626,8 +608,8 @@ SUBROUTINE IfW_UserWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dummy - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dummy + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IfW_UserWind_PackParam SUBROUTINE IfW_UserWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -643,12 +625,6 @@ SUBROUTINE IfW_UserWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IfW_UserWind_UnPackParam' @@ -662,8 +638,8 @@ SUBROUTINE IfW_UserWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%dummy = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%dummy = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IfW_UserWind_UnPackParam END MODULE IfW_UserWind_Types diff --git a/modules/inflowwind/src/InflowWind_Types.f90 b/modules/inflowwind/src/InflowWind_Types.f90 index c18489adcd..5aa47a585e 100644 --- a/modules/inflowwind/src/InflowWind_Types.f90 +++ b/modules/inflowwind/src/InflowWind_Types.f90 @@ -350,44 +350,52 @@ SUBROUTINE InflowWind_PackWindFileMetaData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WindType - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RefHt - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%RefHt_Set , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumTSteps - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%ConstantDT , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TRange))-1 ) = PACK(InData%TRange,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TRange) - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TRange_Limited , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%YRange))-1 ) = PACK(InData%YRange,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%YRange) - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%YRange_Limited , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%ZRange))-1 ) = PACK(InData%ZRange,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%ZRange) - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%ZRange_Limited , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%BinaryFormat - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%IsBinary , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TI))-1 ) = PACK(InData%TI,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TI) - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TI_listed , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MWS - Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(InData%FileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%FileName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%WindType + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RefHt + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%RefHt_Set, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumTSteps + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%ConstantDT, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%TRange,1), UBOUND(InData%TRange,1) + ReKiBuf(Re_Xferred) = InData%TRange(i1) + Re_Xferred = Re_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = TRANSFER(InData%TRange_Limited, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%YRange,1), UBOUND(InData%YRange,1) + ReKiBuf(Re_Xferred) = InData%YRange(i1) + Re_Xferred = Re_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = TRANSFER(InData%YRange_Limited, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%ZRange,1), UBOUND(InData%ZRange,1) + ReKiBuf(Re_Xferred) = InData%ZRange(i1) + Re_Xferred = Re_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = TRANSFER(InData%ZRange_Limited, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%BinaryFormat + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%IsBinary, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%TI,1), UBOUND(InData%TI,1) + ReKiBuf(Re_Xferred) = InData%TI(i1) + Re_Xferred = Re_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = TRANSFER(InData%TI_listed, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MWS + Re_Xferred = Re_Xferred + 1 END SUBROUTINE InflowWind_PackWindFileMetaData SUBROUTINE InflowWind_UnPackWindFileMetaData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -403,12 +411,6 @@ SUBROUTINE InflowWind_UnPackWindFileMetaData( ReKiBuf, DbKiBuf, IntKiBuf, Outdat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -424,80 +426,60 @@ SUBROUTINE InflowWind_UnPackWindFileMetaData( ReKiBuf, DbKiBuf, IntKiBuf, Outdat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%FileName) - OutData%FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%WindType = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%RefHt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RefHt_Set = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%NumTSteps = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ConstantDT = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%FileName) + OutData%FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%WindType = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%RefHt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RefHt_Set = TRANSFER(IntKiBuf(Int_Xferred), OutData%RefHt_Set) + Int_Xferred = Int_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%NumTSteps = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ConstantDT = TRANSFER(IntKiBuf(Int_Xferred), OutData%ConstantDT) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%TRange,1) i1_u = UBOUND(OutData%TRange,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%TRange = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TRange))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TRange) - DEALLOCATE(mask1) - OutData%TRange_Limited = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%TRange,1), UBOUND(OutData%TRange,1) + OutData%TRange(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%TRange_Limited = TRANSFER(IntKiBuf(Int_Xferred), OutData%TRange_Limited) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%YRange,1) i1_u = UBOUND(OutData%YRange,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%YRange = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%YRange))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%YRange) - DEALLOCATE(mask1) - OutData%YRange_Limited = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%YRange,1), UBOUND(OutData%YRange,1) + OutData%YRange(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%YRange_Limited = TRANSFER(IntKiBuf(Int_Xferred), OutData%YRange_Limited) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%ZRange,1) i1_u = UBOUND(OutData%ZRange,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%ZRange = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%ZRange))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%ZRange) - DEALLOCATE(mask1) - OutData%ZRange_Limited = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%BinaryFormat = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%IsBinary = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%ZRange,1), UBOUND(OutData%ZRange,1) + OutData%ZRange(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%ZRange_Limited = TRANSFER(IntKiBuf(Int_Xferred), OutData%ZRange_Limited) + Int_Xferred = Int_Xferred + 1 + OutData%BinaryFormat = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%IsBinary = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsBinary) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%TI,1) i1_u = UBOUND(OutData%TI,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%TI = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TI))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TI) - DEALLOCATE(mask1) - OutData%TI_listed = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%MWS = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%TI,1), UBOUND(OutData%TI,1) + OutData%TI(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%TI_listed = TRANSFER(IntKiBuf(Int_Xferred), OutData%TI_listed) + Int_Xferred = Int_Xferred + 1 + OutData%MWS = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE InflowWind_UnPackWindFileMetaData SUBROUTINE InflowWind_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg ) @@ -760,14 +742,14 @@ SUBROUTINE InflowWind_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%EchoFlag , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WindType - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PropagationDir - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NWindVel - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%EchoFlag, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WindType + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PropagationDir + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NWindVel + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WindVxiList) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -778,8 +760,10 @@ SUBROUTINE InflowWind_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindVxiList,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WindVxiList)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WindVxiList))-1 ) = PACK(InData%WindVxiList,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WindVxiList) + DO i1 = LBOUND(InData%WindVxiList,1), UBOUND(InData%WindVxiList,1) + ReKiBuf(Re_Xferred) = InData%WindVxiList(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WindVyiList) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -791,8 +775,10 @@ SUBROUTINE InflowWind_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindVyiList,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WindVyiList)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WindVyiList))-1 ) = PACK(InData%WindVyiList,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WindVyiList) + DO i1 = LBOUND(InData%WindVyiList,1), UBOUND(InData%WindVyiList,1) + ReKiBuf(Re_Xferred) = InData%WindVyiList(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WindVziList) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -804,99 +790,101 @@ SUBROUTINE InflowWind_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindVziList,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WindVziList)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WindVziList))-1 ) = PACK(InData%WindVziList,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WindVziList) + DO i1 = LBOUND(InData%WindVziList,1), UBOUND(InData%WindVziList,1) + ReKiBuf(Re_Xferred) = InData%WindVziList(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Steady_HWindSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Steady_RefHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Steady_PLexp - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%Uniform_FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%Uniform_FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Uniform_RefHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Uniform_RefLength - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%TSFF_FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%TSFF_FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%BladedFF_FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%BladedFF_FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%BladedFF_TowerFile , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%CTTS_CoherentTurb , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%CTTS_FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%CTTS_FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%CTTS_Path) - IntKiBuf(Int_Xferred) = ICHAR(InData%CTTS_Path(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%HAWC_FileName_u) - IntKiBuf(Int_Xferred) = ICHAR(InData%HAWC_FileName_u(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%HAWC_FileName_v) - IntKiBuf(Int_Xferred) = ICHAR(InData%HAWC_FileName_v(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%HAWC_FileName_w) - IntKiBuf(Int_Xferred) = ICHAR(InData%HAWC_FileName_w(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%HAWC_nx - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%HAWC_ny - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%HAWC_nz - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HAWC_dx - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HAWC_dy - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HAWC_dz - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HAWC_RefHt - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%HAWC_ScaleMethod - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HAWC_SFx - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HAWC_SFy - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HAWC_SFz - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HAWC_SigmaFx - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HAWC_SigmaFy - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HAWC_SigmaFz - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HAWC_TStart - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HAWC_TEnd - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HAWC_URef - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%HAWC_ProfileType - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HAWC_PLExp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HAWC_Z0 - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%SumPrint , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Steady_HWindSpeed + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Steady_RefHt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Steady_PLexp + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(InData%Uniform_FileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%Uniform_FileName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + ReKiBuf(Re_Xferred) = InData%Uniform_RefHt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Uniform_RefLength + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(InData%TSFF_FileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%TSFF_FileName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%BladedFF_FileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%BladedFF_FileName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%BladedFF_TowerFile, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%CTTS_CoherentTurb, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%CTTS_FileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%CTTS_FileName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%CTTS_Path) + IntKiBuf(Int_Xferred) = ICHAR(InData%CTTS_Path(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%HAWC_FileName_u) + IntKiBuf(Int_Xferred) = ICHAR(InData%HAWC_FileName_u(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%HAWC_FileName_v) + IntKiBuf(Int_Xferred) = ICHAR(InData%HAWC_FileName_v(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%HAWC_FileName_w) + IntKiBuf(Int_Xferred) = ICHAR(InData%HAWC_FileName_w(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%HAWC_nx + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%HAWC_ny + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%HAWC_nz + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HAWC_dx + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HAWC_dy + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HAWC_dz + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HAWC_RefHt + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%HAWC_ScaleMethod + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HAWC_SFx + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HAWC_SFy + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HAWC_SFz + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HAWC_SigmaFx + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HAWC_SigmaFy + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HAWC_SigmaFz + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HAWC_TStart + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HAWC_TEnd + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HAWC_URef + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%HAWC_ProfileType + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HAWC_PLExp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HAWC_Z0 + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%SumPrint, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%OutList) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -907,21 +895,23 @@ SUBROUTINE InflowWind_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutList,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) + DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) DO I = 1, LEN(InData%OutList) IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%SensorType - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumPulseGate - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RotorApexOffsetPos))-1 ) = PACK(InData%RotorApexOffsetPos,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RotorApexOffsetPos) - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%LidRadialVel , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%SensorType + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumPulseGate + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%RotorApexOffsetPos,1), UBOUND(InData%RotorApexOffsetPos,1) + ReKiBuf(Re_Xferred) = InData%RotorApexOffsetPos(i1) + Re_Xferred = Re_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = TRANSFER(InData%LidRadialVel, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE InflowWind_PackInputFile SUBROUTINE InflowWind_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -937,12 +927,6 @@ SUBROUTINE InflowWind_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -957,14 +941,14 @@ SUBROUTINE InflowWind_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%EchoFlag = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%WindType = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%PropagationDir = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NWindVel = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%EchoFlag = TRANSFER(IntKiBuf(Int_Xferred), OutData%EchoFlag) + Int_Xferred = Int_Xferred + 1 + OutData%WindType = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%PropagationDir = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NWindVel = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WindVxiList not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -978,15 +962,10 @@ SUBROUTINE InflowWind_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindVxiList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WindVxiList)>0) OutData%WindVxiList = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WindVxiList))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WindVxiList) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WindVxiList,1), UBOUND(OutData%WindVxiList,1) + OutData%WindVxiList(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WindVyiList not allocated Int_Xferred = Int_Xferred + 1 @@ -1001,15 +980,10 @@ SUBROUTINE InflowWind_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindVyiList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WindVyiList)>0) OutData%WindVyiList = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WindVyiList))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WindVyiList) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WindVyiList,1), UBOUND(OutData%WindVyiList,1) + OutData%WindVyiList(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WindVziList not allocated Int_Xferred = Int_Xferred + 1 @@ -1024,106 +998,101 @@ SUBROUTINE InflowWind_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindVziList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WindVziList)>0) OutData%WindVziList = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WindVziList))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WindVziList) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WindVziList,1), UBOUND(OutData%WindVziList,1) + OutData%WindVziList(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%Steady_HWindSpeed = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Steady_RefHt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Steady_PLexp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%Uniform_FileName) - OutData%Uniform_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%Uniform_RefHt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Uniform_RefLength = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%TSFF_FileName) - OutData%TSFF_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%BladedFF_FileName) - OutData%BladedFF_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%BladedFF_TowerFile = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%CTTS_CoherentTurb = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%CTTS_FileName) - OutData%CTTS_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%CTTS_Path) - OutData%CTTS_Path(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%HAWC_FileName_u) - OutData%HAWC_FileName_u(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%HAWC_FileName_v) - OutData%HAWC_FileName_v(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%HAWC_FileName_w) - OutData%HAWC_FileName_w(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%HAWC_nx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%HAWC_ny = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%HAWC_nz = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%HAWC_dx = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HAWC_dy = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HAWC_dz = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HAWC_RefHt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HAWC_ScaleMethod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%HAWC_SFx = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HAWC_SFy = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HAWC_SFz = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HAWC_SigmaFx = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HAWC_SigmaFy = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HAWC_SigmaFz = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HAWC_TStart = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HAWC_TEnd = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HAWC_URef = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HAWC_ProfileType = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%HAWC_PLExp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HAWC_Z0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SumPrint = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%Steady_HWindSpeed = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Steady_RefHt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Steady_PLexp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(OutData%Uniform_FileName) + OutData%Uniform_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%Uniform_RefHt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Uniform_RefLength = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(OutData%TSFF_FileName) + OutData%TSFF_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%BladedFF_FileName) + OutData%BladedFF_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%BladedFF_TowerFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%BladedFF_TowerFile) + Int_Xferred = Int_Xferred + 1 + OutData%CTTS_CoherentTurb = TRANSFER(IntKiBuf(Int_Xferred), OutData%CTTS_CoherentTurb) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%CTTS_FileName) + OutData%CTTS_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%CTTS_Path) + OutData%CTTS_Path(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%HAWC_FileName_u) + OutData%HAWC_FileName_u(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%HAWC_FileName_v) + OutData%HAWC_FileName_v(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%HAWC_FileName_w) + OutData%HAWC_FileName_w(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%HAWC_nx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%HAWC_ny = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%HAWC_nz = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%HAWC_dx = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HAWC_dy = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HAWC_dz = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HAWC_RefHt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HAWC_ScaleMethod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%HAWC_SFx = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HAWC_SFy = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HAWC_SFz = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HAWC_SigmaFx = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HAWC_SigmaFy = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HAWC_SigmaFz = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HAWC_TStart = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HAWC_TEnd = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HAWC_URef = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HAWC_ProfileType = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%HAWC_PLExp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HAWC_Z0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SumPrint = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumPrint) + Int_Xferred = Int_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutList not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1137,37 +1106,25 @@ SUBROUTINE InflowWind_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) + DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) DO I = 1, LEN(OutData%OutList) OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF - OutData%SensorType = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumPulseGate = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%SensorType = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumPulseGate = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%RotorApexOffsetPos,1) i1_u = UBOUND(OutData%RotorApexOffsetPos,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%RotorApexOffsetPos = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RotorApexOffsetPos))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RotorApexOffsetPos) - DEALLOCATE(mask1) - OutData%LidRadialVel = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%RotorApexOffsetPos,1), UBOUND(OutData%RotorApexOffsetPos,1) + OutData%RotorApexOffsetPos(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%LidRadialVel = TRANSFER(IntKiBuf(Int_Xferred), OutData%LidRadialVel) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE InflowWind_UnPackInputFile SUBROUTINE InflowWind_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) @@ -1335,22 +1292,22 @@ SUBROUTINE InflowWind_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%InputFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Linearize , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Use4Dext , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumWindPoints - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%UseInputFile , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(InData%InputFileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%InputFileName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%Linearize, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%Use4Dext, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumWindPoints + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%UseInputFile, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I CALL InflowWind_Packinputfile( Re_Buf, Db_Buf, Int_Buf, InData%PassedFileData, ErrStat2, ErrMsg2, OnlySize ) ! PassedFileData CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1450,12 +1407,6 @@ SUBROUTINE InflowWind_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_UnPackInitInput' @@ -1469,22 +1420,22 @@ SUBROUTINE InflowWind_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFileName) - OutData%InputFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%Linearize = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%Use4Dext = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NumWindPoints = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%UseInputFile = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%InputFileName) + OutData%InputFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%Linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%Linearize) + Int_Xferred = Int_Xferred + 1 + OutData%Use4Dext = TRANSFER(IntKiBuf(Int_Xferred), OutData%Use4Dext) + Int_Xferred = Int_Xferred + 1 + OutData%NumWindPoints = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%UseInputFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseInputFile) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -1890,12 +1841,12 @@ SUBROUTINE InflowWind_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) + DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) DO I = 1, LEN(InData%WriteOutputHdr) IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdr(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1907,12 +1858,12 @@ SUBROUTINE InflowWind_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) + DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) DO I = 1, LEN(InData%WriteOutputUnt) IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUnt(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1980,12 +1931,12 @@ SUBROUTINE InflowWind_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_y,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%LinNames_y,1), UBOUND(InData%LinNames_y,1) + DO i1 = LBOUND(InData%LinNames_y,1), UBOUND(InData%LinNames_y,1) DO I = 1, LEN(InData%LinNames_y) IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_y(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LinNames_u) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1997,12 +1948,12 @@ SUBROUTINE InflowWind_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_u,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%LinNames_u,1), UBOUND(InData%LinNames_u,1) + DO i1 = LBOUND(InData%LinNames_u,1), UBOUND(InData%LinNames_u,1) DO I = 1, LEN(InData%LinNames_u) IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_u(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%RotFrame_y) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2014,8 +1965,10 @@ SUBROUTINE InflowWind_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_y,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RotFrame_y)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%RotFrame_y)-1 ) = TRANSFER(PACK( InData%RotFrame_y ,.TRUE.), IntKiBuf(1), SIZE(InData%RotFrame_y)) - Int_Xferred = Int_Xferred + SIZE(InData%RotFrame_y) + DO i1 = LBOUND(InData%RotFrame_y,1), UBOUND(InData%RotFrame_y,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_y(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%RotFrame_u) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2027,8 +1980,10 @@ SUBROUTINE InflowWind_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_u,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RotFrame_u)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%RotFrame_u)-1 ) = TRANSFER(PACK( InData%RotFrame_u ,.TRUE.), IntKiBuf(1), SIZE(InData%RotFrame_u)) - Int_Xferred = Int_Xferred + SIZE(InData%RotFrame_u) + DO i1 = LBOUND(InData%RotFrame_u,1), UBOUND(InData%RotFrame_u,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_u(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%IsLoad_u) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2040,8 +1995,10 @@ SUBROUTINE InflowWind_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IsLoad_u,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%IsLoad_u)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%IsLoad_u)-1 ) = TRANSFER(PACK( InData%IsLoad_u ,.TRUE.), IntKiBuf(1), SIZE(InData%IsLoad_u)) - Int_Xferred = Int_Xferred + SIZE(InData%IsLoad_u) + DO i1 = LBOUND(InData%IsLoad_u,1), UBOUND(InData%IsLoad_u,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%IsLoad_u(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF END SUBROUTINE InflowWind_PackInitOutput @@ -2058,12 +2015,6 @@ SUBROUTINE InflowWind_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -2091,19 +2042,12 @@ SUBROUTINE InflowWind_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) DO I = 1, LEN(OutData%WriteOutputHdr) OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated Int_Xferred = Int_Xferred + 1 @@ -2118,19 +2062,12 @@ SUBROUTINE InflowWind_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) DO I = 1, LEN(OutData%WriteOutputUnt) OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -2225,19 +2162,12 @@ SUBROUTINE InflowWind_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%LinNames_y,1), UBOUND(OutData%LinNames_y,1) + DO i1 = LBOUND(OutData%LinNames_y,1), UBOUND(OutData%LinNames_y,1) DO I = 1, LEN(OutData%LinNames_y) OutData%LinNames_y(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_u not allocated Int_Xferred = Int_Xferred + 1 @@ -2252,19 +2182,12 @@ SUBROUTINE InflowWind_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%LinNames_u,1), UBOUND(OutData%LinNames_u,1) + DO i1 = LBOUND(OutData%LinNames_u,1), UBOUND(OutData%LinNames_u,1) DO I = 1, LEN(OutData%LinNames_u) OutData%LinNames_u(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_y not allocated Int_Xferred = Int_Xferred + 1 @@ -2279,15 +2202,10 @@ SUBROUTINE InflowWind_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RotFrame_y)>0) OutData%RotFrame_y = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%RotFrame_y))-1 ), OutData%RotFrame_y), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%RotFrame_y) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%RotFrame_y,1), UBOUND(OutData%RotFrame_y,1) + OutData%RotFrame_y(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_y(i1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_u not allocated Int_Xferred = Int_Xferred + 1 @@ -2302,15 +2220,10 @@ SUBROUTINE InflowWind_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RotFrame_u)>0) OutData%RotFrame_u = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%RotFrame_u))-1 ), OutData%RotFrame_u), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%RotFrame_u) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%RotFrame_u,1), UBOUND(OutData%RotFrame_u,1) + OutData%RotFrame_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_u(i1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IsLoad_u not allocated Int_Xferred = Int_Xferred + 1 @@ -2325,15 +2238,10 @@ SUBROUTINE InflowWind_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%IsLoad_u)>0) OutData%IsLoad_u = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%IsLoad_u))-1 ), OutData%IsLoad_u), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%IsLoad_u) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%IsLoad_u,1), UBOUND(OutData%IsLoad_u,1) + OutData%IsLoad_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsLoad_u(i1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF END SUBROUTINE InflowWind_UnPackInitOutput @@ -2599,8 +2507,8 @@ SUBROUTINE InflowWind_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TimeIndex - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TimeIndex + Int_Xferred = Int_Xferred + 1 CALL IfW_UniformWind_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%UniformWind, ErrStat2, ErrMsg2, OnlySize ) ! UniformWind CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2779,8 +2687,10 @@ SUBROUTINE InflowWind_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AllOuts,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AllOuts)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AllOuts))-1 ) = PACK(InData%AllOuts,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AllOuts) + DO i1 = LBOUND(InData%AllOuts,1), UBOUND(InData%AllOuts,1) + ReKiBuf(Re_Xferred) = InData%AllOuts(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WindViUVW) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2795,8 +2705,12 @@ SUBROUTINE InflowWind_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindViUVW,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WindViUVW)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WindViUVW))-1 ) = PACK(InData%WindViUVW,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WindViUVW) + DO i2 = LBOUND(InData%WindViUVW,2), UBOUND(InData%WindViUVW,2) + DO i1 = LBOUND(InData%WindViUVW,1), UBOUND(InData%WindViUVW,1) + ReKiBuf(Re_Xferred) = InData%WindViUVW(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE InflowWind_PackMisc @@ -2813,12 +2727,6 @@ SUBROUTINE InflowWind_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -2834,8 +2742,8 @@ SUBROUTINE InflowWind_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%TimeIndex = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%TimeIndex = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -3089,15 +2997,10 @@ SUBROUTINE InflowWind_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOuts.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%AllOuts)>0) OutData%AllOuts = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AllOuts))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AllOuts) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AllOuts,1), UBOUND(OutData%AllOuts,1) + OutData%AllOuts(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WindViUVW not allocated Int_Xferred = Int_Xferred + 1 @@ -3115,15 +3018,12 @@ SUBROUTINE InflowWind_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindViUVW.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WindViUVW)>0) OutData%WindViUVW = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WindViUVW))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WindViUVW) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WindViUVW,2), UBOUND(OutData%WindViUVW,2) + DO i1 = LBOUND(OutData%WindViUVW,1), UBOUND(OutData%WindViUVW,1) + OutData%WindViUVW(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE InflowWind_UnPackMisc @@ -3497,20 +3397,28 @@ SUBROUTINE InflowWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%RootFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%CTTS_Flag , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PropagationDir - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RotToWind))-1 ) = PACK(InData%RotToWind,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RotToWind) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RotFromWind))-1 ) = PACK(InData%RotFromWind,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RotFromWind) + DO I = 1, LEN(InData%RootFileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootFileName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%CTTS_Flag, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PropagationDir + Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(InData%RotToWind,2), UBOUND(InData%RotToWind,2) + DO i1 = LBOUND(InData%RotToWind,1), UBOUND(InData%RotToWind,1) + ReKiBuf(Re_Xferred) = InData%RotToWind(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%RotFromWind,2), UBOUND(InData%RotFromWind,2) + DO i1 = LBOUND(InData%RotFromWind,1), UBOUND(InData%RotFromWind,1) + ReKiBuf(Re_Xferred) = InData%RotFromWind(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO IF ( .NOT. ALLOCATED(InData%WindViXYZprime) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -3524,15 +3432,19 @@ SUBROUTINE InflowWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindViXYZprime,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WindViXYZprime)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WindViXYZprime))-1 ) = PACK(InData%WindViXYZprime,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WindViXYZprime) + DO i2 = LBOUND(InData%WindViXYZprime,2), UBOUND(InData%WindViXYZprime,2) + DO i1 = LBOUND(InData%WindViXYZprime,1), UBOUND(InData%WindViXYZprime,1) + ReKiBuf(Re_Xferred) = InData%WindViXYZprime(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WindType - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ReferenceHeight - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NWindVel - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WindType + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ReferenceHeight + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NWindVel + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WindViXYZ) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -3546,8 +3458,12 @@ SUBROUTINE InflowWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindViXYZ,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WindViXYZ)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WindViXYZ))-1 ) = PACK(InData%WindViXYZ,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WindViXYZ) + DO i2 = LBOUND(InData%WindViXYZ,2), UBOUND(InData%WindViXYZ,2) + DO i1 = LBOUND(InData%WindViXYZ,1), UBOUND(InData%WindViXYZ,1) + ReKiBuf(Re_Xferred) = InData%WindViXYZ(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF CALL IfW_UniformWind_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%UniformWind, ErrStat2, ErrMsg2, OnlySize ) ! UniformWind CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3717,8 +3633,8 @@ SUBROUTINE InflowWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -3773,8 +3689,12 @@ SUBROUTINE InflowWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutParamLinIndx,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%OutParamLinIndx)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%OutParamLinIndx))-1 ) = PACK(InData%OutParamLinIndx,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%OutParamLinIndx) + DO i2 = LBOUND(InData%OutParamLinIndx,2), UBOUND(InData%OutParamLinIndx,2) + DO i1 = LBOUND(InData%OutParamLinIndx,1), UBOUND(InData%OutParamLinIndx,1) + IntKiBuf(Int_Xferred) = InData%OutParamLinIndx(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF CALL Lidar_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%lidar, ErrStat2, ErrMsg2, OnlySize ) ! lidar CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3819,12 +3739,6 @@ SUBROUTINE InflowWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -3840,42 +3754,36 @@ SUBROUTINE InflowWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%RootFileName) - OutData%RootFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%CTTS_Flag = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%PropagationDir = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(OutData%RootFileName) + OutData%RootFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%CTTS_Flag = TRANSFER(IntKiBuf(Int_Xferred), OutData%CTTS_Flag) + Int_Xferred = Int_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%PropagationDir = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%RotToWind,1) i1_u = UBOUND(OutData%RotToWind,1) i2_l = LBOUND(OutData%RotToWind,2) i2_u = UBOUND(OutData%RotToWind,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%RotToWind = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RotToWind))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RotToWind) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%RotToWind,2), UBOUND(OutData%RotToWind,2) + DO i1 = LBOUND(OutData%RotToWind,1), UBOUND(OutData%RotToWind,1) + OutData%RotToWind(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%RotFromWind,1) i1_u = UBOUND(OutData%RotFromWind,1) i2_l = LBOUND(OutData%RotFromWind,2) i2_u = UBOUND(OutData%RotFromWind,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%RotFromWind = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RotFromWind))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RotFromWind) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%RotFromWind,2), UBOUND(OutData%RotFromWind,2) + DO i1 = LBOUND(OutData%RotFromWind,1), UBOUND(OutData%RotFromWind,1) + OutData%RotFromWind(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WindViXYZprime not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3892,22 +3800,19 @@ SUBROUTINE InflowWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindViXYZprime.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WindViXYZprime)>0) OutData%WindViXYZprime = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WindViXYZprime))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WindViXYZprime) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WindViXYZprime,2), UBOUND(OutData%WindViXYZprime,2) + DO i1 = LBOUND(OutData%WindViXYZprime,1), UBOUND(OutData%WindViXYZprime,1) + OutData%WindViXYZprime(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%WindType = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ReferenceHeight = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NWindVel = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%WindType = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ReferenceHeight = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NWindVel = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WindViXYZ not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3924,15 +3829,12 @@ SUBROUTINE InflowWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindViXYZ.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WindViXYZ)>0) OutData%WindViXYZ = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WindViXYZ))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WindViXYZ) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WindViXYZ,2), UBOUND(OutData%WindViXYZ,2) + DO i1 = LBOUND(OutData%WindViXYZ,1), UBOUND(OutData%WindViXYZ,1) + OutData%WindViXYZ(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -4174,8 +4076,8 @@ SUBROUTINE InflowWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -4248,15 +4150,12 @@ SUBROUTINE InflowWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParamLinIndx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%OutParamLinIndx)>0) OutData%OutParamLinIndx = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%OutParamLinIndx))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%OutParamLinIndx) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%OutParamLinIndx,2), UBOUND(OutData%OutParamLinIndx,2) + DO i1 = LBOUND(OutData%OutParamLinIndx,1), UBOUND(OutData%OutParamLinIndx,1) + OutData%OutParamLinIndx(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -4448,8 +4347,12 @@ SUBROUTINE InflowWind_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PositionXYZ,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PositionXYZ)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PositionXYZ))-1 ) = PACK(InData%PositionXYZ,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PositionXYZ) + DO i2 = LBOUND(InData%PositionXYZ,2), UBOUND(InData%PositionXYZ,2) + DO i1 = LBOUND(InData%PositionXYZ,1), UBOUND(InData%PositionXYZ,1) + ReKiBuf(Re_Xferred) = InData%PositionXYZ(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF CALL Lidar_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%lidar, ErrStat2, ErrMsg2, OnlySize ) ! lidar CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4494,12 +4397,6 @@ SUBROUTINE InflowWind_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -4531,15 +4428,12 @@ SUBROUTINE InflowWind_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PositionXYZ.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PositionXYZ)>0) OutData%PositionXYZ = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PositionXYZ))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PositionXYZ) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PositionXYZ,2), UBOUND(OutData%PositionXYZ,2) + DO i1 = LBOUND(OutData%PositionXYZ,1), UBOUND(OutData%PositionXYZ,1) + OutData%PositionXYZ(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -4753,8 +4647,12 @@ SUBROUTINE InflowWind_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VelocityUVW,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%VelocityUVW)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%VelocityUVW))-1 ) = PACK(InData%VelocityUVW,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%VelocityUVW) + DO i2 = LBOUND(InData%VelocityUVW,2), UBOUND(InData%VelocityUVW,2) + DO i1 = LBOUND(InData%VelocityUVW,1), UBOUND(InData%VelocityUVW,1) + ReKiBuf(Re_Xferred) = InData%VelocityUVW(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutput) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4766,11 +4664,15 @@ SUBROUTINE InflowWind_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WriteOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DiskVel))-1 ) = PACK(InData%DiskVel,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DiskVel) + DO i1 = LBOUND(InData%DiskVel,1), UBOUND(InData%DiskVel,1) + ReKiBuf(Re_Xferred) = InData%DiskVel(i1) + Re_Xferred = Re_Xferred + 1 + END DO CALL Lidar_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%lidar, ErrStat2, ErrMsg2, OnlySize ) ! lidar CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4814,12 +4716,6 @@ SUBROUTINE InflowWind_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -4851,15 +4747,12 @@ SUBROUTINE InflowWind_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VelocityUVW.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%VelocityUVW)>0) OutData%VelocityUVW = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%VelocityUVW))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%VelocityUVW) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%VelocityUVW,2), UBOUND(OutData%VelocityUVW,2) + DO i1 = LBOUND(OutData%VelocityUVW,1), UBOUND(OutData%VelocityUVW,1) + OutData%VelocityUVW(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutput not allocated Int_Xferred = Int_Xferred + 1 @@ -4874,27 +4767,17 @@ SUBROUTINE InflowWind_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WriteOutput)>0) OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF i1_l = LBOUND(OutData%DiskVel,1) i1_u = UBOUND(OutData%DiskVel,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%DiskVel = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DiskVel))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DiskVel) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%DiskVel,1), UBOUND(OutData%DiskVel,1) + OutData%DiskVel(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -5028,8 +4911,8 @@ SUBROUTINE InflowWind_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyContState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyContState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE InflowWind_PackContState SUBROUTINE InflowWind_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -5045,12 +4928,6 @@ SUBROUTINE InflowWind_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_UnPackContState' @@ -5064,8 +4941,8 @@ SUBROUTINE InflowWind_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyContState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyContState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE InflowWind_UnPackContState SUBROUTINE InflowWind_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) @@ -5159,8 +5036,8 @@ SUBROUTINE InflowWind_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyDiscState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE InflowWind_PackDiscState SUBROUTINE InflowWind_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -5176,12 +5053,6 @@ SUBROUTINE InflowWind_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_UnPackDiscState' @@ -5195,8 +5066,8 @@ SUBROUTINE InflowWind_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyDiscState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyDiscState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE InflowWind_UnPackDiscState SUBROUTINE InflowWind_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -5290,8 +5161,8 @@ SUBROUTINE InflowWind_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyConstrState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE InflowWind_PackConstrState SUBROUTINE InflowWind_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -5307,12 +5178,6 @@ SUBROUTINE InflowWind_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_UnPackConstrState' @@ -5326,8 +5191,8 @@ SUBROUTINE InflowWind_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyConstrState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyConstrState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE InflowWind_UnPackConstrState SUBROUTINE InflowWind_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -5421,8 +5286,8 @@ SUBROUTINE InflowWind_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyOtherState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyOtherState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE InflowWind_PackOtherState SUBROUTINE InflowWind_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -5438,12 +5303,6 @@ SUBROUTINE InflowWind_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_UnPackOtherState' @@ -5457,8 +5316,8 @@ SUBROUTINE InflowWind_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyOtherState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyOtherState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE InflowWind_UnPackOtherState @@ -5536,14 +5395,14 @@ SUBROUTINE InflowWind_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! 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 :: i02 ! dim2 level 0 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 = "" @@ -5556,13 +5415,15 @@ SUBROUTINE InflowWind_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ALLOCATED(u_out%PositionXYZ) .AND. ALLOCATED(u1%PositionXYZ)) THEN - ALLOCATE(b2(SIZE(u_out%PositionXYZ,1),SIZE(u_out%PositionXYZ,2) )) - ALLOCATE(c2(SIZE(u_out%PositionXYZ,1),SIZE(u_out%PositionXYZ,2) )) - b2 = -(u1%PositionXYZ - u2%PositionXYZ)/t(2) - u_out%PositionXYZ = u1%PositionXYZ + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%PositionXYZ,2),UBOUND(u_out%PositionXYZ,2) + DO i1 = LBOUND(u_out%PositionXYZ,1),UBOUND(u_out%PositionXYZ,1) + b = -(u1%PositionXYZ(i1,i2) - u2%PositionXYZ(i1,i2)) + u_out%PositionXYZ(i1,i2) = u1%PositionXYZ(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated CALL Lidar_Input_ExtrapInterp1( u1%lidar, u2%lidar, tin, u_out%lidar, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) @@ -5595,15 +5456,16 @@ SUBROUTINE InflowWind_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrSt REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 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 = "" @@ -5622,14 +5484,16 @@ SUBROUTINE InflowWind_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrSt CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ALLOCATED(u_out%PositionXYZ) .AND. ALLOCATED(u1%PositionXYZ)) THEN - ALLOCATE(b2(SIZE(u_out%PositionXYZ,1),SIZE(u_out%PositionXYZ,2) )) - ALLOCATE(c2(SIZE(u_out%PositionXYZ,1),SIZE(u_out%PositionXYZ,2) )) - b2 = (t(3)**2*(u1%PositionXYZ - u2%PositionXYZ) + t(2)**2*(-u1%PositionXYZ + u3%PositionXYZ))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%PositionXYZ + t(3)*u2%PositionXYZ - t(2)*u3%PositionXYZ ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%PositionXYZ = u1%PositionXYZ + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%PositionXYZ,2),UBOUND(u_out%PositionXYZ,2) + DO i1 = LBOUND(u_out%PositionXYZ,1),UBOUND(u_out%PositionXYZ,1) + b = (t(3)**2*(u1%PositionXYZ(i1,i2) - u2%PositionXYZ(i1,i2)) + t(2)**2*(-u1%PositionXYZ(i1,i2) + u3%PositionXYZ(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%PositionXYZ(i1,i2) + t(3)*u2%PositionXYZ(i1,i2) - t(2)*u3%PositionXYZ(i1,i2) ) * scaleFactor + u_out%PositionXYZ(i1,i2) = u1%PositionXYZ(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated CALL Lidar_Input_ExtrapInterp2( u1%lidar, u2%lidar, u3%lidar, tin, u_out%lidar, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) @@ -5710,14 +5574,14 @@ SUBROUTINE InflowWind_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! 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 :: i02 ! dim2 level 0 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 = "" @@ -5730,28 +5594,26 @@ SUBROUTINE InflowWind_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ALLOCATED(y_out%VelocityUVW) .AND. ALLOCATED(y1%VelocityUVW)) THEN - ALLOCATE(b2(SIZE(y_out%VelocityUVW,1),SIZE(y_out%VelocityUVW,2) )) - ALLOCATE(c2(SIZE(y_out%VelocityUVW,1),SIZE(y_out%VelocityUVW,2) )) - b2 = -(y1%VelocityUVW - y2%VelocityUVW)/t(2) - y_out%VelocityUVW = y1%VelocityUVW + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%VelocityUVW,2),UBOUND(y_out%VelocityUVW,2) + DO i1 = LBOUND(y_out%VelocityUVW,1),UBOUND(y_out%VelocityUVW,1) + b = -(y1%VelocityUVW(i1,i2) - y2%VelocityUVW(i1,i2)) + y_out%VelocityUVW(i1,i2) = y1%VelocityUVW(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END IF ! check if allocated - ALLOCATE(b1(SIZE(y_out%DiskVel,1))) - ALLOCATE(c1(SIZE(y_out%DiskVel,1))) - b1 = -(y1%DiskVel - y2%DiskVel)/t(2) - y_out%DiskVel = y1%DiskVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%DiskVel,1),UBOUND(y_out%DiskVel,1) + b = -(y1%DiskVel(i1) - y2%DiskVel(i1)) + y_out%DiskVel(i1) = y1%DiskVel(i1) + b * ScaleFactor + END DO CALL Lidar_Output_ExtrapInterp1( y1%lidar, y2%lidar, tin, y_out%lidar, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE InflowWind_Output_ExtrapInterp1 @@ -5783,15 +5645,16 @@ SUBROUTINE InflowWind_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrS REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 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 = "" @@ -5810,31 +5673,29 @@ SUBROUTINE InflowWind_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrS CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ALLOCATED(y_out%VelocityUVW) .AND. ALLOCATED(y1%VelocityUVW)) THEN - ALLOCATE(b2(SIZE(y_out%VelocityUVW,1),SIZE(y_out%VelocityUVW,2) )) - ALLOCATE(c2(SIZE(y_out%VelocityUVW,1),SIZE(y_out%VelocityUVW,2) )) - b2 = (t(3)**2*(y1%VelocityUVW - y2%VelocityUVW) + t(2)**2*(-y1%VelocityUVW + y3%VelocityUVW))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*y1%VelocityUVW + t(3)*y2%VelocityUVW - t(2)*y3%VelocityUVW ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%VelocityUVW = y1%VelocityUVW + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%VelocityUVW,2),UBOUND(y_out%VelocityUVW,2) + DO i1 = LBOUND(y_out%VelocityUVW,1),UBOUND(y_out%VelocityUVW,1) + b = (t(3)**2*(y1%VelocityUVW(i1,i2) - y2%VelocityUVW(i1,i2)) + t(2)**2*(-y1%VelocityUVW(i1,i2) + y3%VelocityUVW(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*y1%VelocityUVW(i1,i2) + t(3)*y2%VelocityUVW(i1,i2) - t(2)*y3%VelocityUVW(i1,i2) ) * scaleFactor + y_out%VelocityUVW(i1,i2) = y1%VelocityUVW(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END IF ! check if allocated - ALLOCATE(b1(SIZE(y_out%DiskVel,1))) - ALLOCATE(c1(SIZE(y_out%DiskVel,1))) - b1 = (t(3)**2*(y1%DiskVel - y2%DiskVel) + t(2)**2*(-y1%DiskVel + y3%DiskVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%DiskVel + t(3)*y2%DiskVel - t(2)*y3%DiskVel ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%DiskVel = y1%DiskVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%DiskVel,1),UBOUND(y_out%DiskVel,1) + b = (t(3)**2*(y1%DiskVel(i1) - y2%DiskVel(i1)) + t(2)**2*(-y1%DiskVel(i1) + y3%DiskVel(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%DiskVel(i1) + t(3)*y2%DiskVel(i1) - t(2)*y3%DiskVel(i1) ) * scaleFactor + y_out%DiskVel(i1) = y1%DiskVel(i1) + b + c * t_out + END DO 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 InflowWind_Output_ExtrapInterp2 diff --git a/modules/inflowwind/src/Lidar_Types.f90 b/modules/inflowwind/src/Lidar_Types.f90 index 88981bcf4c..4ec86f6a34 100644 --- a/modules/inflowwind/src/Lidar_Types.f90 +++ b/modules/inflowwind/src/Lidar_Types.f90 @@ -209,18 +209,22 @@ SUBROUTINE Lidar_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%SensorType - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%Tmax - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RotorApexOffsetPos))-1 ) = PACK(InData%RotorApexOffsetPos,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RotorApexOffsetPos) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%HubPosition))-1 ) = PACK(InData%HubPosition,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%HubPosition) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumPulseGate - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%LidRadialVel , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%SensorType + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%Tmax + Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(InData%RotorApexOffsetPos,1), UBOUND(InData%RotorApexOffsetPos,1) + ReKiBuf(Re_Xferred) = InData%RotorApexOffsetPos(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%HubPosition,1), UBOUND(InData%HubPosition,1) + ReKiBuf(Re_Xferred) = InData%HubPosition(i1) + Re_Xferred = Re_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%NumPulseGate + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%LidRadialVel, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Lidar_PackInitInput SUBROUTINE Lidar_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -236,12 +240,6 @@ SUBROUTINE Lidar_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -256,36 +254,26 @@ SUBROUTINE Lidar_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%SensorType = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%Tmax = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%SensorType = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Tmax = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 i1_l = LBOUND(OutData%RotorApexOffsetPos,1) i1_u = UBOUND(OutData%RotorApexOffsetPos,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%RotorApexOffsetPos = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RotorApexOffsetPos))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RotorApexOffsetPos) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%RotorApexOffsetPos,1), UBOUND(OutData%RotorApexOffsetPos,1) + OutData%RotorApexOffsetPos(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%HubPosition,1) i1_u = UBOUND(OutData%HubPosition,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%HubPosition = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%HubPosition))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%HubPosition) - DEALLOCATE(mask1) - OutData%NumPulseGate = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%LidRadialVel = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%HubPosition,1), UBOUND(OutData%HubPosition,1) + OutData%HubPosition(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%NumPulseGate = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%LidRadialVel = TRANSFER(IntKiBuf(Int_Xferred), OutData%LidRadialVel) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Lidar_UnPackInitInput SUBROUTINE Lidar_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -379,8 +367,8 @@ SUBROUTINE Lidar_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyInitOut - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyInitOut + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Lidar_PackInitOutput SUBROUTINE Lidar_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -396,12 +384,6 @@ SUBROUTINE Lidar_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_UnPackInitOutput' @@ -415,8 +397,8 @@ SUBROUTINE Lidar_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyInitOut = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyInitOut = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Lidar_UnPackInitOutput SUBROUTINE Lidar_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -531,28 +513,30 @@ SUBROUTINE Lidar_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumPulseGate - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RotorApexOffsetPos))-1 ) = PACK(InData%RotorApexOffsetPos,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RotorApexOffsetPos) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RayRangeSq - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SpatialRes - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%SensorType - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WtFnTrunc - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PulseRangeOne - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DeltaP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DeltaR - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%r_p - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%LidRadialVel , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumPulseGate + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%RotorApexOffsetPos,1), UBOUND(InData%RotorApexOffsetPos,1) + ReKiBuf(Re_Xferred) = InData%RotorApexOffsetPos(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%RayRangeSq + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SpatialRes + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%SensorType + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtFnTrunc + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PulseRangeOne + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DeltaP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DeltaR + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%r_p + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%LidRadialVel, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Lidar_PackParam SUBROUTINE Lidar_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -568,12 +552,6 @@ SUBROUTINE Lidar_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -588,37 +566,32 @@ SUBROUTINE Lidar_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%NumPulseGate = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NumPulseGate = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%RotorApexOffsetPos,1) i1_u = UBOUND(OutData%RotorApexOffsetPos,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%RotorApexOffsetPos = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RotorApexOffsetPos))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RotorApexOffsetPos) - DEALLOCATE(mask1) - OutData%RayRangeSq = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SpatialRes = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SensorType = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%WtFnTrunc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PulseRangeOne = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%DeltaP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%DeltaR = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%r_p = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%LidRadialVel = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%RotorApexOffsetPos,1), UBOUND(OutData%RotorApexOffsetPos,1) + OutData%RotorApexOffsetPos(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%RayRangeSq = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SpatialRes = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SensorType = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WtFnTrunc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PulseRangeOne = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%DeltaP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%DeltaR = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%r_p = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LidRadialVel = TRANSFER(IntKiBuf(Int_Xferred), OutData%LidRadialVel) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Lidar_UnPackParam SUBROUTINE Lidar_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) @@ -712,8 +685,8 @@ SUBROUTINE Lidar_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyContState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyContState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Lidar_PackContState SUBROUTINE Lidar_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -729,12 +702,6 @@ SUBROUTINE Lidar_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_UnPackContState' @@ -748,8 +715,8 @@ SUBROUTINE Lidar_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyContState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyContState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Lidar_UnPackContState SUBROUTINE Lidar_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) @@ -843,8 +810,8 @@ SUBROUTINE Lidar_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyDiscState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Lidar_PackDiscState SUBROUTINE Lidar_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -860,12 +827,6 @@ SUBROUTINE Lidar_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_UnPackDiscState' @@ -879,8 +840,8 @@ SUBROUTINE Lidar_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyDiscState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyDiscState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Lidar_UnPackDiscState SUBROUTINE Lidar_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -974,8 +935,8 @@ SUBROUTINE Lidar_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyConstrState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Lidar_PackConstrState SUBROUTINE Lidar_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -991,12 +952,6 @@ SUBROUTINE Lidar_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_UnPackConstrState' @@ -1010,8 +965,8 @@ SUBROUTINE Lidar_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyConstrState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyConstrState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Lidar_UnPackConstrState SUBROUTINE Lidar_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -1105,8 +1060,8 @@ SUBROUTINE Lidar_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyOtherState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyOtherState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Lidar_PackOtherState SUBROUTINE Lidar_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1122,12 +1077,6 @@ SUBROUTINE Lidar_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_UnPackOtherState' @@ -1141,8 +1090,8 @@ SUBROUTINE Lidar_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyOtherState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyOtherState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Lidar_UnPackOtherState SUBROUTINE Lidar_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -1236,8 +1185,8 @@ SUBROUTINE Lidar_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyMiscVar - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyMiscVar + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Lidar_PackMisc SUBROUTINE Lidar_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1253,12 +1202,6 @@ SUBROUTINE Lidar_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_UnPackMisc' @@ -1272,8 +1215,8 @@ SUBROUTINE Lidar_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyMiscVar = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyMiscVar = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Lidar_UnPackMisc SUBROUTINE Lidar_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -1374,14 +1317,18 @@ SUBROUTINE Lidar_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LidPosition))-1 ) = PACK(InData%LidPosition,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LidPosition) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MsrPosition))-1 ) = PACK(InData%MsrPosition,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MsrPosition) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PulseLidEl - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PulseLidAz - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%LidPosition,1), UBOUND(InData%LidPosition,1) + ReKiBuf(Re_Xferred) = InData%LidPosition(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%MsrPosition,1), UBOUND(InData%MsrPosition,1) + ReKiBuf(Re_Xferred) = InData%MsrPosition(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%PulseLidEl + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PulseLidAz + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Lidar_PackInput SUBROUTINE Lidar_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1397,12 +1344,6 @@ SUBROUTINE Lidar_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1419,30 +1360,20 @@ SUBROUTINE Lidar_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM Int_Xferred = 1 i1_l = LBOUND(OutData%LidPosition,1) i1_u = UBOUND(OutData%LidPosition,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%LidPosition = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LidPosition))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LidPosition) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LidPosition,1), UBOUND(OutData%LidPosition,1) + OutData%LidPosition(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%MsrPosition,1) i1_u = UBOUND(OutData%MsrPosition,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%MsrPosition = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MsrPosition))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MsrPosition) - DEALLOCATE(mask1) - OutData%PulseLidEl = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PulseLidAz = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%MsrPosition,1), UBOUND(OutData%MsrPosition,1) + OutData%MsrPosition(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%PulseLidEl = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PulseLidAz = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Lidar_UnPackInput SUBROUTINE Lidar_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -1585,8 +1516,10 @@ SUBROUTINE Lidar_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LidSpeed,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LidSpeed)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LidSpeed))-1 ) = PACK(InData%LidSpeed,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LidSpeed) + DO i1 = LBOUND(InData%LidSpeed,1), UBOUND(InData%LidSpeed,1) + ReKiBuf(Re_Xferred) = InData%LidSpeed(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WtTrunc) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1598,8 +1531,10 @@ SUBROUTINE Lidar_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WtTrunc,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WtTrunc)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WtTrunc))-1 ) = PACK(InData%WtTrunc,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WtTrunc) + DO i1 = LBOUND(InData%WtTrunc,1), UBOUND(InData%WtTrunc,1) + ReKiBuf(Re_Xferred) = InData%WtTrunc(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE Lidar_PackOutput @@ -1616,12 +1551,6 @@ SUBROUTINE Lidar_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1649,15 +1578,10 @@ SUBROUTINE Lidar_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LidSpeed.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LidSpeed)>0) OutData%LidSpeed = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LidSpeed))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LidSpeed) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LidSpeed,1), UBOUND(OutData%LidSpeed,1) + OutData%LidSpeed(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WtTrunc not allocated Int_Xferred = Int_Xferred + 1 @@ -1672,15 +1596,10 @@ SUBROUTINE Lidar_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WtTrunc.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WtTrunc)>0) OutData%WtTrunc = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WtTrunc))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WtTrunc) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WtTrunc,1), UBOUND(OutData%WtTrunc,1) + OutData%WtTrunc(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE Lidar_UnPackOutput @@ -1759,12 +1678,12 @@ SUBROUTINE Lidar_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMs REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! 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 :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -1777,22 +1696,20 @@ SUBROUTINE Lidar_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(b1(SIZE(u_out%LidPosition,1))) - ALLOCATE(c1(SIZE(u_out%LidPosition,1))) - b1 = -(u1%LidPosition - u2%LidPosition)/t(2) - u_out%LidPosition = u1%LidPosition + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%MsrPosition,1))) - ALLOCATE(c1(SIZE(u_out%MsrPosition,1))) - b1 = -(u1%MsrPosition - u2%MsrPosition)/t(2) - u_out%MsrPosition = u1%MsrPosition + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - b0 = -(u1%PulseLidEl - u2%PulseLidEl)/t(2) - u_out%PulseLidEl = u1%PulseLidEl + b0 * t_out - b0 = -(u1%PulseLidAz - u2%PulseLidAz)/t(2) - u_out%PulseLidAz = u1%PulseLidAz + b0 * t_out + + ScaleFactor = t_out / t(2) + DO i1 = LBOUND(u_out%LidPosition,1),UBOUND(u_out%LidPosition,1) + b = -(u1%LidPosition(i1) - u2%LidPosition(i1)) + u_out%LidPosition(i1) = u1%LidPosition(i1) + b * ScaleFactor + END DO + DO i1 = LBOUND(u_out%MsrPosition,1),UBOUND(u_out%MsrPosition,1) + b = -(u1%MsrPosition(i1) - u2%MsrPosition(i1)) + u_out%MsrPosition(i1) = u1%MsrPosition(i1) + b * ScaleFactor + END DO + b = -(u1%PulseLidEl - u2%PulseLidEl) + u_out%PulseLidEl = u1%PulseLidEl + b * ScaleFactor + b = -(u1%PulseLidAz - u2%PulseLidAz) + u_out%PulseLidAz = u1%PulseLidAz + b * ScaleFactor END SUBROUTINE Lidar_Input_ExtrapInterp1 @@ -1822,13 +1739,14 @@ SUBROUTINE Lidar_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, E REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -1847,26 +1765,24 @@ SUBROUTINE Lidar_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, E CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(b1(SIZE(u_out%LidPosition,1))) - ALLOCATE(c1(SIZE(u_out%LidPosition,1))) - b1 = (t(3)**2*(u1%LidPosition - u2%LidPosition) + t(2)**2*(-u1%LidPosition + u3%LidPosition))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%LidPosition + t(3)*u2%LidPosition - t(2)*u3%LidPosition ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%LidPosition = u1%LidPosition + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%MsrPosition,1))) - ALLOCATE(c1(SIZE(u_out%MsrPosition,1))) - b1 = (t(3)**2*(u1%MsrPosition - u2%MsrPosition) + t(2)**2*(-u1%MsrPosition + u3%MsrPosition))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%MsrPosition + t(3)*u2%MsrPosition - t(2)*u3%MsrPosition ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%MsrPosition = u1%MsrPosition + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - b0 = (t(3)**2*(u1%PulseLidEl - u2%PulseLidEl) + t(2)**2*(-u1%PulseLidEl + u3%PulseLidEl))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%PulseLidEl + t(3)*u2%PulseLidEl - t(2)*u3%PulseLidEl ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%PulseLidEl = u1%PulseLidEl + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%PulseLidAz - u2%PulseLidAz) + t(2)**2*(-u1%PulseLidAz + u3%PulseLidAz))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%PulseLidAz + t(3)*u2%PulseLidAz - t(2)*u3%PulseLidAz ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%PulseLidAz = u1%PulseLidAz + b0 * t_out + c0 * t_out**2 + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) + DO i1 = LBOUND(u_out%LidPosition,1),UBOUND(u_out%LidPosition,1) + b = (t(3)**2*(u1%LidPosition(i1) - u2%LidPosition(i1)) + t(2)**2*(-u1%LidPosition(i1) + u3%LidPosition(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%LidPosition(i1) + t(3)*u2%LidPosition(i1) - t(2)*u3%LidPosition(i1) ) * scaleFactor + u_out%LidPosition(i1) = u1%LidPosition(i1) + b + c * t_out + END DO + DO i1 = LBOUND(u_out%MsrPosition,1),UBOUND(u_out%MsrPosition,1) + b = (t(3)**2*(u1%MsrPosition(i1) - u2%MsrPosition(i1)) + t(2)**2*(-u1%MsrPosition(i1) + u3%MsrPosition(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%MsrPosition(i1) + t(3)*u2%MsrPosition(i1) - t(2)*u3%MsrPosition(i1) ) * scaleFactor + u_out%MsrPosition(i1) = u1%MsrPosition(i1) + b + c * t_out + END DO + b = (t(3)**2*(u1%PulseLidEl - u2%PulseLidEl) + t(2)**2*(-u1%PulseLidEl + u3%PulseLidEl))* scaleFactor + c = ( (t(2)-t(3))*u1%PulseLidEl + t(3)*u2%PulseLidEl - t(2)*u3%PulseLidEl ) * scaleFactor + u_out%PulseLidEl = u1%PulseLidEl + b + c * t_out + b = (t(3)**2*(u1%PulseLidAz - u2%PulseLidAz) + t(2)**2*(-u1%PulseLidAz + u3%PulseLidAz))* scaleFactor + c = ( (t(2)-t(3))*u1%PulseLidAz + t(3)*u2%PulseLidAz - t(2)*u3%PulseLidAz ) * scaleFactor + u_out%PulseLidAz = u1%PulseLidAz + b + c * t_out END SUBROUTINE Lidar_Input_ExtrapInterp2 @@ -1944,12 +1860,12 @@ SUBROUTINE Lidar_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrM REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! 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 :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -1962,21 +1878,19 @@ SUBROUTINE Lidar_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ALLOCATED(y_out%LidSpeed) .AND. ALLOCATED(y1%LidSpeed)) THEN - ALLOCATE(b1(SIZE(y_out%LidSpeed,1))) - ALLOCATE(c1(SIZE(y_out%LidSpeed,1))) - b1 = -(y1%LidSpeed - y2%LidSpeed)/t(2) - y_out%LidSpeed = y1%LidSpeed + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%LidSpeed,1),UBOUND(y_out%LidSpeed,1) + b = -(y1%LidSpeed(i1) - y2%LidSpeed(i1)) + y_out%LidSpeed(i1) = y1%LidSpeed(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ALLOCATED(y_out%WtTrunc) .AND. ALLOCATED(y1%WtTrunc)) THEN - ALLOCATE(b1(SIZE(y_out%WtTrunc,1))) - ALLOCATE(c1(SIZE(y_out%WtTrunc,1))) - b1 = -(y1%WtTrunc - y2%WtTrunc)/t(2) - y_out%WtTrunc = y1%WtTrunc + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WtTrunc,1),UBOUND(y_out%WtTrunc,1) + b = -(y1%WtTrunc(i1) - y2%WtTrunc(i1)) + y_out%WtTrunc(i1) = y1%WtTrunc(i1) + b * ScaleFactor + END DO END IF ! check if allocated END SUBROUTINE Lidar_Output_ExtrapInterp1 @@ -2007,13 +1921,14 @@ SUBROUTINE Lidar_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -2032,23 +1947,21 @@ SUBROUTINE Lidar_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ALLOCATED(y_out%LidSpeed) .AND. ALLOCATED(y1%LidSpeed)) THEN - ALLOCATE(b1(SIZE(y_out%LidSpeed,1))) - ALLOCATE(c1(SIZE(y_out%LidSpeed,1))) - b1 = (t(3)**2*(y1%LidSpeed - y2%LidSpeed) + t(2)**2*(-y1%LidSpeed + y3%LidSpeed))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%LidSpeed + t(3)*y2%LidSpeed - t(2)*y3%LidSpeed ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%LidSpeed = y1%LidSpeed + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%LidSpeed,1),UBOUND(y_out%LidSpeed,1) + b = (t(3)**2*(y1%LidSpeed(i1) - y2%LidSpeed(i1)) + t(2)**2*(-y1%LidSpeed(i1) + y3%LidSpeed(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%LidSpeed(i1) + t(3)*y2%LidSpeed(i1) - t(2)*y3%LidSpeed(i1) ) * scaleFactor + y_out%LidSpeed(i1) = y1%LidSpeed(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ALLOCATED(y_out%WtTrunc) .AND. ALLOCATED(y1%WtTrunc)) THEN - ALLOCATE(b1(SIZE(y_out%WtTrunc,1))) - ALLOCATE(c1(SIZE(y_out%WtTrunc,1))) - b1 = (t(3)**2*(y1%WtTrunc - y2%WtTrunc) + t(2)**2*(-y1%WtTrunc + y3%WtTrunc))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WtTrunc + t(3)*y2%WtTrunc - t(2)*y3%WtTrunc ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WtTrunc = y1%WtTrunc + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WtTrunc,1),UBOUND(y_out%WtTrunc,1) + b = (t(3)**2*(y1%WtTrunc(i1) - y2%WtTrunc(i1)) + t(2)**2*(-y1%WtTrunc(i1) + y3%WtTrunc(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WtTrunc(i1) + t(3)*y2%WtTrunc(i1) - t(2)*y3%WtTrunc(i1) ) * scaleFactor + y_out%WtTrunc(i1) = y1%WtTrunc(i1) + b + c * t_out + END DO END IF ! check if allocated END SUBROUTINE Lidar_Output_ExtrapInterp2 diff --git a/modules/map/src/MAP_Fortran_Types.f90 b/modules/map/src/MAP_Fortran_Types.f90 index f20c4687cc..47c34ab7c1 100644 --- a/modules/map/src/MAP_Fortran_Types.f90 +++ b/modules/map/src/MAP_Fortran_Types.f90 @@ -146,8 +146,8 @@ SUBROUTINE MAP_Fortran_PackLin_InitInputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%linearize , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%linearize, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE MAP_Fortran_PackLin_InitInputType SUBROUTINE MAP_Fortran_UnPackLin_InitInputType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -163,12 +163,6 @@ SUBROUTINE MAP_Fortran_UnPackLin_InitInputType( ReKiBuf, DbKiBuf, IntKiBuf, Outd INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -184,8 +178,8 @@ SUBROUTINE MAP_Fortran_UnPackLin_InitInputType( ReKiBuf, DbKiBuf, IntKiBuf, Outd Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%linearize = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%linearize) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE MAP_Fortran_UnPackLin_InitInputType SUBROUTINE MAP_Fortran_CopyLin_InitOutputType( SrcLin_InitOutputTypeData, DstLin_InitOutputTypeData, CtrlCode, ErrStat, ErrMsg ) @@ -348,12 +342,12 @@ SUBROUTINE MAP_Fortran_PackLin_InitOutputType( ReKiBuf, DbKiBuf, IntKiBuf, Indat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_y,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%LinNames_y,1), UBOUND(InData%LinNames_y,1) + DO i1 = LBOUND(InData%LinNames_y,1), UBOUND(InData%LinNames_y,1) DO I = 1, LEN(InData%LinNames_y) IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_y(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LinNames_u) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -365,12 +359,12 @@ SUBROUTINE MAP_Fortran_PackLin_InitOutputType( ReKiBuf, DbKiBuf, IntKiBuf, Indat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_u,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%LinNames_u,1), UBOUND(InData%LinNames_u,1) + DO i1 = LBOUND(InData%LinNames_u,1), UBOUND(InData%LinNames_u,1) DO I = 1, LEN(InData%LinNames_u) IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_u(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%IsLoad_u) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -382,8 +376,10 @@ SUBROUTINE MAP_Fortran_PackLin_InitOutputType( ReKiBuf, DbKiBuf, IntKiBuf, Indat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IsLoad_u,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%IsLoad_u)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%IsLoad_u)-1 ) = TRANSFER(PACK( InData%IsLoad_u ,.TRUE.), IntKiBuf(1), SIZE(InData%IsLoad_u)) - Int_Xferred = Int_Xferred + SIZE(InData%IsLoad_u) + DO i1 = LBOUND(InData%IsLoad_u,1), UBOUND(InData%IsLoad_u,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%IsLoad_u(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF END SUBROUTINE MAP_Fortran_PackLin_InitOutputType @@ -400,12 +396,6 @@ SUBROUTINE MAP_Fortran_UnPackLin_InitOutputType( ReKiBuf, DbKiBuf, IntKiBuf, Out INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -433,19 +423,12 @@ SUBROUTINE MAP_Fortran_UnPackLin_InitOutputType( ReKiBuf, DbKiBuf, IntKiBuf, Out CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%LinNames_y,1), UBOUND(OutData%LinNames_y,1) + DO i1 = LBOUND(OutData%LinNames_y,1), UBOUND(OutData%LinNames_y,1) DO I = 1, LEN(OutData%LinNames_y) OutData%LinNames_y(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_u not allocated Int_Xferred = Int_Xferred + 1 @@ -460,19 +443,12 @@ SUBROUTINE MAP_Fortran_UnPackLin_InitOutputType( ReKiBuf, DbKiBuf, IntKiBuf, Out CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%LinNames_u,1), UBOUND(OutData%LinNames_u,1) + DO i1 = LBOUND(OutData%LinNames_u,1), UBOUND(OutData%LinNames_u,1) DO I = 1, LEN(OutData%LinNames_u) OutData%LinNames_u(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IsLoad_u not allocated Int_Xferred = Int_Xferred + 1 @@ -487,15 +463,10 @@ SUBROUTINE MAP_Fortran_UnPackLin_InitOutputType( ReKiBuf, DbKiBuf, IntKiBuf, Out CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%IsLoad_u)>0) OutData%IsLoad_u = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%IsLoad_u))-1 ), OutData%IsLoad_u), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%IsLoad_u) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%IsLoad_u,1), UBOUND(OutData%IsLoad_u,1) + OutData%IsLoad_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsLoad_u(i1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF END SUBROUTINE MAP_Fortran_UnPackLin_InitOutputType @@ -629,13 +600,17 @@ SUBROUTINE MAP_Fortran_PackLin_ParamType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Jac_u_indx)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%Jac_u_indx))-1 ) = PACK(InData%Jac_u_indx,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%Jac_u_indx) + DO i2 = LBOUND(InData%Jac_u_indx,2), UBOUND(InData%Jac_u_indx,2) + DO i1 = LBOUND(InData%Jac_u_indx,1), UBOUND(InData%Jac_u_indx,1) + IntKiBuf(Int_Xferred) = InData%Jac_u_indx(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%du - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Jac_ny - Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%du + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Jac_ny + Int_Xferred = Int_Xferred + 1 END SUBROUTINE MAP_Fortran_PackLin_ParamType SUBROUTINE MAP_Fortran_UnPackLin_ParamType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -651,12 +626,6 @@ SUBROUTINE MAP_Fortran_UnPackLin_ParamType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -688,20 +657,17 @@ SUBROUTINE MAP_Fortran_UnPackLin_ParamType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Jac_u_indx)>0) OutData%Jac_u_indx = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%Jac_u_indx))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%Jac_u_indx) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Jac_u_indx,2), UBOUND(OutData%Jac_u_indx,2) + DO i1 = LBOUND(OutData%Jac_u_indx,1), UBOUND(OutData%Jac_u_indx,1) + OutData%Jac_u_indx(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF - OutData%du = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%Jac_ny = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%du = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%Jac_ny = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE MAP_Fortran_UnPackLin_ParamType END MODULE MAP_Fortran_Types diff --git a/modules/map/src/MAP_Types.f90 b/modules/map/src/MAP_Types.f90 index f72e25ddf5..1b15b8f331 100644 --- a/modules/map/src/MAP_Types.f90 +++ b/modules/map/src/MAP_Types.f90 @@ -388,36 +388,36 @@ SUBROUTINE MAP_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%gravity - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%sea_density - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%depth - Db_Xferred = Db_Xferred + 1 - DO I = 1, LEN(InData%file_name) - IntKiBuf(Int_Xferred) = ICHAR(InData%file_name(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%summary_file_name) - IntKiBuf(Int_Xferred) = ICHAR(InData%summary_file_name(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%library_input_str) - IntKiBuf(Int_Xferred) = ICHAR(InData%library_input_str(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%node_input_str) - IntKiBuf(Int_Xferred) = ICHAR(InData%node_input_str(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%line_input_str) - IntKiBuf(Int_Xferred) = ICHAR(InData%line_input_str(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%option_input_str) - IntKiBuf(Int_Xferred) = ICHAR(InData%option_input_str(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DbKiBuf(Db_Xferred) = InData%gravity + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%sea_density + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%depth + Db_Xferred = Db_Xferred + 1 + DO I = 1, LEN(InData%file_name) + IntKiBuf(Int_Xferred) = ICHAR(InData%file_name(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%summary_file_name) + IntKiBuf(Int_Xferred) = ICHAR(InData%summary_file_name(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%library_input_str) + IntKiBuf(Int_Xferred) = ICHAR(InData%library_input_str(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%node_input_str) + IntKiBuf(Int_Xferred) = ICHAR(InData%node_input_str(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%line_input_str) + IntKiBuf(Int_Xferred) = ICHAR(InData%line_input_str(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%option_input_str) + IntKiBuf(Int_Xferred) = ICHAR(InData%option_input_str(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I CALL MAP_Fortran_Packlin_initinputtype( Re_Buf, Db_Buf, Int_Buf, InData%LinInitInp, ErrStat2, ErrMsg2, OnlySize ) ! LinInitInp CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -461,12 +461,6 @@ SUBROUTINE MAP_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -481,44 +475,44 @@ SUBROUTINE MAP_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%gravity = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%gravity = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 OutData%C_obj%gravity = OutData%gravity - OutData%sea_density = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%sea_density = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 OutData%C_obj%sea_density = OutData%sea_density - OutData%depth = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%depth = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 OutData%C_obj%depth = OutData%depth - DO I = 1, LEN(OutData%file_name) - OutData%file_name(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%file_name) + OutData%file_name(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I OutData%C_obj%file_name = TRANSFER(OutData%file_name, OutData%C_obj%file_name ) - DO I = 1, LEN(OutData%summary_file_name) - OutData%summary_file_name(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%summary_file_name) + OutData%summary_file_name(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I OutData%C_obj%summary_file_name = TRANSFER(OutData%summary_file_name, OutData%C_obj%summary_file_name ) - DO I = 1, LEN(OutData%library_input_str) - OutData%library_input_str(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%library_input_str) + OutData%library_input_str(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I OutData%C_obj%library_input_str = TRANSFER(OutData%library_input_str, OutData%C_obj%library_input_str ) - DO I = 1, LEN(OutData%node_input_str) - OutData%node_input_str(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%node_input_str) + OutData%node_input_str(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I OutData%C_obj%node_input_str = TRANSFER(OutData%node_input_str, OutData%C_obj%node_input_str ) - DO I = 1, LEN(OutData%line_input_str) - OutData%line_input_str(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%line_input_str) + OutData%line_input_str(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I OutData%C_obj%line_input_str = TRANSFER(OutData%line_input_str, OutData%C_obj%line_input_str ) - DO I = 1, LEN(OutData%option_input_str) - OutData%option_input_str(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%option_input_str) + OutData%option_input_str(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I OutData%C_obj%option_input_str = TRANSFER(OutData%option_input_str, OutData%C_obj%option_input_str ) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -562,13 +556,21 @@ SUBROUTINE MAP_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END SUBROUTINE MAP_UnPackInitInput - SUBROUTINE MAP_C2Fary_CopyInitInput( InitInputData, ErrStat, ErrMsg ) + SUBROUTINE MAP_C2Fary_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers ) TYPE(MAP_InitInputType), INTENT(INOUT) :: InitInputData 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 InitInputData%gravity = InitInputData%C_obj%gravity InitInputData%sea_density = InitInputData%C_obj%sea_density InitInputData%depth = InitInputData%C_obj%depth @@ -580,6 +582,32 @@ SUBROUTINE MAP_C2Fary_CopyInitInput( InitInputData, ErrStat, ErrMsg ) InitInputData%option_input_str = TRANSFER(InitInputData%C_obj%option_input_str, InitInputData%option_input_str ) END SUBROUTINE MAP_C2Fary_CopyInitInput + SUBROUTINE MAP_F2C_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(MAP_InitInputType), INTENT(INOUT) :: InitInputData + 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 + InitInputData%C_obj%gravity = InitInputData%gravity + InitInputData%C_obj%sea_density = InitInputData%sea_density + InitInputData%C_obj%depth = InitInputData%depth + InitInputData%C_obj%file_name = TRANSFER(InitInputData%file_name, InitInputData%C_obj%file_name ) + InitInputData%C_obj%summary_file_name = TRANSFER(InitInputData%summary_file_name, InitInputData%C_obj%summary_file_name ) + InitInputData%C_obj%library_input_str = TRANSFER(InitInputData%library_input_str, InitInputData%C_obj%library_input_str ) + 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 ) + END SUBROUTINE MAP_F2C_CopyInitInput + SUBROUTINE MAP_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(MAP_InitOutputType), INTENT(IN) :: SrcInitOutputData TYPE(MAP_InitOutputType), INTENT(INOUT) :: DstInitOutputData @@ -764,18 +792,18 @@ SUBROUTINE MAP_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%progName) - IntKiBuf(Int_Xferred) = ICHAR(InData%progName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%version) - IntKiBuf(Int_Xferred) = ICHAR(InData%version(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%compilingData) - IntKiBuf(Int_Xferred) = ICHAR(InData%compilingData(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(InData%progName) + IntKiBuf(Int_Xferred) = ICHAR(InData%progName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%version) + IntKiBuf(Int_Xferred) = ICHAR(InData%version(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%compilingData) + IntKiBuf(Int_Xferred) = ICHAR(InData%compilingData(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( .NOT. ALLOCATED(InData%writeOutputHdr) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -786,12 +814,12 @@ SUBROUTINE MAP_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%writeOutputHdr,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%writeOutputHdr,1), UBOUND(InData%writeOutputHdr,1) + DO i1 = LBOUND(InData%writeOutputHdr,1), UBOUND(InData%writeOutputHdr,1) DO I = 1, LEN(InData%writeOutputHdr) IntKiBuf(Int_Xferred) = ICHAR(InData%writeOutputHdr(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%writeOutputUnt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -803,12 +831,12 @@ SUBROUTINE MAP_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%writeOutputUnt,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%writeOutputUnt,1), UBOUND(InData%writeOutputUnt,1) + DO i1 = LBOUND(InData%writeOutputUnt,1), UBOUND(InData%writeOutputUnt,1) DO I = 1, LEN(InData%writeOutputUnt) IntKiBuf(Int_Xferred) = ICHAR(InData%writeOutputUnt(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -881,12 +909,6 @@ SUBROUTINE MAP_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -901,20 +923,20 @@ SUBROUTINE MAP_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%progName) - OutData%progName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%progName) + OutData%progName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I OutData%C_obj%progName = TRANSFER(OutData%progName, OutData%C_obj%progName ) - DO I = 1, LEN(OutData%version) - OutData%version(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%version) + OutData%version(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I OutData%C_obj%version = TRANSFER(OutData%version, OutData%C_obj%version ) - DO I = 1, LEN(OutData%compilingData) - OutData%compilingData(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%compilingData) + OutData%compilingData(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I OutData%C_obj%compilingData = TRANSFER(OutData%compilingData, OutData%C_obj%compilingData ) IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! writeOutputHdr not allocated Int_Xferred = Int_Xferred + 1 @@ -929,19 +951,12 @@ SUBROUTINE MAP_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%writeOutputHdr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%writeOutputHdr,1), UBOUND(OutData%writeOutputHdr,1) + DO i1 = LBOUND(OutData%writeOutputHdr,1), UBOUND(OutData%writeOutputHdr,1) DO I = 1, LEN(OutData%writeOutputHdr) OutData%writeOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! writeOutputUnt not allocated Int_Xferred = Int_Xferred + 1 @@ -956,19 +971,12 @@ SUBROUTINE MAP_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%writeOutputUnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%writeOutputUnt,1), UBOUND(OutData%writeOutputUnt,1) + DO i1 = LBOUND(OutData%writeOutputUnt,1), UBOUND(OutData%writeOutputUnt,1) DO I = 1, LEN(OutData%writeOutputUnt) OutData%writeOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -1052,18 +1060,46 @@ SUBROUTINE MAP_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END SUBROUTINE MAP_UnPackInitOutput - SUBROUTINE MAP_C2Fary_CopyInitOutput( InitOutputData, ErrStat, ErrMsg ) + SUBROUTINE MAP_C2Fary_CopyInitOutput( InitOutputData, ErrStat, ErrMsg, SkipPointers ) TYPE(MAP_InitOutputType), INTENT(INOUT) :: InitOutputData 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 InitOutputData%progName = TRANSFER(InitOutputData%C_obj%progName, InitOutputData%progName ) InitOutputData%version = TRANSFER(InitOutputData%C_obj%version, InitOutputData%version ) InitOutputData%compilingData = TRANSFER(InitOutputData%C_obj%compilingData, InitOutputData%compilingData ) END SUBROUTINE MAP_C2Fary_CopyInitOutput + SUBROUTINE MAP_F2C_CopyInitOutput( InitOutputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(MAP_InitOutputType), INTENT(INOUT) :: InitOutputData + 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 + InitOutputData%C_obj%progName = TRANSFER(InitOutputData%progName, InitOutputData%C_obj%progName ) + InitOutputData%C_obj%version = TRANSFER(InitOutputData%version, InitOutputData%C_obj%version ) + InitOutputData%C_obj%compilingData = TRANSFER(InitOutputData%compilingData, InitOutputData%C_obj%compilingData ) + END SUBROUTINE MAP_F2C_CopyInitOutput + SUBROUTINE MAP_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(MAP_ContinuousStateType), INTENT(IN) :: SrcContStateData TYPE(MAP_ContinuousStateType), INTENT(INOUT) :: DstContStateData @@ -1158,8 +1194,8 @@ SUBROUTINE MAP_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%dummy - Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%dummy + Db_Xferred = Db_Xferred + 1 END SUBROUTINE MAP_PackContState SUBROUTINE MAP_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1175,12 +1211,6 @@ SUBROUTINE MAP_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'MAP_UnPackContState' @@ -1194,21 +1224,47 @@ SUBROUTINE MAP_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%dummy = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%dummy = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 OutData%C_obj%dummy = OutData%dummy END SUBROUTINE MAP_UnPackContState - SUBROUTINE MAP_C2Fary_CopyContState( ContStateData, ErrStat, ErrMsg ) + SUBROUTINE MAP_C2Fary_CopyContState( ContStateData, ErrStat, ErrMsg, SkipPointers ) TYPE(MAP_ContinuousStateType), INTENT(INOUT) :: ContStateData 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 ContStateData%dummy = ContStateData%C_obj%dummy END SUBROUTINE MAP_C2Fary_CopyContState + SUBROUTINE MAP_F2C_CopyContState( ContStateData, ErrStat, ErrMsg, SkipPointers ) + TYPE(MAP_ContinuousStateType), INTENT(INOUT) :: ContStateData + 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 + ContStateData%C_obj%dummy = ContStateData%dummy + END SUBROUTINE MAP_F2C_CopyContState + SUBROUTINE MAP_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(MAP_DiscreteStateType), INTENT(IN) :: SrcDiscStateData TYPE(MAP_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData @@ -1303,8 +1359,8 @@ SUBROUTINE MAP_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%dummy - Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%dummy + Db_Xferred = Db_Xferred + 1 END SUBROUTINE MAP_PackDiscState SUBROUTINE MAP_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1320,12 +1376,6 @@ SUBROUTINE MAP_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'MAP_UnPackDiscState' @@ -1339,21 +1389,47 @@ SUBROUTINE MAP_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%dummy = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%dummy = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 OutData%C_obj%dummy = OutData%dummy END SUBROUTINE MAP_UnPackDiscState - SUBROUTINE MAP_C2Fary_CopyDiscState( DiscStateData, ErrStat, ErrMsg ) + SUBROUTINE MAP_C2Fary_CopyDiscState( DiscStateData, ErrStat, ErrMsg, SkipPointers ) TYPE(MAP_DiscreteStateType), INTENT(INOUT) :: DiscStateData 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 DiscStateData%dummy = DiscStateData%C_obj%dummy END SUBROUTINE MAP_C2Fary_CopyDiscState + SUBROUTINE MAP_F2C_CopyDiscState( DiscStateData, ErrStat, ErrMsg, SkipPointers ) + TYPE(MAP_DiscreteStateType), INTENT(INOUT) :: DiscStateData + 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 + DiscStateData%C_obj%dummy = DiscStateData%dummy + END SUBROUTINE MAP_F2C_CopyDiscState + SUBROUTINE MAP_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(MAP_OtherStateType), INTENT(IN) :: SrcOtherStateData TYPE(MAP_OtherStateType), INTENT(INOUT) :: DstOtherStateData @@ -1872,8 +1948,10 @@ SUBROUTINE MAP_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%H,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%H)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%H))-1 ) = PACK(InData%H,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%H) + DO i1 = LBOUND(InData%H,1), UBOUND(InData%H,1) + DbKiBuf(Db_Xferred) = InData%H(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%V) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1885,8 +1963,10 @@ SUBROUTINE MAP_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%V)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%V))-1 ) = PACK(InData%V,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%V) + DO i1 = LBOUND(InData%V,1), UBOUND(InData%V,1) + DbKiBuf(Db_Xferred) = InData%V(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%Ha) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1898,8 +1978,10 @@ SUBROUTINE MAP_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ha,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Ha)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Ha))-1 ) = PACK(InData%Ha,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Ha) + DO i1 = LBOUND(InData%Ha,1), UBOUND(InData%Ha,1) + DbKiBuf(Db_Xferred) = InData%Ha(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%Va) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1911,8 +1993,10 @@ SUBROUTINE MAP_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Va,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Va)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Va))-1 ) = PACK(InData%Va,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Va) + DO i1 = LBOUND(InData%Va,1), UBOUND(InData%Va,1) + DbKiBuf(Db_Xferred) = InData%Va(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%x) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1924,8 +2008,10 @@ SUBROUTINE MAP_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%x)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%x))-1 ) = PACK(InData%x,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%x) + DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) + DbKiBuf(Db_Xferred) = InData%x(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%y) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1937,8 +2023,10 @@ SUBROUTINE MAP_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%y)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%y))-1 ) = PACK(InData%y,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%y) + DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) + DbKiBuf(Db_Xferred) = InData%y(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%z) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1950,8 +2038,10 @@ SUBROUTINE MAP_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%z)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%z))-1 ) = PACK(InData%z,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%z) + DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) + DbKiBuf(Db_Xferred) = InData%z(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%xa) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1963,8 +2053,10 @@ SUBROUTINE MAP_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xa,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%xa)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%xa))-1 ) = PACK(InData%xa,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%xa) + DO i1 = LBOUND(InData%xa,1), UBOUND(InData%xa,1) + DbKiBuf(Db_Xferred) = InData%xa(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%ya) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1976,8 +2068,10 @@ SUBROUTINE MAP_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ya,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ya)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%ya))-1 ) = PACK(InData%ya,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%ya) + DO i1 = LBOUND(InData%ya,1), UBOUND(InData%ya,1) + DbKiBuf(Db_Xferred) = InData%ya(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%za) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1989,8 +2083,10 @@ SUBROUTINE MAP_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%za,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%za)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%za))-1 ) = PACK(InData%za,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%za) + DO i1 = LBOUND(InData%za,1), UBOUND(InData%za,1) + DbKiBuf(Db_Xferred) = InData%za(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%Fx_connect) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2002,8 +2098,10 @@ SUBROUTINE MAP_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fx_connect,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Fx_connect)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Fx_connect))-1 ) = PACK(InData%Fx_connect,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Fx_connect) + DO i1 = LBOUND(InData%Fx_connect,1), UBOUND(InData%Fx_connect,1) + DbKiBuf(Db_Xferred) = InData%Fx_connect(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%Fy_connect) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2015,8 +2113,10 @@ SUBROUTINE MAP_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fy_connect,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Fy_connect)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Fy_connect))-1 ) = PACK(InData%Fy_connect,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Fy_connect) + DO i1 = LBOUND(InData%Fy_connect,1), UBOUND(InData%Fy_connect,1) + DbKiBuf(Db_Xferred) = InData%Fy_connect(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%Fz_connect) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2028,8 +2128,10 @@ SUBROUTINE MAP_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fz_connect,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Fz_connect)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Fz_connect))-1 ) = PACK(InData%Fz_connect,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Fz_connect) + DO i1 = LBOUND(InData%Fz_connect,1), UBOUND(InData%Fz_connect,1) + DbKiBuf(Db_Xferred) = InData%Fz_connect(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%Fx_anchor) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2041,8 +2143,10 @@ SUBROUTINE MAP_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fx_anchor,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Fx_anchor)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Fx_anchor))-1 ) = PACK(InData%Fx_anchor,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Fx_anchor) + DO i1 = LBOUND(InData%Fx_anchor,1), UBOUND(InData%Fx_anchor,1) + DbKiBuf(Db_Xferred) = InData%Fx_anchor(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%Fy_anchor) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2054,8 +2158,10 @@ SUBROUTINE MAP_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fy_anchor,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Fy_anchor)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Fy_anchor))-1 ) = PACK(InData%Fy_anchor,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Fy_anchor) + DO i1 = LBOUND(InData%Fy_anchor,1), UBOUND(InData%Fy_anchor,1) + DbKiBuf(Db_Xferred) = InData%Fy_anchor(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%Fz_anchor) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2067,8 +2173,10 @@ SUBROUTINE MAP_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fz_anchor,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Fz_anchor)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Fz_anchor))-1 ) = PACK(InData%Fz_anchor,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Fz_anchor) + DO i1 = LBOUND(InData%Fz_anchor,1), UBOUND(InData%Fz_anchor,1) + DbKiBuf(Db_Xferred) = InData%Fz_anchor(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF END SUBROUTINE MAP_PackOtherState @@ -2085,12 +2193,6 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -2121,15 +2223,10 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E OutData%c_obj%H_Len = SIZE(OutData%H) IF (OutData%c_obj%H_Len > 0) & OutData%c_obj%H = C_LOC( OutData%H(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%H)>0) OutData%H = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%H))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%H) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%H,1), UBOUND(OutData%H,1) + OutData%H(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! V not allocated Int_Xferred = Int_Xferred + 1 @@ -2147,15 +2244,10 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E OutData%c_obj%V_Len = SIZE(OutData%V) IF (OutData%c_obj%V_Len > 0) & OutData%c_obj%V = C_LOC( OutData%V(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%V)>0) OutData%V = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%V))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%V) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%V,1), UBOUND(OutData%V,1) + OutData%V(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Ha not allocated Int_Xferred = Int_Xferred + 1 @@ -2173,15 +2265,10 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E OutData%c_obj%Ha_Len = SIZE(OutData%Ha) IF (OutData%c_obj%Ha_Len > 0) & OutData%c_obj%Ha = C_LOC( OutData%Ha(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Ha)>0) OutData%Ha = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Ha))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%Ha) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Ha,1), UBOUND(OutData%Ha,1) + OutData%Ha(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Va not allocated Int_Xferred = Int_Xferred + 1 @@ -2199,15 +2286,10 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E OutData%c_obj%Va_Len = SIZE(OutData%Va) IF (OutData%c_obj%Va_Len > 0) & OutData%c_obj%Va = C_LOC( OutData%Va(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Va)>0) OutData%Va = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Va))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%Va) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Va,1), UBOUND(OutData%Va,1) + OutData%Va(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x not allocated Int_Xferred = Int_Xferred + 1 @@ -2225,15 +2307,10 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E OutData%c_obj%x_Len = SIZE(OutData%x) IF (OutData%c_obj%x_Len > 0) & OutData%c_obj%x = C_LOC( OutData%x(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%x)>0) OutData%x = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%x))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%x) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) + OutData%x(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y not allocated Int_Xferred = Int_Xferred + 1 @@ -2251,15 +2328,10 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E OutData%c_obj%y_Len = SIZE(OutData%y) IF (OutData%c_obj%y_Len > 0) & OutData%c_obj%y = C_LOC( OutData%y(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%y)>0) OutData%y = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%y))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%y) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%y,1), UBOUND(OutData%y,1) + OutData%y(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z not allocated Int_Xferred = Int_Xferred + 1 @@ -2277,15 +2349,10 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E OutData%c_obj%z_Len = SIZE(OutData%z) IF (OutData%c_obj%z_Len > 0) & OutData%c_obj%z = C_LOC( OutData%z(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%z)>0) OutData%z = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%z))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%z) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) + OutData%z(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xa not allocated Int_Xferred = Int_Xferred + 1 @@ -2303,15 +2370,10 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E OutData%c_obj%xa_Len = SIZE(OutData%xa) IF (OutData%c_obj%xa_Len > 0) & OutData%c_obj%xa = C_LOC( OutData%xa(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%xa)>0) OutData%xa = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%xa))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%xa) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%xa,1), UBOUND(OutData%xa,1) + OutData%xa(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ya not allocated Int_Xferred = Int_Xferred + 1 @@ -2329,15 +2391,10 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E OutData%c_obj%ya_Len = SIZE(OutData%ya) IF (OutData%c_obj%ya_Len > 0) & OutData%c_obj%ya = C_LOC( OutData%ya(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%ya)>0) OutData%ya = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%ya))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%ya) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%ya,1), UBOUND(OutData%ya,1) + OutData%ya(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! za not allocated Int_Xferred = Int_Xferred + 1 @@ -2355,15 +2412,10 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E OutData%c_obj%za_Len = SIZE(OutData%za) IF (OutData%c_obj%za_Len > 0) & OutData%c_obj%za = C_LOC( OutData%za(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%za)>0) OutData%za = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%za))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%za) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%za,1), UBOUND(OutData%za,1) + OutData%za(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fx_connect not allocated Int_Xferred = Int_Xferred + 1 @@ -2381,15 +2433,10 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E OutData%c_obj%Fx_connect_Len = SIZE(OutData%Fx_connect) IF (OutData%c_obj%Fx_connect_Len > 0) & OutData%c_obj%Fx_connect = C_LOC( OutData%Fx_connect(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Fx_connect)>0) OutData%Fx_connect = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Fx_connect))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%Fx_connect) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Fx_connect,1), UBOUND(OutData%Fx_connect,1) + OutData%Fx_connect(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fy_connect not allocated Int_Xferred = Int_Xferred + 1 @@ -2407,15 +2454,10 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E OutData%c_obj%Fy_connect_Len = SIZE(OutData%Fy_connect) IF (OutData%c_obj%Fy_connect_Len > 0) & OutData%c_obj%Fy_connect = C_LOC( OutData%Fy_connect(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Fy_connect)>0) OutData%Fy_connect = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Fy_connect))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%Fy_connect) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Fy_connect,1), UBOUND(OutData%Fy_connect,1) + OutData%Fy_connect(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fz_connect not allocated Int_Xferred = Int_Xferred + 1 @@ -2433,15 +2475,10 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E OutData%c_obj%Fz_connect_Len = SIZE(OutData%Fz_connect) IF (OutData%c_obj%Fz_connect_Len > 0) & OutData%c_obj%Fz_connect = C_LOC( OutData%Fz_connect(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Fz_connect)>0) OutData%Fz_connect = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Fz_connect))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%Fz_connect) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Fz_connect,1), UBOUND(OutData%Fz_connect,1) + OutData%Fz_connect(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fx_anchor not allocated Int_Xferred = Int_Xferred + 1 @@ -2459,15 +2496,10 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E OutData%c_obj%Fx_anchor_Len = SIZE(OutData%Fx_anchor) IF (OutData%c_obj%Fx_anchor_Len > 0) & OutData%c_obj%Fx_anchor = C_LOC( OutData%Fx_anchor(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Fx_anchor)>0) OutData%Fx_anchor = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Fx_anchor))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%Fx_anchor) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Fx_anchor,1), UBOUND(OutData%Fx_anchor,1) + OutData%Fx_anchor(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fy_anchor not allocated Int_Xferred = Int_Xferred + 1 @@ -2485,15 +2517,10 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E OutData%c_obj%Fy_anchor_Len = SIZE(OutData%Fy_anchor) IF (OutData%c_obj%Fy_anchor_Len > 0) & OutData%c_obj%Fy_anchor = C_LOC( OutData%Fy_anchor(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Fy_anchor)>0) OutData%Fy_anchor = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Fy_anchor))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%Fy_anchor) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Fy_anchor,1), UBOUND(OutData%Fy_anchor,1) + OutData%Fy_anchor(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fz_anchor not allocated Int_Xferred = Int_Xferred + 1 @@ -2511,139 +2538,383 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E OutData%c_obj%Fz_anchor_Len = SIZE(OutData%Fz_anchor) IF (OutData%c_obj%Fz_anchor_Len > 0) & OutData%c_obj%Fz_anchor = C_LOC( OutData%Fz_anchor(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Fz_anchor)>0) OutData%Fz_anchor = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Fz_anchor))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%Fz_anchor) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Fz_anchor,1), UBOUND(OutData%Fz_anchor,1) + OutData%Fz_anchor(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF END SUBROUTINE MAP_UnPackOtherState - SUBROUTINE MAP_C2Fary_CopyOtherState( OtherStateData, ErrStat, ErrMsg ) + SUBROUTINE MAP_C2Fary_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ) TYPE(MAP_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" - ! -- H OtherState Data fields - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%H ) ) THEN - NULLIFY( OtherStateData%H ) + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers ELSE - CALL C_F_POINTER(OtherStateData%C_obj%H, OtherStateData%H, (/OtherStateData%C_obj%H_Len/)) + SkipPointers_local = .false. + END IF + + ! -- H OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%H ) ) THEN + NULLIFY( OtherStateData%H ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%H, OtherStateData%H, (/OtherStateData%C_obj%H_Len/)) + END IF END IF ! -- V OtherState Data fields - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%V ) ) THEN - NULLIFY( OtherStateData%V ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%V, OtherStateData%V, (/OtherStateData%C_obj%V_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%V ) ) THEN + NULLIFY( OtherStateData%V ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%V, OtherStateData%V, (/OtherStateData%C_obj%V_Len/)) + END IF END IF ! -- Ha OtherState Data fields - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Ha ) ) THEN - NULLIFY( OtherStateData%Ha ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%Ha, OtherStateData%Ha, (/OtherStateData%C_obj%Ha_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Ha ) ) THEN + NULLIFY( OtherStateData%Ha ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%Ha, OtherStateData%Ha, (/OtherStateData%C_obj%Ha_Len/)) + END IF END IF ! -- Va OtherState Data fields - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Va ) ) THEN - NULLIFY( OtherStateData%Va ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%Va, OtherStateData%Va, (/OtherStateData%C_obj%Va_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Va ) ) THEN + NULLIFY( OtherStateData%Va ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%Va, OtherStateData%Va, (/OtherStateData%C_obj%Va_Len/)) + END IF END IF ! -- x OtherState Data fields - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%x ) ) THEN - NULLIFY( OtherStateData%x ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%x, OtherStateData%x, (/OtherStateData%C_obj%x_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%x ) ) THEN + NULLIFY( OtherStateData%x ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%x, OtherStateData%x, (/OtherStateData%C_obj%x_Len/)) + END IF END IF ! -- y OtherState Data fields - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%y ) ) THEN - NULLIFY( OtherStateData%y ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%y, OtherStateData%y, (/OtherStateData%C_obj%y_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%y ) ) THEN + NULLIFY( OtherStateData%y ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%y, OtherStateData%y, (/OtherStateData%C_obj%y_Len/)) + END IF END IF ! -- z OtherState Data fields - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%z ) ) THEN - NULLIFY( OtherStateData%z ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%z, OtherStateData%z, (/OtherStateData%C_obj%z_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%z ) ) THEN + NULLIFY( OtherStateData%z ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%z, OtherStateData%z, (/OtherStateData%C_obj%z_Len/)) + END IF END IF ! -- xa OtherState Data fields - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%xa ) ) THEN - NULLIFY( OtherStateData%xa ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%xa, OtherStateData%xa, (/OtherStateData%C_obj%xa_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%xa ) ) THEN + NULLIFY( OtherStateData%xa ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%xa, OtherStateData%xa, (/OtherStateData%C_obj%xa_Len/)) + END IF END IF ! -- ya OtherState Data fields - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%ya ) ) THEN - NULLIFY( OtherStateData%ya ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%ya, OtherStateData%ya, (/OtherStateData%C_obj%ya_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%ya ) ) THEN + NULLIFY( OtherStateData%ya ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%ya, OtherStateData%ya, (/OtherStateData%C_obj%ya_Len/)) + END IF END IF ! -- za OtherState Data fields - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%za ) ) THEN - NULLIFY( OtherStateData%za ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%za, OtherStateData%za, (/OtherStateData%C_obj%za_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%za ) ) THEN + NULLIFY( OtherStateData%za ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%za, OtherStateData%za, (/OtherStateData%C_obj%za_Len/)) + END IF END IF ! -- Fx_connect OtherState Data fields - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fx_connect ) ) THEN - NULLIFY( OtherStateData%Fx_connect ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%Fx_connect, OtherStateData%Fx_connect, (/OtherStateData%C_obj%Fx_connect_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fx_connect ) ) THEN + NULLIFY( OtherStateData%Fx_connect ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%Fx_connect, OtherStateData%Fx_connect, (/OtherStateData%C_obj%Fx_connect_Len/)) + END IF END IF ! -- Fy_connect OtherState Data fields - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fy_connect ) ) THEN - NULLIFY( OtherStateData%Fy_connect ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%Fy_connect, OtherStateData%Fy_connect, (/OtherStateData%C_obj%Fy_connect_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fy_connect ) ) THEN + NULLIFY( OtherStateData%Fy_connect ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%Fy_connect, OtherStateData%Fy_connect, (/OtherStateData%C_obj%Fy_connect_Len/)) + END IF END IF ! -- Fz_connect OtherState Data fields - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fz_connect ) ) THEN - NULLIFY( OtherStateData%Fz_connect ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%Fz_connect, OtherStateData%Fz_connect, (/OtherStateData%C_obj%Fz_connect_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fz_connect ) ) THEN + NULLIFY( OtherStateData%Fz_connect ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%Fz_connect, OtherStateData%Fz_connect, (/OtherStateData%C_obj%Fz_connect_Len/)) + END IF END IF ! -- Fx_anchor OtherState Data fields - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fx_anchor ) ) THEN - NULLIFY( OtherStateData%Fx_anchor ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%Fx_anchor, OtherStateData%Fx_anchor, (/OtherStateData%C_obj%Fx_anchor_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fx_anchor ) ) THEN + NULLIFY( OtherStateData%Fx_anchor ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%Fx_anchor, OtherStateData%Fx_anchor, (/OtherStateData%C_obj%Fx_anchor_Len/)) + END IF END IF ! -- Fy_anchor OtherState Data fields - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fy_anchor ) ) THEN - NULLIFY( OtherStateData%Fy_anchor ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%Fy_anchor, OtherStateData%Fy_anchor, (/OtherStateData%C_obj%Fy_anchor_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fy_anchor ) ) THEN + NULLIFY( OtherStateData%Fy_anchor ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%Fy_anchor, OtherStateData%Fy_anchor, (/OtherStateData%C_obj%Fy_anchor_Len/)) + END IF END IF ! -- Fz_anchor OtherState Data fields - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fz_anchor ) ) THEN - NULLIFY( OtherStateData%Fz_anchor ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%Fz_anchor, OtherStateData%Fz_anchor, (/OtherStateData%C_obj%Fz_anchor_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fz_anchor ) ) THEN + NULLIFY( OtherStateData%Fz_anchor ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%Fz_anchor, OtherStateData%Fz_anchor, (/OtherStateData%C_obj%Fz_anchor_Len/)) + END IF END IF END SUBROUTINE MAP_C2Fary_CopyOtherState + SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ) + TYPE(MAP_OtherStateType), INTENT(INOUT) :: OtherStateData + 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 + + ! -- H OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OtherStateData%H)) THEN + OtherStateData%c_obj%H_Len = 0 + OtherStateData%c_obj%H = C_NULL_PTR + 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) ) ) + END IF + END IF + + ! -- V OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OtherStateData%V)) THEN + OtherStateData%c_obj%V_Len = 0 + OtherStateData%c_obj%V = C_NULL_PTR + 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) ) ) + END IF + END IF + + ! -- Ha OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OtherStateData%Ha)) THEN + OtherStateData%c_obj%Ha_Len = 0 + OtherStateData%c_obj%Ha = C_NULL_PTR + 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) ) ) + END IF + END IF + + ! -- Va OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OtherStateData%Va)) THEN + OtherStateData%c_obj%Va_Len = 0 + OtherStateData%c_obj%Va = C_NULL_PTR + 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) ) ) + END IF + END IF + + ! -- x OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OtherStateData%x)) THEN + OtherStateData%c_obj%x_Len = 0 + OtherStateData%c_obj%x = C_NULL_PTR + 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) ) ) + END IF + END IF + + ! -- y OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OtherStateData%y)) THEN + OtherStateData%c_obj%y_Len = 0 + OtherStateData%c_obj%y = C_NULL_PTR + 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) ) ) + END IF + END IF + + ! -- z OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OtherStateData%z)) THEN + OtherStateData%c_obj%z_Len = 0 + OtherStateData%c_obj%z = C_NULL_PTR + 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) ) ) + END IF + END IF + + ! -- xa OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OtherStateData%xa)) THEN + OtherStateData%c_obj%xa_Len = 0 + OtherStateData%c_obj%xa = C_NULL_PTR + 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) ) ) + END IF + END IF + + ! -- ya OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OtherStateData%ya)) THEN + OtherStateData%c_obj%ya_Len = 0 + OtherStateData%c_obj%ya = C_NULL_PTR + 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) ) ) + END IF + END IF + + ! -- za OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OtherStateData%za)) THEN + OtherStateData%c_obj%za_Len = 0 + OtherStateData%c_obj%za = C_NULL_PTR + 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) ) ) + END IF + END IF + + ! -- Fx_connect OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OtherStateData%Fx_connect)) THEN + OtherStateData%c_obj%Fx_connect_Len = 0 + OtherStateData%c_obj%Fx_connect = C_NULL_PTR + 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) ) ) + END IF + END IF + + ! -- Fy_connect OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OtherStateData%Fy_connect)) THEN + OtherStateData%c_obj%Fy_connect_Len = 0 + OtherStateData%c_obj%Fy_connect = C_NULL_PTR + 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) ) ) + END IF + END IF + + ! -- Fz_connect OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OtherStateData%Fz_connect)) THEN + OtherStateData%c_obj%Fz_connect_Len = 0 + OtherStateData%c_obj%Fz_connect = C_NULL_PTR + 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) ) ) + END IF + END IF + + ! -- Fx_anchor OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OtherStateData%Fx_anchor)) THEN + OtherStateData%c_obj%Fx_anchor_Len = 0 + OtherStateData%c_obj%Fx_anchor = C_NULL_PTR + 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) ) ) + END IF + END IF + + ! -- Fy_anchor OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OtherStateData%Fy_anchor)) THEN + OtherStateData%c_obj%Fy_anchor_Len = 0 + OtherStateData%c_obj%Fy_anchor = C_NULL_PTR + 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) ) ) + END IF + END IF + + ! -- Fz_anchor OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OtherStateData%Fz_anchor)) THEN + OtherStateData%c_obj%Fz_anchor_Len = 0 + OtherStateData%c_obj%Fz_anchor = C_NULL_PTR + 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) ) ) + END IF + END IF + END SUBROUTINE MAP_F2C_CopyOtherState + SUBROUTINE MAP_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(MAP_ConstraintStateType), INTENT(IN) :: SrcConstrStateData TYPE(MAP_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData @@ -2876,8 +3147,10 @@ SUBROUTINE MAP_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%H,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%H)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%H))-1 ) = PACK(InData%H,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%H) + DO i1 = LBOUND(InData%H,1), UBOUND(InData%H,1) + DbKiBuf(Db_Xferred) = InData%H(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%V) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2889,8 +3162,10 @@ SUBROUTINE MAP_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%V)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%V))-1 ) = PACK(InData%V,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%V) + DO i1 = LBOUND(InData%V,1), UBOUND(InData%V,1) + DbKiBuf(Db_Xferred) = InData%V(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%x) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2902,8 +3177,10 @@ SUBROUTINE MAP_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%x)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%x))-1 ) = PACK(InData%x,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%x) + DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) + DbKiBuf(Db_Xferred) = InData%x(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%y) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2915,8 +3192,10 @@ SUBROUTINE MAP_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%y)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%y))-1 ) = PACK(InData%y,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%y) + DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) + DbKiBuf(Db_Xferred) = InData%y(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%z) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2928,8 +3207,10 @@ SUBROUTINE MAP_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%z)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%z))-1 ) = PACK(InData%z,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%z) + DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) + DbKiBuf(Db_Xferred) = InData%z(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF END SUBROUTINE MAP_PackConstrState @@ -2946,12 +3227,6 @@ SUBROUTINE MAP_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -2982,15 +3257,10 @@ SUBROUTINE MAP_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, OutData%c_obj%H_Len = SIZE(OutData%H) IF (OutData%c_obj%H_Len > 0) & OutData%c_obj%H = C_LOC( OutData%H(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%H)>0) OutData%H = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%H))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%H) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%H,1), UBOUND(OutData%H,1) + OutData%H(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! V not allocated Int_Xferred = Int_Xferred + 1 @@ -3008,15 +3278,10 @@ SUBROUTINE MAP_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, OutData%c_obj%V_Len = SIZE(OutData%V) IF (OutData%c_obj%V_Len > 0) & OutData%c_obj%V = C_LOC( OutData%V(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%V)>0) OutData%V = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%V))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%V) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%V,1), UBOUND(OutData%V,1) + OutData%V(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x not allocated Int_Xferred = Int_Xferred + 1 @@ -3034,15 +3299,10 @@ SUBROUTINE MAP_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, OutData%c_obj%x_Len = SIZE(OutData%x) IF (OutData%c_obj%x_Len > 0) & OutData%c_obj%x = C_LOC( OutData%x(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%x)>0) OutData%x = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%x))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%x) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) + OutData%x(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y not allocated Int_Xferred = Int_Xferred + 1 @@ -3060,15 +3320,10 @@ SUBROUTINE MAP_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, OutData%c_obj%y_Len = SIZE(OutData%y) IF (OutData%c_obj%y_Len > 0) & OutData%c_obj%y = C_LOC( OutData%y(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%y)>0) OutData%y = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%y))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%y) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%y,1), UBOUND(OutData%y,1) + OutData%y(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z not allocated Int_Xferred = Int_Xferred + 1 @@ -3086,62 +3341,152 @@ SUBROUTINE MAP_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, OutData%c_obj%z_Len = SIZE(OutData%z) IF (OutData%c_obj%z_Len > 0) & OutData%c_obj%z = C_LOC( OutData%z(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%z)>0) OutData%z = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%z))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%z) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) + OutData%z(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF END SUBROUTINE MAP_UnPackConstrState - SUBROUTINE MAP_C2Fary_CopyConstrState( ConstrStateData, ErrStat, ErrMsg ) + SUBROUTINE MAP_C2Fary_CopyConstrState( ConstrStateData, ErrStat, ErrMsg, SkipPointers ) TYPE(MAP_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" - ! -- H ConstrState Data fields - IF ( .NOT. C_ASSOCIATED( ConstrStateData%C_obj%H ) ) THEN - NULLIFY( ConstrStateData%H ) + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers ELSE - CALL C_F_POINTER(ConstrStateData%C_obj%H, ConstrStateData%H, (/ConstrStateData%C_obj%H_Len/)) + SkipPointers_local = .false. + END IF + + ! -- H ConstrState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ConstrStateData%C_obj%H ) ) THEN + NULLIFY( ConstrStateData%H ) + ELSE + CALL C_F_POINTER(ConstrStateData%C_obj%H, ConstrStateData%H, (/ConstrStateData%C_obj%H_Len/)) + END IF END IF ! -- V ConstrState Data fields - IF ( .NOT. C_ASSOCIATED( ConstrStateData%C_obj%V ) ) THEN - NULLIFY( ConstrStateData%V ) - ELSE - CALL C_F_POINTER(ConstrStateData%C_obj%V, ConstrStateData%V, (/ConstrStateData%C_obj%V_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ConstrStateData%C_obj%V ) ) THEN + NULLIFY( ConstrStateData%V ) + ELSE + CALL C_F_POINTER(ConstrStateData%C_obj%V, ConstrStateData%V, (/ConstrStateData%C_obj%V_Len/)) + END IF END IF ! -- x ConstrState Data fields - IF ( .NOT. C_ASSOCIATED( ConstrStateData%C_obj%x ) ) THEN - NULLIFY( ConstrStateData%x ) - ELSE - CALL C_F_POINTER(ConstrStateData%C_obj%x, ConstrStateData%x, (/ConstrStateData%C_obj%x_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ConstrStateData%C_obj%x ) ) THEN + NULLIFY( ConstrStateData%x ) + ELSE + CALL C_F_POINTER(ConstrStateData%C_obj%x, ConstrStateData%x, (/ConstrStateData%C_obj%x_Len/)) + END IF END IF ! -- y ConstrState Data fields - IF ( .NOT. C_ASSOCIATED( ConstrStateData%C_obj%y ) ) THEN - NULLIFY( ConstrStateData%y ) - ELSE - CALL C_F_POINTER(ConstrStateData%C_obj%y, ConstrStateData%y, (/ConstrStateData%C_obj%y_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ConstrStateData%C_obj%y ) ) THEN + NULLIFY( ConstrStateData%y ) + ELSE + CALL C_F_POINTER(ConstrStateData%C_obj%y, ConstrStateData%y, (/ConstrStateData%C_obj%y_Len/)) + END IF END IF ! -- z ConstrState Data fields - IF ( .NOT. C_ASSOCIATED( ConstrStateData%C_obj%z ) ) THEN - NULLIFY( ConstrStateData%z ) - ELSE - CALL C_F_POINTER(ConstrStateData%C_obj%z, ConstrStateData%z, (/ConstrStateData%C_obj%z_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ConstrStateData%C_obj%z ) ) THEN + NULLIFY( ConstrStateData%z ) + ELSE + CALL C_F_POINTER(ConstrStateData%C_obj%z, ConstrStateData%z, (/ConstrStateData%C_obj%z_Len/)) + END IF END IF END SUBROUTINE MAP_C2Fary_CopyConstrState + SUBROUTINE MAP_F2C_CopyConstrState( ConstrStateData, ErrStat, ErrMsg, SkipPointers ) + TYPE(MAP_ConstraintStateType), INTENT(INOUT) :: ConstrStateData + 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 + + ! -- H ConstrState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(ConstrStateData%H)) THEN + ConstrStateData%c_obj%H_Len = 0 + ConstrStateData%c_obj%H = C_NULL_PTR + 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) ) ) + END IF + END IF + + ! -- V ConstrState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(ConstrStateData%V)) THEN + ConstrStateData%c_obj%V_Len = 0 + ConstrStateData%c_obj%V = C_NULL_PTR + 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) ) ) + END IF + END IF + + ! -- x ConstrState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(ConstrStateData%x)) THEN + ConstrStateData%c_obj%x_Len = 0 + ConstrStateData%c_obj%x = C_NULL_PTR + 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) ) ) + END IF + END IF + + ! -- y ConstrState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(ConstrStateData%y)) THEN + ConstrStateData%c_obj%y_Len = 0 + ConstrStateData%c_obj%y = C_NULL_PTR + 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) ) ) + END IF + END IF + + ! -- z ConstrState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(ConstrStateData%z)) THEN + ConstrStateData%c_obj%z_Len = 0 + ConstrStateData%c_obj%z = C_NULL_PTR + 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) ) ) + END IF + END IF + END SUBROUTINE MAP_F2C_CopyConstrState + SUBROUTINE MAP_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) TYPE(MAP_ParameterType), INTENT(IN) :: SrcParamData TYPE(MAP_ParameterType), INTENT(INOUT) :: DstParamData @@ -3275,28 +3620,28 @@ SUBROUTINE MAP_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%g - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%depth - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%rho_sea - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%dt - Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%g + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%depth + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%rho_sea + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%dt + Db_Xferred = Db_Xferred + 1 DO i1 = LBOUND(InData%InputLines,1), UBOUND(InData%InputLines,1) - DO I = 1, LEN(InData%InputLines) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputLines(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 + DO I = 1, LEN(InData%InputLines) + IntKiBuf(Int_Xferred) = ICHAR(InData%InputLines(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO DO i1 = LBOUND(InData%InputLineType,1), UBOUND(InData%InputLineType,1) - DO I = 1, LEN(InData%InputLineType) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputLineType(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%numOuts - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%InputLineType) + IntKiBuf(Int_Xferred) = ICHAR(InData%InputLineType(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + IntKiBuf(Int_Xferred) = InData%numOuts + Int_Xferred = Int_Xferred + 1 CALL MAP_Fortran_Packlin_paramtype( Re_Buf, Db_Buf, Int_Buf, InData%LinParams, ErrStat2, ErrMsg2, OnlySize ) ! LinParams CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3340,12 +3685,6 @@ SUBROUTINE MAP_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -3360,50 +3699,36 @@ SUBROUTINE MAP_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%g = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%g = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 OutData%C_obj%g = OutData%g - OutData%depth = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%depth = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 OutData%C_obj%depth = OutData%depth - OutData%rho_sea = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%rho_sea = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 OutData%C_obj%rho_sea = OutData%rho_sea - OutData%dt = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%dt = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 OutData%C_obj%dt = OutData%dt i1_l = LBOUND(OutData%InputLines,1) i1_u = UBOUND(OutData%InputLines,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. DO i1 = LBOUND(OutData%InputLines,1), UBOUND(OutData%InputLines,1) - DO I = 1, LEN(OutData%InputLines) - OutData%InputLines(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - DEALLOCATE(mask1) + DO I = 1, LEN(OutData%InputLines) + OutData%InputLines(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO i1_l = LBOUND(OutData%InputLineType,1) i1_u = UBOUND(OutData%InputLineType,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. DO i1 = LBOUND(OutData%InputLineType,1), UBOUND(OutData%InputLineType,1) - DO I = 1, LEN(OutData%InputLineType) - OutData%InputLineType(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - DEALLOCATE(mask1) - OutData%numOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%InputLineType) + OutData%InputLineType(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + OutData%numOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 OutData%C_obj%numOuts = OutData%numOuts Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -3447,13 +3772,21 @@ SUBROUTINE MAP_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END SUBROUTINE MAP_UnPackParam - SUBROUTINE MAP_C2Fary_CopyParam( ParamData, ErrStat, ErrMsg ) + SUBROUTINE MAP_C2Fary_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) TYPE(MAP_ParameterType), INTENT(INOUT) :: ParamData 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 ParamData%g = ParamData%C_obj%g ParamData%depth = ParamData%C_obj%depth ParamData%rho_sea = ParamData%C_obj%rho_sea @@ -3461,6 +3794,28 @@ SUBROUTINE MAP_C2Fary_CopyParam( ParamData, ErrStat, ErrMsg ) ParamData%numOuts = ParamData%C_obj%numOuts END SUBROUTINE MAP_C2Fary_CopyParam + SUBROUTINE MAP_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) + TYPE(MAP_ParameterType), INTENT(INOUT) :: ParamData + 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 + ParamData%C_obj%g = ParamData%g + ParamData%C_obj%depth = ParamData%depth + ParamData%C_obj%rho_sea = ParamData%rho_sea + ParamData%C_obj%dt = ParamData%dt + ParamData%C_obj%numOuts = ParamData%numOuts + END SUBROUTINE MAP_F2C_CopyParam + SUBROUTINE MAP_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) TYPE(MAP_InputType), INTENT(INOUT) :: SrcInputData TYPE(MAP_InputType), INTENT(INOUT) :: DstInputData @@ -3663,8 +4018,10 @@ SUBROUTINE MAP_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%x)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%x))-1 ) = PACK(InData%x,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%x) + DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) + DbKiBuf(Db_Xferred) = InData%x(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%y) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3676,8 +4033,10 @@ SUBROUTINE MAP_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%y)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%y))-1 ) = PACK(InData%y,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%y) + DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) + DbKiBuf(Db_Xferred) = InData%y(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%z) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3689,8 +4048,10 @@ SUBROUTINE MAP_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%z)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%z))-1 ) = PACK(InData%z,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%z) + DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) + DbKiBuf(Db_Xferred) = InData%z(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF CALL MeshPack( InData%PtFairDisplacement, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! PtFairDisplacement CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3735,12 +4096,6 @@ SUBROUTINE MAP_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -3771,15 +4126,10 @@ SUBROUTINE MAP_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg OutData%c_obj%x_Len = SIZE(OutData%x) IF (OutData%c_obj%x_Len > 0) & OutData%c_obj%x = C_LOC( OutData%x(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%x)>0) OutData%x = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%x))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%x) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) + OutData%x(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y not allocated Int_Xferred = Int_Xferred + 1 @@ -3797,15 +4147,10 @@ SUBROUTINE MAP_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg OutData%c_obj%y_Len = SIZE(OutData%y) IF (OutData%c_obj%y_Len > 0) & OutData%c_obj%y = C_LOC( OutData%y(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%y)>0) OutData%y = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%y))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%y) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%y,1), UBOUND(OutData%y,1) + OutData%y(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z not allocated Int_Xferred = Int_Xferred + 1 @@ -3823,15 +4168,10 @@ SUBROUTINE MAP_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg OutData%c_obj%z_Len = SIZE(OutData%z) IF (OutData%c_obj%z_Len > 0) & OutData%c_obj%z = C_LOC( OutData%z(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%z)>0) OutData%z = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%z))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%z) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) + OutData%z(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -3875,36 +4215,103 @@ SUBROUTINE MAP_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END SUBROUTINE MAP_UnPackInput - SUBROUTINE MAP_C2Fary_CopyInput( InputData, ErrStat, ErrMsg ) + SUBROUTINE MAP_C2Fary_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) TYPE(MAP_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" - ! -- x Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%x ) ) THEN - NULLIFY( InputData%x ) + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers ELSE - CALL C_F_POINTER(InputData%C_obj%x, InputData%x, (/InputData%C_obj%x_Len/)) + SkipPointers_local = .false. + END IF + + ! -- x Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%x ) ) THEN + NULLIFY( InputData%x ) + ELSE + CALL C_F_POINTER(InputData%C_obj%x, InputData%x, (/InputData%C_obj%x_Len/)) + END IF END IF ! -- y Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%y ) ) THEN - NULLIFY( InputData%y ) - ELSE - CALL C_F_POINTER(InputData%C_obj%y, InputData%y, (/InputData%C_obj%y_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%y ) ) THEN + NULLIFY( InputData%y ) + ELSE + CALL C_F_POINTER(InputData%C_obj%y, InputData%y, (/InputData%C_obj%y_Len/)) + END IF END IF ! -- z Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%z ) ) THEN - NULLIFY( InputData%z ) - ELSE - CALL C_F_POINTER(InputData%C_obj%z, InputData%z, (/InputData%C_obj%z_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%z ) ) THEN + NULLIFY( InputData%z ) + ELSE + CALL C_F_POINTER(InputData%C_obj%z, InputData%z, (/InputData%C_obj%z_Len/)) + END IF END IF END SUBROUTINE MAP_C2Fary_CopyInput + SUBROUTINE MAP_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(MAP_InputType), INTENT(INOUT) :: InputData + 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 + + ! -- x Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%x)) THEN + InputData%c_obj%x_Len = 0 + InputData%c_obj%x = C_NULL_PTR + 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) ) ) + END IF + END IF + + ! -- y Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%y)) THEN + InputData%c_obj%y_Len = 0 + InputData%c_obj%y = C_NULL_PTR + 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) ) ) + END IF + END IF + + ! -- z Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%z)) THEN + InputData%c_obj%z_Len = 0 + InputData%c_obj%z = C_NULL_PTR + 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) ) ) + END IF + END IF + END SUBROUTINE MAP_F2C_CopyInput + SUBROUTINE MAP_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(MAP_OutputType), INTENT(INOUT) :: SrcOutputData TYPE(MAP_OutputType), INTENT(INOUT) :: DstOutputData @@ -3976,7 +4383,6 @@ SUBROUTINE MAP_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM END IF END IF DstOutputData%WriteOutput = SrcOutputData%WriteOutput - DstOutputData%C_obj%WriteOutput = SrcOutputData%C_obj%WriteOutput ENDIF IF (ASSOCIATED(SrcOutputData%wrtOutput)) THEN i1_l = LBOUND(SrcOutputData%wrtOutput,1) @@ -4154,8 +4560,10 @@ SUBROUTINE MAP_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fx,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Fx)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Fx))-1 ) = PACK(InData%Fx,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Fx) + DO i1 = LBOUND(InData%Fx,1), UBOUND(InData%Fx,1) + DbKiBuf(Db_Xferred) = InData%Fx(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%Fy) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4167,8 +4575,10 @@ SUBROUTINE MAP_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fy,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Fy)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Fy))-1 ) = PACK(InData%Fy,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Fy) + DO i1 = LBOUND(InData%Fy,1), UBOUND(InData%Fy,1) + DbKiBuf(Db_Xferred) = InData%Fy(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%Fz) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4180,8 +4590,10 @@ SUBROUTINE MAP_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fz,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Fz)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Fz))-1 ) = PACK(InData%Fz,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Fz) + DO i1 = LBOUND(InData%Fz,1), UBOUND(InData%Fz,1) + DbKiBuf(Db_Xferred) = InData%Fz(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutput) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4193,8 +4605,10 @@ SUBROUTINE MAP_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WriteOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%wrtOutput) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4206,8 +4620,10 @@ SUBROUTINE MAP_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%wrtOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%wrtOutput)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%wrtOutput))-1 ) = PACK(InData%wrtOutput,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%wrtOutput) + DO i1 = LBOUND(InData%wrtOutput,1), UBOUND(InData%wrtOutput,1) + DbKiBuf(Db_Xferred) = InData%wrtOutput(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF CALL MeshPack( InData%ptFairleadLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! ptFairleadLoad CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4252,12 +4668,6 @@ SUBROUTINE MAP_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -4288,15 +4698,10 @@ SUBROUTINE MAP_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs OutData%c_obj%Fx_Len = SIZE(OutData%Fx) IF (OutData%c_obj%Fx_Len > 0) & OutData%c_obj%Fx = C_LOC( OutData%Fx(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Fx)>0) OutData%Fx = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Fx))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%Fx) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Fx,1), UBOUND(OutData%Fx,1) + OutData%Fx(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fy not allocated Int_Xferred = Int_Xferred + 1 @@ -4314,15 +4719,10 @@ SUBROUTINE MAP_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs OutData%c_obj%Fy_Len = SIZE(OutData%Fy) IF (OutData%c_obj%Fy_Len > 0) & OutData%c_obj%Fy = C_LOC( OutData%Fy(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Fy)>0) OutData%Fy = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Fy))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%Fy) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Fy,1), UBOUND(OutData%Fy,1) + OutData%Fy(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fz not allocated Int_Xferred = Int_Xferred + 1 @@ -4340,15 +4740,10 @@ SUBROUTINE MAP_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs OutData%c_obj%Fz_Len = SIZE(OutData%Fz) IF (OutData%c_obj%Fz_Len > 0) & OutData%c_obj%Fz = C_LOC( OutData%Fz(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Fz)>0) OutData%Fz = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Fz))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%Fz) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Fz,1), UBOUND(OutData%Fz,1) + OutData%Fz(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutput not allocated Int_Xferred = Int_Xferred + 1 @@ -4363,15 +4758,10 @@ SUBROUTINE MAP_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WriteOutput)>0) OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! wrtOutput not allocated Int_Xferred = Int_Xferred + 1 @@ -4389,15 +4779,10 @@ SUBROUTINE MAP_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs OutData%c_obj%wrtOutput_Len = SIZE(OutData%wrtOutput) IF (OutData%c_obj%wrtOutput_Len > 0) & OutData%c_obj%wrtOutput = C_LOC( OutData%wrtOutput(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%wrtOutput)>0) OutData%wrtOutput = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%wrtOutput))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%wrtOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%wrtOutput,1), UBOUND(OutData%wrtOutput,1) + OutData%wrtOutput(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -4441,43 +4826,124 @@ SUBROUTINE MAP_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END SUBROUTINE MAP_UnPackOutput - SUBROUTINE MAP_C2Fary_CopyOutput( OutputData, ErrStat, ErrMsg ) + SUBROUTINE MAP_C2Fary_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) TYPE(MAP_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" - ! -- Fx Output Data fields - IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%Fx ) ) THEN - NULLIFY( OutputData%Fx ) + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers ELSE - CALL C_F_POINTER(OutputData%C_obj%Fx, OutputData%Fx, (/OutputData%C_obj%Fx_Len/)) + SkipPointers_local = .false. + END IF + + ! -- Fx Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%Fx ) ) THEN + NULLIFY( OutputData%Fx ) + ELSE + CALL C_F_POINTER(OutputData%C_obj%Fx, OutputData%Fx, (/OutputData%C_obj%Fx_Len/)) + END IF END IF ! -- Fy Output Data fields - IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%Fy ) ) THEN - NULLIFY( OutputData%Fy ) - ELSE - CALL C_F_POINTER(OutputData%C_obj%Fy, OutputData%Fy, (/OutputData%C_obj%Fy_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%Fy ) ) THEN + NULLIFY( OutputData%Fy ) + ELSE + CALL C_F_POINTER(OutputData%C_obj%Fy, OutputData%Fy, (/OutputData%C_obj%Fy_Len/)) + END IF END IF ! -- Fz Output Data fields - IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%Fz ) ) THEN - NULLIFY( OutputData%Fz ) - ELSE - CALL C_F_POINTER(OutputData%C_obj%Fz, OutputData%Fz, (/OutputData%C_obj%Fz_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%Fz ) ) THEN + NULLIFY( OutputData%Fz ) + ELSE + CALL C_F_POINTER(OutputData%C_obj%Fz, OutputData%Fz, (/OutputData%C_obj%Fz_Len/)) + END IF END IF ! -- wrtOutput Output Data fields - IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%wrtOutput ) ) THEN - NULLIFY( OutputData%wrtOutput ) - ELSE - CALL C_F_POINTER(OutputData%C_obj%wrtOutput, OutputData%wrtOutput, (/OutputData%C_obj%wrtOutput_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%wrtOutput ) ) THEN + NULLIFY( OutputData%wrtOutput ) + ELSE + CALL C_F_POINTER(OutputData%C_obj%wrtOutput, OutputData%wrtOutput, (/OutputData%C_obj%wrtOutput_Len/)) + END IF END IF END SUBROUTINE MAP_C2Fary_CopyOutput + SUBROUTINE MAP_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(MAP_OutputType), INTENT(INOUT) :: OutputData + 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 + + ! -- Fx Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OutputData%Fx)) THEN + OutputData%c_obj%Fx_Len = 0 + OutputData%c_obj%Fx = C_NULL_PTR + 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) ) ) + END IF + END IF + + ! -- Fy Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OutputData%Fy)) THEN + OutputData%c_obj%Fy_Len = 0 + OutputData%c_obj%Fy = C_NULL_PTR + 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) ) ) + END IF + END IF + + ! -- Fz Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OutputData%Fz)) THEN + OutputData%c_obj%Fz_Len = 0 + OutputData%c_obj%Fz = C_NULL_PTR + 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) ) ) + END IF + END IF + + ! -- wrtOutput Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OutputData%wrtOutput)) THEN + OutputData%c_obj%wrtOutput_Len = 0 + OutputData%c_obj%wrtOutput = C_NULL_PTR + 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) ) ) + END IF + END IF + END SUBROUTINE MAP_F2C_CopyOutput + SUBROUTINE MAP_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) ! @@ -4553,12 +5019,12 @@ SUBROUTINE MAP_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! 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 :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -4571,29 +5037,25 @@ SUBROUTINE MAP_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ASSOCIATED(u_out%x) .AND. ASSOCIATED(u1%x)) THEN - ALLOCATE(b1(SIZE(u_out%x,1))) - ALLOCATE(c1(SIZE(u_out%x,1))) - b1 = -(u1%x - u2%x)/t(2) - u_out%x = u1%x + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%x,1),UBOUND(u_out%x,1) + b = -(u1%x(i1) - u2%x(i1)) + u_out%x(i1) = u1%x(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%y) .AND. ASSOCIATED(u1%y)) THEN - ALLOCATE(b1(SIZE(u_out%y,1))) - ALLOCATE(c1(SIZE(u_out%y,1))) - b1 = -(u1%y - u2%y)/t(2) - u_out%y = u1%y + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%y,1),UBOUND(u_out%y,1) + b = -(u1%y(i1) - u2%y(i1)) + u_out%y(i1) = u1%y(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%z) .AND. ASSOCIATED(u1%z)) THEN - ALLOCATE(b1(SIZE(u_out%z,1))) - ALLOCATE(c1(SIZE(u_out%z,1))) - b1 = -(u1%z - u2%z)/t(2) - u_out%z = u1%z + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%z,1),UBOUND(u_out%z,1) + b = -(u1%z(i1) - u2%z(i1)) + u_out%z(i1) = u1%z(i1) + b * ScaleFactor + END DO END IF ! check if allocated CALL MeshExtrapInterp1(u1%PtFairDisplacement, u2%PtFairDisplacement, tin, u_out%PtFairDisplacement, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) @@ -4626,13 +5088,14 @@ SUBROUTINE MAP_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Err REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -4651,32 +5114,28 @@ SUBROUTINE MAP_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ASSOCIATED(u_out%x) .AND. ASSOCIATED(u1%x)) THEN - ALLOCATE(b1(SIZE(u_out%x,1))) - ALLOCATE(c1(SIZE(u_out%x,1))) - b1 = (t(3)**2*(u1%x - u2%x) + t(2)**2*(-u1%x + u3%x))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%x + t(3)*u2%x - t(2)*u3%x ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%x = u1%x + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%x,1),UBOUND(u_out%x,1) + b = (t(3)**2*(u1%x(i1) - u2%x(i1)) + t(2)**2*(-u1%x(i1) + u3%x(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%x(i1) + t(3)*u2%x(i1) - t(2)*u3%x(i1) ) * scaleFactor + u_out%x(i1) = u1%x(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%y) .AND. ASSOCIATED(u1%y)) THEN - ALLOCATE(b1(SIZE(u_out%y,1))) - ALLOCATE(c1(SIZE(u_out%y,1))) - b1 = (t(3)**2*(u1%y - u2%y) + t(2)**2*(-u1%y + u3%y))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%y + t(3)*u2%y - t(2)*u3%y ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%y = u1%y + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%y,1),UBOUND(u_out%y,1) + b = (t(3)**2*(u1%y(i1) - u2%y(i1)) + t(2)**2*(-u1%y(i1) + u3%y(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%y(i1) + t(3)*u2%y(i1) - t(2)*u3%y(i1) ) * scaleFactor + u_out%y(i1) = u1%y(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%z) .AND. ASSOCIATED(u1%z)) THEN - ALLOCATE(b1(SIZE(u_out%z,1))) - ALLOCATE(c1(SIZE(u_out%z,1))) - b1 = (t(3)**2*(u1%z - u2%z) + t(2)**2*(-u1%z + u3%z))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%z + t(3)*u2%z - t(2)*u3%z ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%z = u1%z + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%z,1),UBOUND(u_out%z,1) + b = (t(3)**2*(u1%z(i1) - u2%z(i1)) + t(2)**2*(-u1%z(i1) + u3%z(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%z(i1) + t(3)*u2%z(i1) - t(2)*u3%z(i1) ) * scaleFactor + u_out%z(i1) = u1%z(i1) + b + c * t_out + END DO END IF ! check if allocated CALL MeshExtrapInterp2(u1%PtFairDisplacement, u2%PtFairDisplacement, u3%PtFairDisplacement, tin, u_out%PtFairDisplacement, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) @@ -4757,12 +5216,12 @@ SUBROUTINE MAP_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! 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 :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -4775,45 +5234,37 @@ SUBROUTINE MAP_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ASSOCIATED(y_out%Fx) .AND. ASSOCIATED(y1%Fx)) THEN - ALLOCATE(b1(SIZE(y_out%Fx,1))) - ALLOCATE(c1(SIZE(y_out%Fx,1))) - b1 = -(y1%Fx - y2%Fx)/t(2) - y_out%Fx = y1%Fx + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%Fx,1),UBOUND(y_out%Fx,1) + b = -(y1%Fx(i1) - y2%Fx(i1)) + y_out%Fx(i1) = y1%Fx(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(y_out%Fy) .AND. ASSOCIATED(y1%Fy)) THEN - ALLOCATE(b1(SIZE(y_out%Fy,1))) - ALLOCATE(c1(SIZE(y_out%Fy,1))) - b1 = -(y1%Fy - y2%Fy)/t(2) - y_out%Fy = y1%Fy + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%Fy,1),UBOUND(y_out%Fy,1) + b = -(y1%Fy(i1) - y2%Fy(i1)) + y_out%Fy(i1) = y1%Fy(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(y_out%Fz) .AND. ASSOCIATED(y1%Fz)) THEN - ALLOCATE(b1(SIZE(y_out%Fz,1))) - ALLOCATE(c1(SIZE(y_out%Fz,1))) - b1 = -(y1%Fz - y2%Fz)/t(2) - y_out%Fz = y1%Fz + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%Fz,1),UBOUND(y_out%Fz,1) + b = -(y1%Fz(i1) - y2%Fz(i1)) + y_out%Fz(i1) = y1%Fz(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(y_out%wrtOutput) .AND. ASSOCIATED(y1%wrtOutput)) THEN - ALLOCATE(b1(SIZE(y_out%wrtOutput,1))) - ALLOCATE(c1(SIZE(y_out%wrtOutput,1))) - b1 = -(y1%wrtOutput - y2%wrtOutput)/t(2) - y_out%wrtOutput = y1%wrtOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%wrtOutput,1),UBOUND(y_out%wrtOutput,1) + b = -(y1%wrtOutput(i1) - y2%wrtOutput(i1)) + y_out%wrtOutput(i1) = y1%wrtOutput(i1) + b * ScaleFactor + END DO END IF ! check if allocated CALL MeshExtrapInterp1(y1%ptFairleadLoad, y2%ptFairleadLoad, tin, y_out%ptFairleadLoad, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) @@ -4846,13 +5297,14 @@ SUBROUTINE MAP_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -4871,50 +5323,42 @@ SUBROUTINE MAP_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ASSOCIATED(y_out%Fx) .AND. ASSOCIATED(y1%Fx)) THEN - ALLOCATE(b1(SIZE(y_out%Fx,1))) - ALLOCATE(c1(SIZE(y_out%Fx,1))) - b1 = (t(3)**2*(y1%Fx - y2%Fx) + t(2)**2*(-y1%Fx + y3%Fx))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%Fx + t(3)*y2%Fx - t(2)*y3%Fx ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Fx = y1%Fx + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%Fx,1),UBOUND(y_out%Fx,1) + b = (t(3)**2*(y1%Fx(i1) - y2%Fx(i1)) + t(2)**2*(-y1%Fx(i1) + y3%Fx(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%Fx(i1) + t(3)*y2%Fx(i1) - t(2)*y3%Fx(i1) ) * scaleFactor + y_out%Fx(i1) = y1%Fx(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(y_out%Fy) .AND. ASSOCIATED(y1%Fy)) THEN - ALLOCATE(b1(SIZE(y_out%Fy,1))) - ALLOCATE(c1(SIZE(y_out%Fy,1))) - b1 = (t(3)**2*(y1%Fy - y2%Fy) + t(2)**2*(-y1%Fy + y3%Fy))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%Fy + t(3)*y2%Fy - t(2)*y3%Fy ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Fy = y1%Fy + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%Fy,1),UBOUND(y_out%Fy,1) + b = (t(3)**2*(y1%Fy(i1) - y2%Fy(i1)) + t(2)**2*(-y1%Fy(i1) + y3%Fy(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%Fy(i1) + t(3)*y2%Fy(i1) - t(2)*y3%Fy(i1) ) * scaleFactor + y_out%Fy(i1) = y1%Fy(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(y_out%Fz) .AND. ASSOCIATED(y1%Fz)) THEN - ALLOCATE(b1(SIZE(y_out%Fz,1))) - ALLOCATE(c1(SIZE(y_out%Fz,1))) - b1 = (t(3)**2*(y1%Fz - y2%Fz) + t(2)**2*(-y1%Fz + y3%Fz))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%Fz + t(3)*y2%Fz - t(2)*y3%Fz ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Fz = y1%Fz + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%Fz,1),UBOUND(y_out%Fz,1) + b = (t(3)**2*(y1%Fz(i1) - y2%Fz(i1)) + t(2)**2*(-y1%Fz(i1) + y3%Fz(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%Fz(i1) + t(3)*y2%Fz(i1) - t(2)*y3%Fz(i1) ) * scaleFactor + y_out%Fz(i1) = y1%Fz(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(y_out%wrtOutput) .AND. ASSOCIATED(y1%wrtOutput)) THEN - ALLOCATE(b1(SIZE(y_out%wrtOutput,1))) - ALLOCATE(c1(SIZE(y_out%wrtOutput,1))) - b1 = (t(3)**2*(y1%wrtOutput - y2%wrtOutput) + t(2)**2*(-y1%wrtOutput + y3%wrtOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%wrtOutput + t(3)*y2%wrtOutput - t(2)*y3%wrtOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%wrtOutput = y1%wrtOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%wrtOutput,1),UBOUND(y_out%wrtOutput,1) + b = (t(3)**2*(y1%wrtOutput(i1) - y2%wrtOutput(i1)) + t(2)**2*(-y1%wrtOutput(i1) + y3%wrtOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%wrtOutput(i1) + t(3)*y2%wrtOutput(i1) - t(2)*y3%wrtOutput(i1) ) * scaleFactor + y_out%wrtOutput(i1) = y1%wrtOutput(i1) + b + c * t_out + END DO END IF ! check if allocated CALL MeshExtrapInterp2(y1%ptFairleadLoad, y2%ptFairleadLoad, y3%ptFairleadLoad, tin, y_out%ptFairleadLoad, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) diff --git a/modules/moordyn/src/MoorDyn_Types.f90 b/modules/moordyn/src/MoorDyn_Types.f90 index aa295f80ec..9f16aba61b 100644 --- a/modules/moordyn/src/MoorDyn_Types.f90 +++ b/modules/moordyn/src/MoorDyn_Types.f90 @@ -336,32 +336,34 @@ SUBROUTINE MD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%g - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rhoW - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WtrDepth - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PtfmInit))-1 ) = PACK(InData%PtfmInit,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PtfmInit) - DO I = 1, LEN(InData%FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Echo , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DTIC - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMaxIC - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CdScaleIC - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%threshIC - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%g + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rhoW + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDepth + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%PtfmInit,1), UBOUND(InData%PtfmInit,1) + ReKiBuf(Re_Xferred) = InData%PtfmInit(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO I = 1, LEN(InData%FileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%FileName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%Echo, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DTIC + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMaxIC + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CdScaleIC + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%threshIC + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%OutList) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -372,12 +374,12 @@ SUBROUTINE MD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutList,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) + DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) DO I = 1, LEN(InData%OutList) IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF END SUBROUTINE MD_PackInitInput @@ -394,12 +396,6 @@ SUBROUTINE MD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -416,41 +412,36 @@ SUBROUTINE MD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%g = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rhoW = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDepth = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%g = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rhoW = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WtrDepth = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%PtfmInit,1) i1_u = UBOUND(OutData%PtfmInit,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%PtfmInit = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PtfmInit))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PtfmInit) - DEALLOCATE(mask1) - DO I = 1, LEN(OutData%FileName) - OutData%FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%Echo = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%DTIC = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMaxIC = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%CdScaleIC = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%threshIC = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%PtfmInit,1), UBOUND(OutData%PtfmInit,1) + OutData%PtfmInit(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + DO I = 1, LEN(OutData%FileName) + OutData%FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%Echo = TRANSFER(IntKiBuf(Int_Xferred), OutData%Echo) + Int_Xferred = Int_Xferred + 1 + OutData%DTIC = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMaxIC = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%CdScaleIC = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%threshIC = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutList not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -464,19 +455,12 @@ SUBROUTINE MD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) + DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) DO I = 1, LEN(OutData%OutList) OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF END SUBROUTINE MD_UnPackInitInput @@ -589,28 +573,28 @@ SUBROUTINE MD_PackLineProp( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%IdNum - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%name) - IntKiBuf(Int_Xferred) = ICHAR(InData%name(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%d - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%w - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%EA - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%BA - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Can - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cat - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cdn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cdt - Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%IdNum + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%name) + IntKiBuf(Int_Xferred) = ICHAR(InData%name(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + ReKiBuf(Re_Xferred) = InData%d + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%w + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%EA + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%BA + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Can + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cat + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cdn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cdt + Re_Xferred = Re_Xferred + 1 END SUBROUTINE MD_PackLineProp SUBROUTINE MD_UnPackLineProp( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -626,12 +610,6 @@ SUBROUTINE MD_UnPackLineProp( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackLineProp' @@ -645,28 +623,28 @@ SUBROUTINE MD_UnPackLineProp( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%IdNum = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%name) - OutData%name(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%d = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%w = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%EA = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%BA = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Can = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cat = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cdn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cdt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%IdNum = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%name) + OutData%name(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%d = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%w = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%EA = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%BA = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Can = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cat = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cdn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cdt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE MD_UnPackLineProp SUBROUTINE MD_CopyConnect( SrcConnectData, DstConnectData, CtrlCode, ErrStat, ErrMsg ) @@ -836,14 +814,14 @@ SUBROUTINE MD_PackConnect( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%IdNum - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%type) - IntKiBuf(Int_Xferred) = ICHAR(InData%type(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TypeNum - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%IdNum + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%type) + IntKiBuf(Int_Xferred) = ICHAR(InData%type(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%TypeNum + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%AttachedFairs) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -854,8 +832,10 @@ SUBROUTINE MD_PackConnect( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AttachedFairs,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AttachedFairs)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%AttachedFairs))-1 ) = PACK(InData%AttachedFairs,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%AttachedFairs) + DO i1 = LBOUND(InData%AttachedFairs,1), UBOUND(InData%AttachedFairs,1) + IntKiBuf(Int_Xferred) = InData%AttachedFairs(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%AttachedAnchs) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -867,39 +847,55 @@ SUBROUTINE MD_PackConnect( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AttachedAnchs,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AttachedAnchs)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%AttachedAnchs))-1 ) = PACK(InData%AttachedAnchs,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%AttachedAnchs) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%conX - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%conY - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%conZ - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%conM - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%conV - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%conFX - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%conFY - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%conFZ - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%conCa - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%conCdA - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Ftot))-1 ) = PACK(InData%Ftot,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Ftot) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Mtot))-1 ) = PACK(InData%Mtot,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Mtot) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%S))-1 ) = PACK(InData%S,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%S) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%r))-1 ) = PACK(InData%r,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%r) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%rd))-1 ) = PACK(InData%rd,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%rd) + DO i1 = LBOUND(InData%AttachedAnchs,1), UBOUND(InData%AttachedAnchs,1) + IntKiBuf(Int_Xferred) = InData%AttachedAnchs(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%conX + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%conY + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%conZ + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%conM + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%conV + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%conFX + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%conFY + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%conFZ + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%conCa + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%conCdA + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%Ftot,1), UBOUND(InData%Ftot,1) + ReKiBuf(Re_Xferred) = InData%Ftot(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i2 = LBOUND(InData%Mtot,2), UBOUND(InData%Mtot,2) + DO i1 = LBOUND(InData%Mtot,1), UBOUND(InData%Mtot,1) + ReKiBuf(Re_Xferred) = InData%Mtot(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%S,2), UBOUND(InData%S,2) + DO i1 = LBOUND(InData%S,1), UBOUND(InData%S,1) + ReKiBuf(Re_Xferred) = InData%S(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i1 = LBOUND(InData%r,1), UBOUND(InData%r,1) + ReKiBuf(Re_Xferred) = InData%r(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rd,1), UBOUND(InData%rd,1) + ReKiBuf(Re_Xferred) = InData%rd(i1) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE MD_PackConnect SUBROUTINE MD_UnPackConnect( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -915,12 +911,6 @@ SUBROUTINE MD_UnPackConnect( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -936,14 +926,14 @@ SUBROUTINE MD_UnPackConnect( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%IdNum = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%type) - OutData%type(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%TypeNum = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%IdNum = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%type) + OutData%type(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%TypeNum = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AttachedFairs not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -957,15 +947,10 @@ SUBROUTINE MD_UnPackConnect( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AttachedFairs.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%AttachedFairs)>0) OutData%AttachedFairs = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%AttachedFairs))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%AttachedFairs) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AttachedFairs,1), UBOUND(OutData%AttachedFairs,1) + OutData%AttachedFairs(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AttachedAnchs not allocated Int_Xferred = Int_Xferred + 1 @@ -980,95 +965,69 @@ SUBROUTINE MD_UnPackConnect( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AttachedAnchs.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%AttachedAnchs)>0) OutData%AttachedAnchs = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%AttachedAnchs))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%AttachedAnchs) - DEALLOCATE(mask1) - END IF - OutData%conX = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%conY = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%conZ = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%conM = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%conV = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%conFX = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%conFY = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%conFZ = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%conCa = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%conCdA = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%AttachedAnchs,1), UBOUND(OutData%AttachedAnchs,1) + OutData%AttachedAnchs(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + OutData%conX = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%conY = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%conZ = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%conM = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%conV = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%conFX = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%conFY = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%conFZ = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%conCa = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%conCdA = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%Ftot,1) i1_u = UBOUND(OutData%Ftot,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%Ftot = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Ftot))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Ftot) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Ftot,1), UBOUND(OutData%Ftot,1) + OutData%Ftot(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%Mtot,1) i1_u = UBOUND(OutData%Mtot,1) i2_l = LBOUND(OutData%Mtot,2) i2_u = UBOUND(OutData%Mtot,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%Mtot = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Mtot))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Mtot) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Mtot,2), UBOUND(OutData%Mtot,2) + DO i1 = LBOUND(OutData%Mtot,1), UBOUND(OutData%Mtot,1) + OutData%Mtot(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%S,1) i1_u = UBOUND(OutData%S,1) i2_l = LBOUND(OutData%S,2) i2_u = UBOUND(OutData%S,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%S = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%S))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%S) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%S,2), UBOUND(OutData%S,2) + DO i1 = LBOUND(OutData%S,1), UBOUND(OutData%S,1) + OutData%S(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%r,1) i1_u = UBOUND(OutData%r,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%r = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%r))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%r) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%r,1), UBOUND(OutData%r,1) + OutData%r(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%rd,1) i1_u = UBOUND(OutData%rd,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rd = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%rd))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%rd) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rd,1), UBOUND(OutData%rd,1) + OutData%rd(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE MD_UnPackConnect SUBROUTINE MD_CopyLine( SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg ) @@ -1595,26 +1554,28 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%IdNum - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%type) - IntKiBuf(Int_Xferred) = ICHAR(InData%type(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%OutFlagList))-1 ) = PACK(InData%OutFlagList,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%OutFlagList) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%FairConnect - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%AnchConnect - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%PropsIdNum - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%N - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%UnstrLen - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%BA - Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%IdNum + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%type) + IntKiBuf(Int_Xferred) = ICHAR(InData%type(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO i1 = LBOUND(InData%OutFlagList,1), UBOUND(InData%OutFlagList,1) + IntKiBuf(Int_Xferred) = InData%OutFlagList(i1) + Int_Xferred = Int_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%FairConnect + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%AnchConnect + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%PropsIdNum + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%N + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%UnstrLen + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%BA + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%r) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1628,8 +1589,12 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%r)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%r))-1 ) = PACK(InData%r,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%r) + DO i2 = LBOUND(InData%r,2), UBOUND(InData%r,2) + DO i1 = LBOUND(InData%r,1), UBOUND(InData%r,1) + ReKiBuf(Re_Xferred) = InData%r(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%rd) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1644,8 +1609,12 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rd,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rd)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%rd))-1 ) = PACK(InData%rd,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%rd) + DO i2 = LBOUND(InData%rd,2), UBOUND(InData%rd,2) + DO i1 = LBOUND(InData%rd,1), UBOUND(InData%rd,1) + ReKiBuf(Re_Xferred) = InData%rd(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%q) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1660,8 +1629,12 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%q,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%q)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%q))-1 ) = PACK(InData%q,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%q) + DO i2 = LBOUND(InData%q,2), UBOUND(InData%q,2) + DO i1 = LBOUND(InData%q,1), UBOUND(InData%q,1) + ReKiBuf(Re_Xferred) = InData%q(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%l) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1673,8 +1646,10 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%l,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%l)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%l))-1 ) = PACK(InData%l,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%l) + DO i1 = LBOUND(InData%l,1), UBOUND(InData%l,1) + ReKiBuf(Re_Xferred) = InData%l(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%lstr) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1686,8 +1661,10 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%lstr,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%lstr)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%lstr))-1 ) = PACK(InData%lstr,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%lstr) + DO i1 = LBOUND(InData%lstr,1), UBOUND(InData%lstr,1) + ReKiBuf(Re_Xferred) = InData%lstr(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%lstrd) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1699,8 +1676,10 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%lstrd,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%lstrd)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%lstrd))-1 ) = PACK(InData%lstrd,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%lstrd) + DO i1 = LBOUND(InData%lstrd,1), UBOUND(InData%lstrd,1) + ReKiBuf(Re_Xferred) = InData%lstrd(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%V) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1712,8 +1691,10 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%V)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%V))-1 ) = PACK(InData%V,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%V) + DO i1 = LBOUND(InData%V,1), UBOUND(InData%V,1) + ReKiBuf(Re_Xferred) = InData%V(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%T) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1728,8 +1709,12 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%T,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%T)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%T))-1 ) = PACK(InData%T,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%T) + DO i2 = LBOUND(InData%T,2), UBOUND(InData%T,2) + DO i1 = LBOUND(InData%T,1), UBOUND(InData%T,1) + ReKiBuf(Re_Xferred) = InData%T(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Td) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1744,8 +1729,12 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Td,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Td)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Td))-1 ) = PACK(InData%Td,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Td) + DO i2 = LBOUND(InData%Td,2), UBOUND(InData%Td,2) + DO i1 = LBOUND(InData%Td,1), UBOUND(InData%Td,1) + ReKiBuf(Re_Xferred) = InData%Td(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%W) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1760,8 +1749,12 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%W,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%W)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%W))-1 ) = PACK(InData%W,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%W) + DO i2 = LBOUND(InData%W,2), UBOUND(InData%W,2) + DO i1 = LBOUND(InData%W,1), UBOUND(InData%W,1) + ReKiBuf(Re_Xferred) = InData%W(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Dp) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1776,8 +1769,12 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Dp,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Dp)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Dp))-1 ) = PACK(InData%Dp,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Dp) + DO i2 = LBOUND(InData%Dp,2), UBOUND(InData%Dp,2) + DO i1 = LBOUND(InData%Dp,1), UBOUND(InData%Dp,1) + ReKiBuf(Re_Xferred) = InData%Dp(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Dq) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1792,8 +1789,12 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Dq,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Dq)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Dq))-1 ) = PACK(InData%Dq,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Dq) + DO i2 = LBOUND(InData%Dq,2), UBOUND(InData%Dq,2) + DO i1 = LBOUND(InData%Dq,1), UBOUND(InData%Dq,1) + ReKiBuf(Re_Xferred) = InData%Dq(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Ap) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1808,8 +1809,12 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ap,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Ap)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Ap))-1 ) = PACK(InData%Ap,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Ap) + DO i2 = LBOUND(InData%Ap,2), UBOUND(InData%Ap,2) + DO i1 = LBOUND(InData%Ap,1), UBOUND(InData%Ap,1) + ReKiBuf(Re_Xferred) = InData%Ap(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Aq) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1824,8 +1829,12 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Aq,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Aq)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Aq))-1 ) = PACK(InData%Aq,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Aq) + DO i2 = LBOUND(InData%Aq,2), UBOUND(InData%Aq,2) + DO i1 = LBOUND(InData%Aq,1), UBOUND(InData%Aq,1) + ReKiBuf(Re_Xferred) = InData%Aq(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%B) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1840,8 +1849,12 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%B,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%B)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%B))-1 ) = PACK(InData%B,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%B) + DO i2 = LBOUND(InData%B,2), UBOUND(InData%B,2) + DO i1 = LBOUND(InData%B,1), UBOUND(InData%B,1) + ReKiBuf(Re_Xferred) = InData%B(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%F) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1856,8 +1869,12 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%F)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F))-1 ) = PACK(InData%F,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F) + DO i2 = LBOUND(InData%F,2), UBOUND(InData%F,2) + DO i1 = LBOUND(InData%F,1), UBOUND(InData%F,1) + ReKiBuf(Re_Xferred) = InData%F(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%S) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1875,8 +1892,14 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%S,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%S)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%S))-1 ) = PACK(InData%S,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%S) + DO i3 = LBOUND(InData%S,3), UBOUND(InData%S,3) + DO i2 = LBOUND(InData%S,2), UBOUND(InData%S,2) + DO i1 = LBOUND(InData%S,1), UBOUND(InData%S,1) + ReKiBuf(Re_Xferred) = InData%S(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%M) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1894,11 +1917,17 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%M)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%M))-1 ) = PACK(InData%M,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%M) + DO i3 = LBOUND(InData%M,3), UBOUND(InData%M,3) + DO i2 = LBOUND(InData%M,2), UBOUND(InData%M,2) + DO i1 = LBOUND(InData%M,1), UBOUND(InData%M,1) + ReKiBuf(Re_Xferred) = InData%M(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%LineUnOut - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%LineUnOut + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%LineWrOutput) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1909,8 +1938,10 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LineWrOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LineWrOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LineWrOutput))-1 ) = PACK(InData%LineWrOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LineWrOutput) + DO i1 = LBOUND(InData%LineWrOutput,1), UBOUND(InData%LineWrOutput,1) + ReKiBuf(Re_Xferred) = InData%LineWrOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE MD_PackLine @@ -1927,12 +1958,6 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -1949,35 +1974,30 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%IdNum = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%type) - OutData%type(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + OutData%IdNum = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%type) + OutData%type(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I i1_l = LBOUND(OutData%OutFlagList,1) i1_u = UBOUND(OutData%OutFlagList,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%OutFlagList = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%OutFlagList))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%OutFlagList) - DEALLOCATE(mask1) - OutData%FairConnect = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%AnchConnect = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%PropsIdNum = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%N = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%UnstrLen = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%BA = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%OutFlagList,1), UBOUND(OutData%OutFlagList,1) + OutData%OutFlagList(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + OutData%FairConnect = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%AnchConnect = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%PropsIdNum = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%N = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%UnstrLen = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%BA = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! r not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1994,15 +2014,12 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%r.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%r)>0) OutData%r = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%r))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%r) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%r,2), UBOUND(OutData%r,2) + DO i1 = LBOUND(OutData%r,1), UBOUND(OutData%r,1) + OutData%r(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rd not allocated Int_Xferred = Int_Xferred + 1 @@ -2020,15 +2037,12 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rd.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%rd)>0) OutData%rd = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%rd))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%rd) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%rd,2), UBOUND(OutData%rd,2) + DO i1 = LBOUND(OutData%rd,1), UBOUND(OutData%rd,1) + OutData%rd(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! q not allocated Int_Xferred = Int_Xferred + 1 @@ -2046,15 +2060,12 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%q.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%q)>0) OutData%q = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%q))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%q) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%q,2), UBOUND(OutData%q,2) + DO i1 = LBOUND(OutData%q,1), UBOUND(OutData%q,1) + OutData%q(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! l not allocated Int_Xferred = Int_Xferred + 1 @@ -2069,15 +2080,10 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%l.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%l)>0) OutData%l = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%l))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%l) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%l,1), UBOUND(OutData%l,1) + OutData%l(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! lstr not allocated Int_Xferred = Int_Xferred + 1 @@ -2092,15 +2098,10 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%lstr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%lstr)>0) OutData%lstr = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%lstr))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%lstr) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%lstr,1), UBOUND(OutData%lstr,1) + OutData%lstr(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! lstrd not allocated Int_Xferred = Int_Xferred + 1 @@ -2115,15 +2116,10 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%lstrd.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%lstrd)>0) OutData%lstrd = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%lstrd))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%lstrd) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%lstrd,1), UBOUND(OutData%lstrd,1) + OutData%lstrd(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! V not allocated Int_Xferred = Int_Xferred + 1 @@ -2138,15 +2134,10 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%V.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%V)>0) OutData%V = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%V))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%V) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%V,1), UBOUND(OutData%V,1) + OutData%V(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! T not allocated Int_Xferred = Int_Xferred + 1 @@ -2164,15 +2155,12 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%T.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%T)>0) OutData%T = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%T))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%T) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%T,2), UBOUND(OutData%T,2) + DO i1 = LBOUND(OutData%T,1), UBOUND(OutData%T,1) + OutData%T(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Td not allocated Int_Xferred = Int_Xferred + 1 @@ -2190,15 +2178,12 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Td.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Td)>0) OutData%Td = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Td))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Td) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Td,2), UBOUND(OutData%Td,2) + DO i1 = LBOUND(OutData%Td,1), UBOUND(OutData%Td,1) + OutData%Td(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! W not allocated Int_Xferred = Int_Xferred + 1 @@ -2216,15 +2201,12 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%W)>0) OutData%W = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%W))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%W) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%W,2), UBOUND(OutData%W,2) + DO i1 = LBOUND(OutData%W,1), UBOUND(OutData%W,1) + OutData%W(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Dp not allocated Int_Xferred = Int_Xferred + 1 @@ -2242,15 +2224,12 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Dp.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Dp)>0) OutData%Dp = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Dp))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Dp) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Dp,2), UBOUND(OutData%Dp,2) + DO i1 = LBOUND(OutData%Dp,1), UBOUND(OutData%Dp,1) + OutData%Dp(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Dq not allocated Int_Xferred = Int_Xferred + 1 @@ -2268,15 +2247,12 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Dq.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Dq)>0) OutData%Dq = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Dq))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Dq) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Dq,2), UBOUND(OutData%Dq,2) + DO i1 = LBOUND(OutData%Dq,1), UBOUND(OutData%Dq,1) + OutData%Dq(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Ap not allocated Int_Xferred = Int_Xferred + 1 @@ -2294,15 +2270,12 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ap.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Ap)>0) OutData%Ap = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Ap))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Ap) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Ap,2), UBOUND(OutData%Ap,2) + DO i1 = LBOUND(OutData%Ap,1), UBOUND(OutData%Ap,1) + OutData%Ap(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Aq not allocated Int_Xferred = Int_Xferred + 1 @@ -2320,15 +2293,12 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Aq.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Aq)>0) OutData%Aq = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Aq))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Aq) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Aq,2), UBOUND(OutData%Aq,2) + DO i1 = LBOUND(OutData%Aq,1), UBOUND(OutData%Aq,1) + OutData%Aq(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! B not allocated Int_Xferred = Int_Xferred + 1 @@ -2346,15 +2316,12 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%B.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%B)>0) OutData%B = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%B))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%B) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%B,2), UBOUND(OutData%B,2) + DO i1 = LBOUND(OutData%B,1), UBOUND(OutData%B,1) + OutData%B(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F not allocated Int_Xferred = Int_Xferred + 1 @@ -2372,15 +2339,12 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%F)>0) OutData%F = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%F,2), UBOUND(OutData%F,2) + DO i1 = LBOUND(OutData%F,1), UBOUND(OutData%F,1) + OutData%F(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! S not allocated Int_Xferred = Int_Xferred + 1 @@ -2401,15 +2365,14 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%S.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%S)>0) OutData%S = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%S))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%S) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%S,3), UBOUND(OutData%S,3) + DO i2 = LBOUND(OutData%S,2), UBOUND(OutData%S,2) + DO i1 = LBOUND(OutData%S,1), UBOUND(OutData%S,1) + OutData%S(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! M not allocated Int_Xferred = Int_Xferred + 1 @@ -2430,18 +2393,17 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%M.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%M)>0) OutData%M = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%M))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%M) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%M,3), UBOUND(OutData%M,3) + DO i2 = LBOUND(OutData%M,2), UBOUND(OutData%M,2) + DO i1 = LBOUND(OutData%M,1), UBOUND(OutData%M,1) + OutData%M(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - OutData%LineUnOut = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%LineUnOut = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LineWrOutput not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2455,15 +2417,10 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineWrOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LineWrOutput)>0) OutData%LineWrOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LineWrOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LineWrOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LineWrOutput,1), UBOUND(OutData%LineWrOutput,1) + OutData%LineWrOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE MD_UnPackLine @@ -2568,22 +2525,22 @@ SUBROUTINE MD_PackOutParmType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%Name) - IntKiBuf(Int_Xferred) = ICHAR(InData%Name(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%Units) - IntKiBuf(Int_Xferred) = ICHAR(InData%Units(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%QType - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%OType - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NodeID - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%ObjID - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%Name) + IntKiBuf(Int_Xferred) = ICHAR(InData%Name(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%Units) + IntKiBuf(Int_Xferred) = ICHAR(InData%Units(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%QType + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%OType + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NodeID + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%ObjID + Int_Xferred = Int_Xferred + 1 END SUBROUTINE MD_PackOutParmType SUBROUTINE MD_UnPackOutParmType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2599,12 +2556,6 @@ SUBROUTINE MD_UnPackOutParmType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackOutParmType' @@ -2618,22 +2569,22 @@ SUBROUTINE MD_UnPackOutParmType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%Name) - OutData%Name(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Units) - OutData%Units(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%QType = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%OType = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NodeID = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ObjID = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%Name) + OutData%Name(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%Units) + OutData%Units(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%QType = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%OType = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NodeID = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ObjID = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE MD_UnPackOutParmType SUBROUTINE MD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -2798,12 +2749,12 @@ SUBROUTINE MD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%writeOutputHdr,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%writeOutputHdr,1), UBOUND(InData%writeOutputHdr,1) + DO i1 = LBOUND(InData%writeOutputHdr,1), UBOUND(InData%writeOutputHdr,1) DO I = 1, LEN(InData%writeOutputHdr) IntKiBuf(Int_Xferred) = ICHAR(InData%writeOutputHdr(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%writeOutputUnt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2815,12 +2766,12 @@ SUBROUTINE MD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%writeOutputUnt,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%writeOutputUnt,1), UBOUND(InData%writeOutputUnt,1) + DO i1 = LBOUND(InData%writeOutputUnt,1), UBOUND(InData%writeOutputUnt,1) DO I = 1, LEN(InData%writeOutputUnt) IntKiBuf(Int_Xferred) = ICHAR(InData%writeOutputUnt(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2865,12 +2816,6 @@ SUBROUTINE MD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -2898,19 +2843,12 @@ SUBROUTINE MD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%writeOutputHdr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%writeOutputHdr,1), UBOUND(OutData%writeOutputHdr,1) + DO i1 = LBOUND(OutData%writeOutputHdr,1), UBOUND(OutData%writeOutputHdr,1) DO I = 1, LEN(OutData%writeOutputHdr) OutData%writeOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! writeOutputUnt not allocated Int_Xferred = Int_Xferred + 1 @@ -2925,19 +2863,12 @@ SUBROUTINE MD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%writeOutputUnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%writeOutputUnt,1), UBOUND(OutData%writeOutputUnt,1) + DO i1 = LBOUND(OutData%writeOutputUnt,1), UBOUND(OutData%writeOutputUnt,1) DO I = 1, LEN(OutData%writeOutputUnt) OutData%writeOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -3101,8 +3032,10 @@ SUBROUTINE MD_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%states,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%states)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%states))-1 ) = PACK(InData%states,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%states) + DO i1 = LBOUND(InData%states,1), UBOUND(InData%states,1) + ReKiBuf(Re_Xferred) = InData%states(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE MD_PackContState @@ -3119,12 +3052,6 @@ SUBROUTINE MD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -3152,15 +3079,10 @@ SUBROUTINE MD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%states.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%states)>0) OutData%states = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%states))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%states) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%states,1), UBOUND(OutData%states,1) + OutData%states(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE MD_UnPackContState @@ -3255,8 +3177,8 @@ SUBROUTINE MD_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dummy - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dummy + Re_Xferred = Re_Xferred + 1 END SUBROUTINE MD_PackDiscState SUBROUTINE MD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -3272,12 +3194,6 @@ SUBROUTINE MD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackDiscState' @@ -3291,8 +3207,8 @@ SUBROUTINE MD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%dummy = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%dummy = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE MD_UnPackDiscState SUBROUTINE MD_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -3386,8 +3302,8 @@ SUBROUTINE MD_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dummy - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dummy + Re_Xferred = Re_Xferred + 1 END SUBROUTINE MD_PackConstrState SUBROUTINE MD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -3403,12 +3319,6 @@ SUBROUTINE MD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackConstrState' @@ -3422,8 +3332,8 @@ SUBROUTINE MD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%dummy = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%dummy = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE MD_UnPackConstrState SUBROUTINE MD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -3517,8 +3427,8 @@ SUBROUTINE MD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dummy - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dummy + Re_Xferred = Re_Xferred + 1 END SUBROUTINE MD_PackOtherState SUBROUTINE MD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -3534,12 +3444,6 @@ SUBROUTINE MD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackOtherState' @@ -3553,8 +3457,8 @@ SUBROUTINE MD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%dummy = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%dummy = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE MD_UnPackOtherState SUBROUTINE MD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -3996,8 +3900,10 @@ SUBROUTINE MD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FairIdList,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FairIdList)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%FairIdList))-1 ) = PACK(InData%FairIdList,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%FairIdList) + DO i1 = LBOUND(InData%FairIdList,1), UBOUND(InData%FairIdList,1) + IntKiBuf(Int_Xferred) = InData%FairIdList(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%ConnIdList) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4009,8 +3915,10 @@ SUBROUTINE MD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ConnIdList,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ConnIdList)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%ConnIdList))-1 ) = PACK(InData%ConnIdList,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%ConnIdList) + DO i1 = LBOUND(InData%ConnIdList,1), UBOUND(InData%ConnIdList,1) + IntKiBuf(Int_Xferred) = InData%ConnIdList(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LineStateIndList) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4022,8 +3930,10 @@ SUBROUTINE MD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LineStateIndList,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LineStateIndList)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%LineStateIndList))-1 ) = PACK(InData%LineStateIndList,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%LineStateIndList) + DO i1 = LBOUND(InData%LineStateIndList,1), UBOUND(InData%LineStateIndList,1) + IntKiBuf(Int_Xferred) = InData%LineStateIndList(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%MDWrOutput) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4035,8 +3945,10 @@ SUBROUTINE MD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MDWrOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%MDWrOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MDWrOutput))-1 ) = PACK(InData%MDWrOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MDWrOutput) + DO i1 = LBOUND(InData%MDWrOutput,1), UBOUND(InData%MDWrOutput,1) + ReKiBuf(Re_Xferred) = InData%MDWrOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE MD_PackMisc @@ -4053,12 +3965,6 @@ SUBROUTINE MD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -4254,15 +4160,10 @@ SUBROUTINE MD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FairIdList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%FairIdList)>0) OutData%FairIdList = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%FairIdList))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%FairIdList) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FairIdList,1), UBOUND(OutData%FairIdList,1) + OutData%FairIdList(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ConnIdList not allocated Int_Xferred = Int_Xferred + 1 @@ -4277,15 +4178,10 @@ SUBROUTINE MD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ConnIdList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%ConnIdList)>0) OutData%ConnIdList = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%ConnIdList))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%ConnIdList) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%ConnIdList,1), UBOUND(OutData%ConnIdList,1) + OutData%ConnIdList(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LineStateIndList not allocated Int_Xferred = Int_Xferred + 1 @@ -4300,15 +4196,10 @@ SUBROUTINE MD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineStateIndList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LineStateIndList)>0) OutData%LineStateIndList = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%LineStateIndList))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%LineStateIndList) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LineStateIndList,1), UBOUND(OutData%LineStateIndList,1) + OutData%LineStateIndList(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MDWrOutput not allocated Int_Xferred = Int_Xferred + 1 @@ -4323,15 +4214,10 @@ SUBROUTINE MD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MDWrOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%MDWrOutput)>0) OutData%MDWrOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MDWrOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MDWrOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%MDWrOutput,1), UBOUND(OutData%MDWrOutput,1) + OutData%MDWrOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE MD_UnPackMisc @@ -4505,38 +4391,38 @@ SUBROUTINE MD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NTypes - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NConnects - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NFairs - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NConns - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NAnchs - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NLines - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%g - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rhoW - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%kBot - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%cBot - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dtM0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dtCoupling - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + IntKiBuf(Int_Xferred) = InData%NTypes + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NConnects + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NFairs + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NConns + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NAnchs + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NLines + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%g + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rhoW + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDpth + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%kBot + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%cBot + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dtM0 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dtCoupling + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4578,12 +4464,12 @@ SUBROUTINE MD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si ENDIF END DO END IF - DO I = 1, LEN(InData%Delim) - IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MDUnOut - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%Delim) + IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%MDUnOut + Int_Xferred = Int_Xferred + 1 END SUBROUTINE MD_PackParam SUBROUTINE MD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -4599,12 +4485,6 @@ SUBROUTINE MD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -4619,38 +4499,38 @@ SUBROUTINE MD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%NTypes = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NConnects = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NFairs = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NConns = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NAnchs = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NLines = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%g = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rhoW = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDpth = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%kBot = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%cBot = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%dtM0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%dtCoupling = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + OutData%NTypes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NConnects = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NFairs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NConns = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NAnchs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NLines = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%g = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rhoW = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WtrDpth = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%kBot = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%cBot = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%dtM0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%dtCoupling = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -4707,12 +4587,12 @@ SUBROUTINE MD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%MDUnOut = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%Delim) + OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%MDUnOut = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE MD_UnPackParam SUBROUTINE MD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -4869,12 +4749,6 @@ SUBROUTINE MD_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackInput' @@ -5100,8 +4974,10 @@ SUBROUTINE MD_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WriteOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE MD_PackOutput @@ -5118,12 +4994,6 @@ SUBROUTINE MD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -5191,15 +5061,10 @@ SUBROUTINE MD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WriteOutput)>0) OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE MD_UnPackOutput @@ -5278,8 +5143,8 @@ SUBROUTINE MD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'MD_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -5294,6 +5159,8 @@ SUBROUTINE MD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(u1%PtFairleadDisplacement, u2%PtFairleadDisplacement, tin, u_out%PtFairleadDisplacement, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE MD_Input_ExtrapInterp1 @@ -5325,8 +5192,9 @@ SUBROUTINE MD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'MD_Input_ExtrapInterp2' @@ -5348,6 +5216,8 @@ SUBROUTINE MD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(u1%PtFairleadDisplacement, u2%PtFairleadDisplacement, u3%PtFairleadDisplacement, tin, u_out%PtFairleadDisplacement, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE MD_Input_ExtrapInterp2 @@ -5427,12 +5297,12 @@ SUBROUTINE MD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'MD_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! 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 :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -5445,15 +5315,15 @@ SUBROUTINE MD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(y1%PtFairleadLoad, y2%PtFairleadLoad, tin, y_out%PtFairleadLoad, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END IF ! check if allocated END SUBROUTINE MD_Output_ExtrapInterp1 @@ -5484,13 +5354,14 @@ SUBROUTINE MD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'MD_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -5509,16 +5380,16 @@ SUBROUTINE MD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(y1%PtFairleadLoad, y2%PtFairleadLoad, y3%PtFairleadLoad, tin, y_out%PtFairleadLoad, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END IF ! check if allocated END SUBROUTINE MD_Output_ExtrapInterp2 diff --git a/modules/nwtc-library/src/ModMesh.f90 b/modules/nwtc-library/src/ModMesh.f90 index e5af024392..00a8ee68fd 100644 --- a/modules/nwtc-library/src/ModMesh.f90 +++ b/modules/nwtc-library/src/ModMesh.f90 @@ -1543,7 +1543,7 @@ SUBROUTINE MeshPack ( Mesh, ReKiBuf, DbKiBuf, IntKiBuf , ErrStat, ErrMess, SizeO ELSE ! initialized, may or may not be committed Int_BufSz = 3 & ! number of logicals in MeshType (initialized, committed, RemapFlag) + FIELDMASK_SIZE & ! number of logicals in MeshType (fieldmask) - + 4 ! number of non-pointer integers (ios, nnodes, nextelem, nscalars) + + 5 ! number of non-pointer integers (ios, nnodes, nextelem, nscalars, refNode) !...... ! we'll store the element structure (and call MeshCommit on Unpack if necessary to get the remaining fields like det_jac) @@ -1638,6 +1638,7 @@ SUBROUTINE MeshPack ( Mesh, ReKiBuf, DbKiBuf, IntKiBuf , ErrStat, ErrMess, SizeO ! integers IntKiBuf(Int_Xferred) = Mesh%ios; Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = Mesh%nnodes; Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = Mesh%refnode; Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = Mesh%nextelem; Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = Mesh%nscalars; Int_Xferred = Int_Xferred + 1 @@ -1746,7 +1747,7 @@ SUBROUTINE MeshUnpack( Mesh, ReKiBuf, DbKiBuf, IntKiBuf, ErrStat, ErrMess ) ! Local LOGICAL committed, RemapFlag, fieldmask(FIELDMASK_SIZE) - INTEGER nScalars, ios, nnodes, nextelem, nelemnodes, nelem + INTEGER nScalars, ios, nnodes, nextelem, nelemnodes, nelem, refnode INTEGER i,j INTEGER(IntKi) :: Re_Xferred ! number of reals transferred @@ -1780,6 +1781,7 @@ SUBROUTINE MeshUnpack( Mesh, ReKiBuf, DbKiBuf, IntKiBuf, ErrStat, ErrMess ) ! integers ios = IntKiBuf(Int_Xferred) ; Int_Xferred = Int_Xferred + 1 nnodes = IntKiBuf(Int_Xferred) ; Int_Xferred = Int_Xferred + 1 + refnode = IntKiBuf(Int_Xferred) ; Int_Xferred = Int_Xferred + 1 nextelem = IntKiBuf(Int_Xferred) ; Int_Xferred = Int_Xferred + 1 nscalars = IntKiBuf(Int_Xferred) ; Int_Xferred = Int_Xferred + 1 @@ -1799,6 +1801,7 @@ SUBROUTINE MeshUnpack( Mesh, ReKiBuf, DbKiBuf, IntKiBuf, ErrStat, ErrMess ) CALL SetErrStat(ErrStat2, ErrMess2, ErrStat, ErrMess, RoutineName) IF (ErrStat >= AbortErrLev) RETURN + Mesh%RefNode = refnode Mesh%RemapFlag = RemapFlag Mesh%nextelem = nextelem @@ -2013,7 +2016,7 @@ SUBROUTINE MeshCopy( SrcMesh, DestMesh, CtrlCode, 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 + IOS_l = SrcMesh%IOS Force_l = SrcMesh%FieldMask(MASKID_FORCE) Moment_l = SrcMesh%FieldMask(MASKID_MOMENT) Orientation_l = SrcMesh%FieldMask(MASKID_ORIENTATION) @@ -2195,6 +2198,7 @@ SUBROUTINE MeshCopy( SrcMesh, DestMesh, CtrlCode, ErrStat , ErrMess & DestMesh%Initialized = SrcMesh%Initialized DestMesh%Committed = SrcMesh%Committed + DestMesh%refNode = SrcMesh%refNode IF ( ALLOCATED(SrcMesh%Force ) .AND. ALLOCATED(DestMesh%Force ) ) DestMesh%Force = SrcMesh%Force IF ( ALLOCATED(SrcMesh%Moment ) .AND. ALLOCATED(DestMesh%Moment ) ) DestMesh%Moment = SrcMesh%Moment IF ( ALLOCATED(SrcMesh%Orientation ) .AND. ALLOCATED(DestMesh%Orientation ) ) DestMesh%Orientation = SrcMesh%Orientation @@ -2215,7 +2219,7 @@ END SUBROUTINE MeshCopy !! If an Orient argument is included, the node will also be assigned the specified orientation !! (orientation is assumed to be the identity matrix if omitted). Returns a non-zero value in !! ErrStat if Inode is outside the range 1..Nnodes. - SUBROUTINE MeshPositionNode( Mesh, Inode, Pos, ErrStat, ErrMess, Orient ) + SUBROUTINE MeshPositionNode( Mesh, Inode, Pos, ErrStat, ErrMess, Orient, Ref ) TYPE(MeshType), INTENT(INOUT) :: Mesh !< Mesh being spatio-located INTEGER(IntKi), INTENT(IN ) :: Inode !< Number of node being located @@ -2223,6 +2227,7 @@ SUBROUTINE MeshPositionNode( Mesh, Inode, Pos, ErrStat, ErrMess, Orient ) INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error code CHARACTER(*), INTENT( OUT) :: ErrMess !< Error message REAL(R8Ki), OPTIONAL, INTENT(IN ) :: Orient(3,3) !< Orientation (direction cosine matrix) of node; identity by default + LOGICAL, OPTIONAL, INTENT(IN ) :: Ref ErrStat = ErrID_None ErrMess = "" @@ -2276,6 +2281,10 @@ SUBROUTINE MeshPositionNode( Mesh, Inode, Pos, ErrStat, ErrMess, Orient ) Mesh%RefOrientation(:,3,Inode) = (/ 0._R8Ki, 0._R8Ki, 1._R8Ki /) END IF + IF (PRESENT(Ref)) THEN + Mesh%RefNode = Inode + END IF + RETURN END SUBROUTINE MeshPositionNode @@ -2913,9 +2922,9 @@ SUBROUTINE PackLoadMesh_Names(M, MeshName, Names, indx_first) do j=1,3 Names(indx_first) = trim(MeshName)//' '//Comp(j)//' moment, node '//trim(num2lstr(i))//', Nm'//UnitDesc indx_first = indx_first + 1 - end do + end do end do - end if + end if END SUBROUTINE PackLoadMesh_Names !............................................................................................................................... @@ -2944,9 +2953,9 @@ SUBROUTINE PackLoadMesh(M, Ary, indx_first) do j=1,3 Ary(indx_first) = M%Moment(j,i) indx_first = indx_first + 1 - end do + end do end do - end if + end if END SUBROUTINE PackLoadMesh !............................................................................................................................... @@ -2977,7 +2986,7 @@ SUBROUTINE PackLoadMesh_dY(M_p, M_m, dY, indx_first) indx_first = indx_last + 1 end do end if - + END SUBROUTINE PackLoadMesh_dY !............................................................................................................................... !> This subroutine returns the names of rows/columns of motion meshes in the Jacobian matrices. It assumes all fields marked @@ -3064,17 +3073,23 @@ END SUBROUTINE PackMotionMesh_Names !> This subroutine returns the operating point values of the mesh fields. It assumes all fields marked !! by FieldMask are allocated; Some fields may be allocated by the ModMesh module and not used in !! the linearization procedure, thus I am not using the check if they are allocated to determine if they should be included. - SUBROUTINE PackMotionMesh(M, Ary, indx_first, FieldMask) + SUBROUTINE PackMotionMesh(M, Ary, indx_first, FieldMask, UseLogMaps) TYPE(MeshType) , INTENT(IN ) :: M !< Motion mesh REAL(ReKi) , 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 ) :: UseLogMaps !< flag to determine if the orientation should be packed as a DCM or a log map ! local variables: INTEGER(IntKi) :: i, j, k LOGICAL :: Mask(FIELDMASK_SIZE) !< flags to determine if this field is part of the packing + LOGICAL :: OutputLogMap + REAL(R8Ki) :: logmap(3) !< array to pack logmaps into + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + if (present(FieldMask)) then Mask = FieldMask @@ -3093,14 +3108,30 @@ SUBROUTINE PackMotionMesh(M, Ary, indx_first, FieldMask) end if if (Mask(MASKID_ORIENTATION)) then - do i=1,M%NNodes - do j=1,3 - do k=1,3 ! note this gives us 9 values instead of 3 for this "operating point" - Ary(indx_first) = M%Orientation(j,k,i) + if (present(UseLogMaps)) then + OutputLogMap = UseLogMaps + else + OutputLogMap = .false. + end if + + if (OutputLogMap) then + do i=1,M%NNodes + call DCM_logMap(M%Orientation(:,:,i), logmap, ErrStat2, ErrMsg2) + do k=1,3 + Ary(indx_first) = logmap(k) indx_first = indx_first + 1 - end do - end do - end do + end do + end do + else + do i=1,M%NNodes + do j=1,3 + do k=1,3 ! note this gives us 9 values instead of 3 for this "operating point" + Ary(indx_first) = M%Orientation(j,k,i) + indx_first = indx_first + 1 + end do + end do + end do + end if end if if (Mask(MASKID_TRANSLATIONVEL)) then @@ -3388,7 +3419,7 @@ SUBROUTINE MeshExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) if ( size(t) .ne. order+1) then ErrStat = ErrID_Fatal - ErrMsg = 'MeshExtrapInterp2: size(t) must equal 2.' + ErrMsg = 'MeshExtrapInterp2: size(t) must equal 3.' RETURN end if diff --git a/modules/nwtc-library/src/ModMesh_Mapping.f90 b/modules/nwtc-library/src/ModMesh_Mapping.f90 index c2a13e4ee0..eb17f74235 100644 --- a/modules/nwtc-library/src/ModMesh_Mapping.f90 +++ b/modules/nwtc-library/src/ModMesh_Mapping.f90 @@ -1227,6 +1227,7 @@ SUBROUTINE Transfer_Motions_Line2_to_Point( Src, Dest, MeshMap, ErrStat, ErrMsg ! local variables INTEGER(IntKi) :: i , j ! counter over the nodes INTEGER(IntKi) :: k ! counter components + INTEGER(IntKi) :: nScalars ! number of scalars transferred INTEGER(IntKi) :: n, n1, n2 ! temporary space for node numbers REAL(R8Ki) :: FieldValueN1(3) ! Temporary variable to store field values on element nodes REAL(R8Ki) :: FieldValueN2(3) ! Temporary variable to store field values on element nodes @@ -1495,14 +1496,21 @@ SUBROUTINE Transfer_Motions_Line2_to_Point( Src, Dest, MeshMap, ErrStat, ErrMsg !! \phi_i\f$ if (Src%FieldMask(MASKID_SCALAR) .AND. Dest%FieldMask(MASKID_SCALAR) ) then + nScalars = min(Dest%nScalars, Src%nScalars) + + if (Dest%nScalars > nScalars) then + call SetErrStat(ErrID_Severe, "Not all scalars could be computed from source mesh (insufficient data).", ErrStat, ErrMsg, 'Transfer_Motions_Line2_to_Point') + Dest%Scalars(nScalars+1:,:) = 0.0_ReKi + end if + do i=1, Dest%Nnodes !if ( MeshMap%MapMotions(i)%OtherMesh_Element < 1 ) CYCLE n1 = Src%ElemTable(ELEMENT_LINE2)%Elements(MeshMap%MapMotions(i)%OtherMesh_Element)%ElemNodes(1) n2 = Src%ElemTable(ELEMENT_LINE2)%Elements(MeshMap%MapMotions(i)%OtherMesh_Element)%ElemNodes(2) - Dest%Scalars(:,i) = MeshMap%MapMotions(i)%shape_fn(1)*Src%Scalars(:,n1) & - + MeshMap%MapMotions(i)%shape_fn(2)*Src%Scalars(:,n2) + Dest%Scalars(1:nScalars,i) = MeshMap%MapMotions(i)%shape_fn(1)*Src%Scalars(1:nScalars,n1) & + + MeshMap%MapMotions(i)%shape_fn(2)*Src%Scalars(1:nScalars,n2) end do end if @@ -1941,7 +1949,7 @@ SUBROUTINE CreateMapping_ProjectToLine2(Mesh1, Mesh2, NodeMap, Mesh1_TYPE, ErrSt ! if failed to find an element that the Point projected into, throw an error if (.not. found) then - if ( closest_elem_distance < 5.0e-3 ) then ! if it is within 5mm of the end of an element, we'll accept it + if ( closest_elem_distance <= 7.5e-3 ) then ! if it is within 7.5mm of the end of an element, we'll accept it NodeMap(i)%OtherMesh_Element = closest_elem NodeMap(i)%shape_fn(1) = 1.0_ReKi - closest_elem_position NodeMap(i)%shape_fn(2) = closest_elem_position @@ -1949,7 +1957,8 @@ SUBROUTINE CreateMapping_ProjectToLine2(Mesh1, Mesh2, NodeMap, Mesh1_TYPE, ErrSt end if if (NodeMap(i)%OtherMesh_Element .lt. 1 ) then - CALL SetErrStat( ErrID_Fatal, 'Node '//trim(num2Lstr(i))//' does not project onto any line2 element.', ErrStat, ErrMsg, RoutineName) + CALL SetErrStat( ErrID_Fatal, 'Node '//trim(num2Lstr(i))//' does not project onto any line2 element.' & + //' Closest distance is '//trim(num2lstr(closest_elem_distance))//' m.', ErrStat, ErrMsg, RoutineName) #ifdef DEBUG_MESHMAPPING ! output some mesh information for debugging @@ -2625,6 +2634,7 @@ SUBROUTINE Transfer_Motions_Point_to_Point( Src, Dest, MeshMap, ErrStat, ErrMsg CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None ! local variables + INTEGER(IntKi) :: nScalars INTEGER(IntKi) :: i, j ! counter over the nodes REAL(R8Ki) :: RotationMatrix(3,3) REAL(ReKi) :: TmpVec(3) @@ -2773,10 +2783,17 @@ SUBROUTINE Transfer_Motions_Point_to_Point( Src, Dest, MeshMap, ErrStat, ErrMsg !> Scalars: \f$S^D = S^S\f$ if (Src%FieldMask(MASKID_SCALAR) .AND. Dest%FieldMask(MASKID_SCALAR) ) then + nScalars = min(Dest%nScalars, Src%nScalars) + + if (Dest%nScalars > nScalars) then + call SetErrStat(ErrID_Severe, "Not all scalars could be computed from source mesh (insufficient data).", ErrStat, ErrMsg, 'Transfer_Motions_Point_to_Point') + Dest%Scalars(nScalars+1:,:) = 0.0_ReKi + end if + do i=1, Dest%Nnodes !if ( MeshMap%MapMotions(i)%OtherMesh_Element < 1 ) CYCLE - Dest%Scalars(:,i) = Src%Scalars(:,MeshMap%MapMotions(i)%OtherMesh_Element) + Dest%Scalars(1:nScalars,i) = Src%Scalars(1:nScalars,MeshMap%MapMotions(i)%OtherMesh_Element) end do end if @@ -5540,7 +5557,7 @@ SUBROUTINE WriteMappingTransferToFile(Mesh1_I,Mesh1_O,Mesh2_I,Mesh2_O,Map_Mod1_M INTEGER(IntKi) :: i INTEGER(IntKi) :: un_out INTEGER(IntKi) :: ErrStat ! Error status of the operation - CHARACTER(1024) :: ErrMsg ! Error message if ErrStat /= ErrID_None + CHARACTER(ErrMsgLen) :: ErrMsg ! Error message if ErrStat /= ErrID_None CHARACTER(256) :: PrintWarnF, PrintWarnM, TmpValues #ifdef MESH_DEBUG diff --git a/modules/nwtc-library/src/ModMesh_Types.f90 b/modules/nwtc-library/src/ModMesh_Types.f90 index f4c82f3977..c3b1d71638 100644 --- a/modules/nwtc-library/src/ModMesh_Types.f90 +++ b/modules/nwtc-library/src/ModMesh_Types.f90 @@ -101,6 +101,7 @@ MODULE ModMesh_Types LOGICAL :: fieldmask(FIELDMASK_SIZE) = .FALSE. !< Dimension as number of allocatable fields, below LOGICAL,POINTER :: RemapFlag => NULL() !< false=no action/ignore; true=remap required INTEGER :: ios !< Mesh type: input (1), output(2), or state(3) + INTEGER :: refNode = 0 !< optional reference node (informational only) INTEGER :: Nnodes = 0 !< Number of nodes (vertices) in mesh ! Mesh elements diff --git a/modules/nwtc-library/src/NWTC_IO.f90 b/modules/nwtc-library/src/NWTC_IO.f90 index 6d6da2978d..9b6271e991 100644 --- a/modules/nwtc-library/src/NWTC_IO.f90 +++ b/modules/nwtc-library/src/NWTC_IO.f90 @@ -22,6 +22,7 @@ MODULE NWTC_IO USE SysSubs USE NWTC_Library_Types ! ProgDesc and other types with copy and other routines for those types + USE IEEE_ARITHMETIC IMPLICIT NONE @@ -152,6 +153,13 @@ MODULE NWTC_IO MODULE PROCEDURE ParseSiAry ! Parse an array of single-precision REAL values. END INTERFACE + !> \copydoc nwtc_io::checkr4var + INTERFACE CheckRealVar + MODULE PROCEDURE CheckR4Var ! 4-byte real + MODULE PROCEDURE CheckR8Var ! 8-byte real + MODULE PROCEDURE CheckR16Var ! 16-byte real + END INTERFACE + !> \copydoc nwtc_io::readcvar INTERFACE ReadVar MODULE PROCEDURE ReadCVar @@ -1526,6 +1534,8 @@ SUBROUTINE CheckArgs ( InputFile, ErrStat, Arg2, Flag ) CALL Conv2UC( Arg ) Flag = Arg(2:) !this results in only the last flag IF ( TRIM(Flag) == 'RESTART' ) CYCLE ! Get next argument (which will be input [checkpoint] file name) + IF ( TRIM(Flag) == 'VTKLIN' ) CYCLE ! Get next argument (which will be input [checkpoint] file name) + END IF CALL NWTC_DisplaySyntax( InputFile, ProgName ) @@ -1677,7 +1687,7 @@ SUBROUTINE ChkRealFmtStr ( RealFmt, RealFmtVar, FmtWidth, ErrStat, ErrMsg ) REAL, PARAMETER :: TestVal = -1.0 ! The value to test the format specifier with. INTEGER :: IOS ! An integer to store the I/O status of the attempted internal write. - INTEGER, PARAMETER :: TestStrLen = 20 ! A parameter for specifying the length of RealStr. + INTEGER, PARAMETER :: TestStrLen = 30 ! A parameter for specifying the length of RealStr. CHARACTER(TestStrLen) :: RealStr ! A string to test writing a real number to. @@ -1784,6 +1794,60 @@ SUBROUTINE CheckIOS ( IOS, Fil, Variable, VarType, ErrStat, ErrMsg, TrapErrors ) RETURN END SUBROUTINE CheckIOS !======================================================================= +!> This routine checks that real values are finite and not NaNs +SUBROUTINE CheckR4Var( RealVar, RealDesc, ErrStat, ErrMsg ) + + REAL(SiKi), INTENT(IN) :: RealVar !< Real value to check + CHARACTER(*),INTENT(IN) :: RealDesc !< description of RealVar + INTEGER, INTENT(OUT) :: ErrStat !< Error status + CHARACTER(*),INTENT(OUT) :: ErrMsg !< Error message + + IF (IEEE_IS_NAN(RealVar) .or. .not. IEEE_IS_FINITE( RealVar) ) THEN + ErrStat = ErrID_Fatal + ErrMsg = trim(RealDesc)//': value is not a finite real number.' + ELSE + ErrStat = ErrID_None + ErrMsg = "" + END IF + +END SUBROUTINE CheckR4Var +!======================================================================= +!> \copydoc nwtc_io::checkr4var +SUBROUTINE CheckR8Var( RealVar, RealDesc, ErrStat, ErrMsg ) + + REAL(R8Ki), INTENT(IN) :: RealVar !< Real value to check + CHARACTER(*),INTENT(IN) :: RealDesc !< description of RealVar + INTEGER, INTENT(OUT) :: ErrStat !< Error status + CHARACTER(*),INTENT(OUT) :: ErrMsg !< Error message + + IF (IEEE_IS_NAN(RealVar) .or. .not. IEEE_IS_FINITE( RealVar) ) THEN + ErrStat = ErrID_Fatal + ErrMsg = trim(RealDesc)//': value is not a finite real number.' + ELSE + ErrStat = ErrID_None + ErrMsg = "" + END IF + +END SUBROUTINE CheckR8Var +!======================================================================= +!> \copydoc nwtc_io::checkr4var +SUBROUTINE CheckR16Var( RealVar, RealDesc, ErrStat, ErrMsg ) + + REAL(QuKi), INTENT(IN) :: RealVar !< Real value to check + CHARACTER(*),INTENT(IN) :: RealDesc !< description of RealVar + INTEGER, INTENT(OUT) :: ErrStat !< Error status + CHARACTER(*),INTENT(OUT) :: ErrMsg !< Error message + + IF (IEEE_IS_NAN(RealVar) .or. .not. IEEE_IS_FINITE( RealVar) ) THEN + ErrStat = ErrID_Fatal + ErrMsg = trim(RealDesc)//': value is not a finite real number.' + ELSE + ErrStat = ErrID_None + ErrMsg = "" + END IF + +END SUBROUTINE CheckR16Var +!======================================================================= !> This routine converts all the text in a string to upper case. SUBROUTINE Conv2UC ( Str ) @@ -2307,12 +2371,13 @@ END FUNCTION GetNVD !======================================================================= !> Let's parse the path name from the name of the given file. !! We'll count everything before (and including) the last "\" or "/". - SUBROUTINE GetPath ( GivenFil, PathName ) + SUBROUTINE GetPath ( GivenFil, PathName, FileName ) ! Argument declarations. - CHARACTER(*), INTENT(IN) :: GivenFil !< The name of the given file. - CHARACTER(*), INTENT(OUT) :: PathName !< The path name of the given file (based solely on the GivenFil text string). + CHARACTER(*), INTENT(IN) :: GivenFil !< The name of the given file. + CHARACTER(*), INTENT(OUT) :: PathName !< The path name of the given file (based solely on the GivenFil text string). + CHARACTER(*), INTENT(OUT), OPTIONAL :: FileName !< The name of the given file without the PathName (based solely on the GivenFil text string). ! Local declarations. @@ -2328,8 +2393,16 @@ SUBROUTINE GetPath ( GivenFil, PathName ) IF ( I == 0 ) THEN ! we don't have a path specified, return '.' PathName = '.'//PathSep + IF (PRESENT(FileName)) FileName = GivenFil ELSE PathName = GivenFil(:I) + IF (PRESENT(FileName)) THEN + IF ( LEN_TRIM(GivenFil) > I ) THEN + FileName = GivenFil(I+1:) + ELSE + FileName = "" + END IF + END IF END IF @@ -2571,6 +2644,22 @@ FUNCTION Int2LStr ( Num ) RETURN END FUNCTION Int2LStr !======================================================================= +!> This function returns true if and only if the first character of the input StringToCheck matches on the of comment characters +!! nwtc_io::commchars. + FUNCTION IsComment(StringToCheck) + ! Note: only the first character in the word is checked. Otherwise we would falsely grab the units '(%)' + LOGICAL :: IsComment + CHARACTER(*), INTENT(IN ) :: StringToCheck ! String to check + + + if ( LEN_TRIM(StringToCheck) > 0 ) then + ISComment = INDEX( CommChars, StringToCheck(1:1) ) > 0 + else + IsComment = .FALSE. + end if + + END FUNCTION IsComment +!======================================================================= !> This routine gets the name of the input file from the InArgth command-line argument, !! removes the extension if there is one, and appends OutExten to the end. SUBROUTINE NameOFile ( InArg, OutExten, OutFile, ErrStat, ErrMsg ) @@ -2971,6 +3060,7 @@ SUBROUTINE OpenFUnkFileAppend ( Un, OutFile, ErrStat, ErrMsg ) RETURN END SUBROUTINE OpenFUnkFileAppend ! ( Un, OutFile [, ErrStat] [, ErrMsg] ) +!======================================================================= !> This routine opens an unformatted input file of RecLen-byte data records !! stored in Big Endian format. SUBROUTINE OpenUInBEFile( Un, InFile, RecLen, ErrStat, ErrMsg ) @@ -3248,8 +3338,8 @@ SUBROUTINE ParseDbAry ( FileInfo, LineNum, AryName, Ary, AryLen, ErrStat, ErrMsg ! Local declarations. INTEGER(IntKi) :: ErrStatLcl ! Error status local to this routine. + INTEGER(IntKi) :: i ! Error status local to this routine. - CHARACTER(20), ALLOCATABLE :: Words (:) ! The array "words" parsed from the line. CHARACTER(*), PARAMETER :: RoutineName = 'ParseDbAry' @@ -3264,14 +3354,6 @@ SUBROUTINE ParseDbAry ( FileInfo, LineNum, AryName, Ary, AryLen, ErrStat, ErrMsg END IF - ALLOCATE ( Words( AryLen ) , STAT=ErrStatLcl ) - IF ( ErrStatLcl /= 0 ) THEN - CALL SetErrStat ( ErrID_Fatal, 'Fatal error allocating memory for the Words array.',ErrStat,ErrMsg,RoutineName ) - CALL Cleanup() - RETURN - ENDIF - - READ (FileInfo%Lines(LineNum),*,IOSTAT=ErrStatLcl) Ary IF ( ErrStatLcl /= 0 ) THEN CALL SetErrStat ( ErrID_Fatal, 'A fatal error occurred when parsing data from "' & @@ -3280,34 +3362,22 @@ SUBROUTINE ParseDbAry ( FileInfo, LineNum, AryName, Ary, AryLen, ErrStat, ErrMsg //TRIM( Num2LStr( FileInfo%FileLine(LineNum) ) )//'.'//NewLine//' >> The text being parsed was :'//NewLine & //' "'//TRIM( FileInfo%Lines(LineNum) )//'"',ErrStat,ErrMsg,RoutineName ) RETURN - CALL Cleanup() ENDIF + + DO i=1,AryLen + call CheckRealVar( Ary(i), AryName, ErrStat, ErrMsg ) + if (ErrStat>= AbortErrLev) return + END DO + IF ( PRESENT(UnEc) ) THEN IF ( UnEc > 0 ) WRITE (UnEc,'(A)') TRIM( FileInfo%Lines(LineNum) ) END IF LineNum = LineNum + 1 - CALL Cleanup() RETURN - !======================================================================= - CONTAINS - !======================================================================= - SUBROUTINE Cleanup ( ) - - ! This subroutine cleans up the parent routine before exiting. - - ! Deallocate the Words array if it had been allocated. - - IF ( ALLOCATED( Words ) ) DEALLOCATE( Words ) - - - RETURN - - END SUBROUTINE Cleanup - END SUBROUTINE ParseDbAry !======================================================================= !> \copydoc nwtc_io::parsechvar @@ -3365,7 +3435,9 @@ SUBROUTINE ParseDbVar ( FileInfo, LineNum, ExpVarName, Var, ErrStat, ErrMsg, UnE NewLine//' "'//TRIM( FileInfo%Lines(LineNum) )//'"', ErrStat, ErrMsg, RoutineName) RETURN ENDIF - + CALL CheckRealVar( Var, ExpVarName, ErrStatLcl, ErrMsg2) + CALL SetErrStat(ErrStatLcl, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF ( PRESENT(UnEc) ) THEN IF ( UnEc > 0 ) WRITE (UnEc,'(1X,A15," = ",A20)') Words END IF @@ -3977,8 +4049,8 @@ SUBROUTINE ParseSiAry ( FileInfo, LineNum, AryName, Ary, AryLen, ErrStat, ErrMsg ! Local declarations. INTEGER(IntKi) :: ErrStatLcl ! Error status local to this routine. + INTEGER(IntKi) :: i - CHARACTER(20), ALLOCATABLE :: Words (:) ! The array "words" parsed from the line. CHARACTER(*), PARAMETER :: RoutineName = 'ParseSiAry' ErrStat = ErrID_None @@ -3991,14 +4063,6 @@ SUBROUTINE ParseSiAry ( FileInfo, LineNum, AryName, Ary, AryLen, ErrStat, ErrMsg RETURN END IF - ALLOCATE ( Words( AryLen ) , STAT=ErrStatLcl ) - IF ( ErrStatLcl /= 0 ) THEN - CALL SetErrStat ( ErrID_Fatal, 'Fatal error allocating memory for the Words array.', ErrStat, ErrMsg, RoutineName ) - CALL Cleanup() - RETURN - ENDIF - - READ (FileInfo%Lines(LineNum),*,IOSTAT=ErrStatLcl) Ary IF ( ErrStatLcl /= 0 ) THEN CALL SetErrStat ( ErrID_Fatal, NewLine//' >> A fatal error occurred when parsing data from "' & @@ -4006,7 +4070,6 @@ SUBROUTINE ParseSiAry ( FileInfo, LineNum, AryName, Ary, AryLen, ErrStat, ErrMsg ' >> The "'//TRIM( AryName )//'" array was not assigned valid REAL values on line #' & //TRIM( Num2LStr( FileInfo%FileLine(LineNum) ) )//'.'//NewLine//' >> The text being parsed was :'//NewLine & //' "'//TRIM( FileInfo%Lines(LineNum) )//'"', ErrStat, ErrMsg, RoutineName ) - CALL Cleanup() RETURN ENDIF @@ -4014,27 +4077,15 @@ SUBROUTINE ParseSiAry ( FileInfo, LineNum, AryName, Ary, AryLen, ErrStat, ErrMsg IF ( UnEc > 0 ) WRITE (UnEc,'(A)') TRIM( FileInfo%Lines(LineNum) ) END IF + DO i=1,AryLen + call CheckRealVar( Ary(i), AryName, ErrStat, ErrMsg ) + if (ErrStat>= AbortErrLev) return + END DO + LineNum = LineNum + 1 - CALL Cleanup ( ) - RETURN - !======================================================================= - CONTAINS - !======================================================================= - SUBROUTINE Cleanup ( ) - - ! This subroutine cleans up the parent routine before exiting. - - ! Deallocate the Words array if it had been allocated. - - IF ( ALLOCATED( Words ) ) DEALLOCATE( Words ) - - RETURN - - END SUBROUTINE Cleanup - END SUBROUTINE ParseSiAry !======================================================================= !> \copydoc nwtc_io::parsechvar @@ -4092,6 +4143,8 @@ SUBROUTINE ParseSiVar ( FileInfo, LineNum, ExpVarName, Var, ErrStat, ErrMsg, UnE RETURN ENDIF + CALL CheckRealVar( Var, ExpVarName, ErrStat, ErrMsg) + IF ( PRESENT(UnEc) ) THEN IF ( UnEc > 0 ) WRITE (UnEc,'(1X,A15," = ",A20)') Words END IF @@ -5509,7 +5562,7 @@ END SUBROUTINE ReadLAry !============================================================================= !> This routine reads a line from the specified input file and returns the non-comment !! portion of the line. - SUBROUTINE ReadLine ( UnIn, CommChars, Line, LineLen, IOStat ) + SUBROUTINE ReadLine ( UnIn, CommentChars, Line, LineLen, IOStat ) ! Argument declarations. @@ -5518,7 +5571,7 @@ SUBROUTINE ReadLine ( UnIn, CommChars, Line, LineLen, IOStat ) INTEGER, INTENT(IN) :: UnIn !< The unit number for the file being read. INTEGER, INTENT(OUT) :: LineLen !< The length of the line returned from ReadLine(). - CHARACTER(*), INTENT(IN) :: CommChars !< The list of possible comment characters. + CHARACTER(*), INTENT(IN) :: CommentChars !< The list of possible comment characters. CHARACTER(*), INTENT(OUT) :: Line !< The decommented line being returned to the calling routine. ! Local declarations. @@ -5526,7 +5579,7 @@ SUBROUTINE ReadLine ( UnIn, CommChars, Line, LineLen, IOStat ) INTEGER :: CommLoc ! The left-most location of a given comment character in the Line. INTEGER :: FirstComm ! The location of first comment character in the Line. INTEGER :: IC ! The index for the character location in the string. - INTEGER :: NumCommChars ! The number of comment characters in the CommChars array. + INTEGER :: NumCommChars ! The number of comment characters in the CommentChars array. READ (UnIn,'(A)',IOSTAT=IOStat) Line @@ -5538,14 +5591,14 @@ SUBROUTINE ReadLine ( UnIn, CommChars, Line, LineLen, IOStat ) ENDIF LineLen = LEN_TRIM( Line ) - NumCommChars = LEN_TRIM( CommChars ) + NumCommChars = LEN_TRIM( CommentChars ) IF ( ( NumCommChars == 0 ) .OR. ( LineLen == 0 ) ) RETURN FirstComm = MIN( LEN( Line ), LineLen + 1 ) DO IC=1,NumCommChars - CommLoc = INDEX( Line, CommChars(IC:IC) ) + CommLoc = INDEX( Line, CommentChars(IC:IC) ) IF ( CommLoc > 0 ) THEN FirstComm = MIN( CommLoc, FirstComm ) ENDIF @@ -5757,8 +5810,12 @@ SUBROUTINE ReadR4Ary ( UnIn, Fil, Ary, AryLen, AryName, AryDescr, ErrStat, ErrMs READ (UnIn,*,IOSTAT=IOS) ( Ary(Ind), Ind=1,AryLen ) CALL CheckIOS ( IOS, Fil, TRIM( AryName ), NumType, ErrStat, ErrMsg ) + IF (ErrStat >= AbortErrLev) RETURN - IF (ErrStat >= AbortErrLev) RETURN + DO Ind=1,AryLen + CALL CheckRealVar( Ary(Ind), AryName, ErrStat, ErrMsg) + IF (ErrStat >= AbortErrLev) RETURN + END DO IF ( PRESENT(UnEc) ) THEN IF ( UnEc > 0 ) THEN @@ -5807,6 +5864,11 @@ SUBROUTINE ReadR8Ary ( UnIn, Fil, Ary, AryLen, AryName, AryDescr, ErrStat, ErrMs IF (ErrStat >= AbortErrLev) RETURN + DO Ind=1,AryLen + CALL CheckRealVar( Ary(Ind), AryName, ErrStat, ErrMsg) + IF (ErrStat >= AbortErrLev) RETURN + END DO + IF ( PRESENT(UnEc) ) THEN IF ( UnEc > 0 ) THEN WRITE( UnEc, Ec_ReAryFrmt ) TRIM( AryName ), AryDescr, Ary(1:MIN(AryLen,NWTC_MaxAryLen)) @@ -5853,6 +5915,11 @@ SUBROUTINE ReadR16Ary ( UnIn, Fil, Ary, AryLen, AryName, AryDescr, ErrStat, ErrM IF (ErrStat >= AbortErrLev) RETURN + DO Ind=1,AryLen + CALL CheckRealVar( Ary(Ind), AryName, ErrStat, ErrMsg) + IF (ErrStat >= AbortErrLev) RETURN + END DO + IF ( PRESENT(UnEc) ) THEN IF ( UnEc > 0 ) THEN WRITE( UnEc, Ec_ReAryFrmt ) TRIM( AryName ), AryDescr, Ary(1:MIN(AryLen,NWTC_MaxAryLen)) @@ -5895,8 +5962,9 @@ SUBROUTINE ReadR4AryLines ( UnIn, Fil, Ary, AryLen, AryName, AryDescr, ErrStat, READ (UnIn,*,IOSTAT=IOS) Ary(Ind) CALL CheckIOS ( IOS, Fil, TRIM( AryName )//'('//TRIM( Num2LStr( Ind ) )//')', NumType, ErrStat, ErrMsg ) - - IF (ErrStat >= AbortErrLev) RETURN + IF (ErrStat >= AbortErrLev) RETURN + CALL CheckRealVar( Ary(Ind), AryName, ErrStat, ErrMsg) + IF (ErrStat >= AbortErrLev) RETURN IF ( PRESENT(UnEc) ) THEN IF ( UnEc > 0 ) & @@ -5943,8 +6011,9 @@ SUBROUTINE ReadR8AryLines ( UnIn, Fil, Ary, AryLen, AryName, AryDescr, ErrStat, READ (UnIn,*,IOSTAT=IOS) Ary(Ind) CALL CheckIOS ( IOS, Fil, TRIM( AryName )//'('//TRIM( Num2LStr( Ind ) )//')', NumType, ErrStat, ErrMsg ) - - IF (ErrStat >= AbortErrLev) RETURN + IF (ErrStat >= AbortErrLev) RETURN + CALL CheckRealVar( Ary(Ind), AryName, ErrStat, ErrMsg) + IF (ErrStat >= AbortErrLev) RETURN IF ( PRESENT(UnEc) ) THEN IF ( UnEc > 0 ) & @@ -5991,8 +6060,9 @@ SUBROUTINE ReadR16AryLines ( UnIn, Fil, Ary, AryLen, AryName, AryDescr, ErrStat, READ (UnIn,*,IOSTAT=IOS) Ary(Ind) CALL CheckIOS ( IOS, Fil, TRIM( AryName )//'('//TRIM( Num2LStr( Ind ) )//')', NumType, ErrStat, ErrMsg ) - - IF (ErrStat >= AbortErrLev) RETURN + IF (ErrStat >= AbortErrLev) RETURN + CALL CheckRealVar( Ary(Ind), AryName, ErrStat, ErrMsg) + IF (ErrStat >= AbortErrLev) RETURN IF ( PRESENT(UnEc) ) THEN IF ( UnEc > 0 ) & @@ -6040,8 +6110,9 @@ SUBROUTINE ReadR4Var ( UnIn, Fil, Var, VarName, VarDescr, ErrStat, ErrMsg, UnEc READ (Word,*,IOSTAT=IOS) Var CALL CheckIOS ( IOS, Fil, VarName, NumType, ErrStat, ErrMsg ) - - IF (ErrStat >= AbortErrLev) RETURN + IF (ErrStat >= AbortErrLev) RETURN + CALL CheckRealVar( Var, VarName, ErrStat, ErrMsg) + IF (ErrStat >= AbortErrLev) RETURN IF ( PRESENT(UnEc) ) THEN @@ -6086,8 +6157,9 @@ SUBROUTINE ReadR4VarWDefault ( UnIn, Fil, Var, VarName, VarDescr, VarDefault, Er READ (Word,*,IOSTAT=IOS) Var CALL CheckIOS ( IOS, Fil, VarName, NumType, ErrStat, ErrMsg ) - - IF (ErrStat >= AbortErrLev) RETURN + IF (ErrStat >= AbortErrLev) RETURN + CALL CheckRealVar( Var, VarName, ErrStat, ErrMsg) + IF (ErrStat >= AbortErrLev) RETURN ELSE Var = VarDefault END IF @@ -6133,9 +6205,9 @@ SUBROUTINE ReadR8Var ( UnIn, Fil, Var, VarName, VarDescr, ErrStat, ErrMsg, UnEc READ (Word,*,IOSTAT=IOS) Var CALL CheckIOS ( IOS, Fil, VarName, NumType, ErrStat, ErrMsg ) - - - IF (ErrStat >= AbortErrLev) RETURN + IF (ErrStat >= AbortErrLev) RETURN + CALL CheckRealVar( Var, VarName, ErrStat, ErrMsg) + IF (ErrStat >= AbortErrLev) RETURN IF ( PRESENT(UnEc) ) THEN IF ( UnEc > 0 ) & @@ -6180,8 +6252,9 @@ SUBROUTINE ReadR8VarWDefault ( UnIn, Fil, Var, VarName, VarDescr, VarDefault, Er READ (Word,*,IOSTAT=IOS) Var CALL CheckIOS ( IOS, Fil, VarName, NumType, ErrStat, ErrMsg ) - - IF (ErrStat >= AbortErrLev) RETURN + IF (ErrStat >= AbortErrLev) RETURN + CALL CheckRealVar( Var, VarName, ErrStat, ErrMsg) + IF (ErrStat >= AbortErrLev) RETURN ELSE Var = VarDefault END IF @@ -6233,9 +6306,9 @@ SUBROUTINE ReadR16Var ( UnIn, Fil, Var, VarName, VarDescr, ErrStat, ErrMsg, UnEc READ (Word,*,IOSTAT=IOS) Var CALL CheckIOS ( IOS, Fil, VarName, NumType, ErrStat, ErrMsg ) - - - IF (ErrStat >= AbortErrLev) RETURN + IF (ErrStat >= AbortErrLev) RETURN + CALL CheckRealVar( Var, VarName, ErrStat, ErrMsg) + IF (ErrStat >= AbortErrLev) RETURN IF ( PRESENT(UnEc) ) THEN IF ( UnEc > 0 ) & @@ -6280,8 +6353,9 @@ SUBROUTINE ReadR16VarWDefault ( UnIn, Fil, Var, VarName, VarDescr, VarDefault, E READ (Word,*,IOSTAT=IOS) Var CALL CheckIOS ( IOS, Fil, VarName, NumType, ErrStat, ErrMsg ) - - IF (ErrStat >= AbortErrLev) RETURN + IF (ErrStat >= AbortErrLev) RETURN + CALL CheckRealVar( Var, VarName, ErrStat, ErrMsg) + IF (ErrStat >= AbortErrLev) RETURN ELSE Var = VarDefault END IF @@ -6383,8 +6457,6 @@ RECURSIVE SUBROUTINE ScanComFile ( FirstFile, ThisFile, LastFile, StartLine, Las LOGICAL :: FileFound ! A flag that is set to TRUE if this file has already been read. LOGICAL :: IsOpen ! A flag that is set to TRUE if this file is already open. -! Should the comment characters be passed to this routine instead of being hard coded? -mlb - CHARACTER(3), PARAMETER :: CommChars = '!#%' ! Comment characters that mark the end of useful input. CHARACTER(1024) :: FileName ! The name of this file being processed. CHARACTER(1024) :: IncFileName ! The name of a file that this one includes. CHARACTER(512) :: Line ! The contents of a line returned from ReadLine() with comment removed. @@ -6647,7 +6719,6 @@ SUBROUTINE WrBinFAST(FileName, FileID, DescStr, ChanName, ChanUnit, TimeData, Al IMPLICIT NONE INTEGER(IntKi), PARAMETER :: LenName = ChanLen ! Number of characters allowed in a channel name - INTEGER(IntKi), PARAMETER :: LenUnit = ChanLen ! Number of characters allowed in a channel unit ! Passed data (sorted by element size, then alphabetical) @@ -6657,7 +6728,7 @@ SUBROUTINE WrBinFAST(FileName, FileID, DescStr, ChanName, ChanUnit, TimeData, Al INTEGER(B2Ki), INTENT(IN) :: FileID !< File ID, used to determine format of output file (use FileFmtID_WithTime or FileFmtID_WithoutTime) CHARACTER(LenName),INTENT(IN) :: ChanName(:) !< The output channel names (including Time) - CHARACTER(LenUnit),INTENT(IN) :: ChanUnit(:) !< The output channel units (including Time) + CHARACTER(LenName),INTENT(IN) :: ChanUnit(:) !< The output channel units (including Time) CHARACTER(*), INTENT(IN) :: DescStr !< Description to write to the binary file (e.g., program version, date, & time) CHARACTER(*), INTENT(OUT):: ErrMsg !< Error message associated with the ErrStat CHARACTER(*), INTENT(IN) :: FileName !< Name of the file to write the output in @@ -6742,7 +6813,7 @@ SUBROUTINE WrBinFAST(FileName, FileID, DescStr, ChanName, ChanUnit, TimeData, Al CALL AllocAry( ChanNameASCII, (1+NumOutChans)*LenName , 'temporary channel name array (ChanNameASCII)', ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AllocAry( ChanUnitASCII, (1+NumOutChans)*LenUnit, 'temporary channel unit names (ChanUnitASCII)', ErrStat2, ErrMsg2 ) + CALL AllocAry( ChanUnitASCII, (1+NumOutChans)*LenName, 'temporary channel unit names (ChanUnitASCII)', ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL AllocAry( DescStrASCII, LenDesc, 'temporary file description (DescStrASCII)', ErrStat2, ErrMsg2 ) @@ -6803,7 +6874,7 @@ SUBROUTINE WrBinFAST(FileName, FileID, DescStr, ChanName, ChanUnit, TimeData, Al ! Channel units (ChanUnit) J = 1 DO IC = 1,SIZE(ChanUnit) - DO I=1,LenUnit + DO I=1,LenName ChanUnitASCII(J) = IACHAR( ChanUnit(IC)(I:I) ) J = J + 1 END DO @@ -7866,7 +7937,10 @@ SUBROUTINE ReadVTK_SP_info( FileName, descr, dims, origin, gridSpacing, vecLabel ELSE sz = len(Line) Line = Line(12:sz) - READ(Line,*) dims + READ(Line,*, IOSTAT=ErrStat2) dims + if (ErrStat2 /= 0) then + CALL SetErrStat( ErrID_Fatal, 'Error reading "dims".', ErrStat, ErrMsg, RoutineName ) + end if END IF ! Origin @@ -7881,7 +7955,11 @@ SUBROUTINE ReadVTK_SP_info( FileName, descr, dims, origin, gridSpacing, vecLabel ELSE sz = len(Line) Line = Line(8:sz) - READ(Line,*) origin + READ(Line,*, IOSTAT=ErrStat2) origin + if (ErrStat2 /= 0) then + CALL SetErrStat( ErrID_Fatal, 'Error reading "origin".', ErrStat, ErrMsg, RoutineName ) + end if + END IF ! Spacing @@ -7896,7 +7974,11 @@ SUBROUTINE ReadVTK_SP_info( FileName, descr, dims, origin, gridSpacing, vecLabel ELSE sz = len(Line) Line = Line(9:sz) - READ(Line,*) gridSpacing + READ(Line,*,IOSTAT=ErrStat2) gridSpacing + if (ErrStat2 /= 0) then + CALL SetErrStat( ErrID_Fatal, 'Error reading "gridSpacing".', ErrStat, ErrMsg, RoutineName ) + end if + END IF ! Point Data @@ -7911,7 +7993,10 @@ SUBROUTINE ReadVTK_SP_info( FileName, descr, dims, origin, gridSpacing, vecLabel ELSE sz = len(Line) Line = Line(12:sz) - READ(Line,*) nPts + READ(Line,*,IOSTAT=ErrStat2) nPts + if (ErrStat2 /= 0) then + CALL SetErrStat( ErrID_Fatal, 'Error reading "nPts".', ErrStat, ErrMsg, RoutineName ) + end if END IF ! Vector Label @@ -7946,23 +8031,24 @@ END SUBROUTINE ReadVTK_SP_info !> This routine reads the vector data for a vtk, ascii, structured_points dataset file, !! The Unit number of the file is already assumed to be valid via a previous call to !! ReadVTK_SP_info. - SUBROUTINE ReadVTK_SP_vectors( FileName, Un, dims, gridVals, ErrStat, ErrMsg ) + SUBROUTINE ReadVTK_SP_vectors( Un, dims, gridVals, ErrStat, ErrMsg ) - CHARACTER(*) , INTENT(IN ) :: FileName !< Name of output file INTEGER(IntKi) , INTENT(IN ) :: Un !< unit number of opened file INTEGER(IntKi) , INTENT(IN ) :: dims(3) !< dimension of the 3D grid (nX,nY,nZ) - REAL(ReKi) , INTENT( OUT) :: gridVals(:,:,:,:) !< 3D array of data, size (nX,nY,nZ), must be pre-allocated + REAL(ReKi) , INTENT( OUT) :: gridVals(:,:,:,:) !< 4D array of data, size (3,nX,nY,nZ), must be pre-allocated INTEGER(IntKi) , INTENT( OUT) :: ErrStat !< error level/status of OpenFOutFile operation CHARACTER(*) , INTENT( OUT) :: ErrMsg !< message when error occurs INTEGER(IntKi) :: ErrStat2 ! local error level/status of OpenFOutFile operation - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local message when error occurs CHARACTER(*), PARAMETER :: RoutineName = 'ReadVTK_SP_vectors' ErrStat = ErrID_None ErrMsg = '' - READ(Un,*) gridVals(1:3,1:dims(1),1:dims(2),1:dims(3)) + READ(Un,*, IOSTAT=ErrStat2) gridVals(1:3,1:dims(1),1:dims(2),1:dims(3)) + if (ErrStat2 /= 0) then + CALL SetErrStat( ErrID_Fatal, 'Error reading vector data.', ErrStat, ErrMsg, RoutineName ) + end if close(Un) diff --git a/modules/nwtc-library/src/NWTC_Num.f90 b/modules/nwtc-library/src/NWTC_Num.f90 index 836fc56e4f..0e18f8838e 100644 --- a/modules/nwtc-library/src/NWTC_Num.f90 +++ b/modules/nwtc-library/src/NWTC_Num.f90 @@ -55,6 +55,13 @@ MODULE NWTC_Num REAL(ReKi) :: TwoByPi !< 2/Pi REAL(ReKi) :: TwoPi !< 2*Pi + REAL(SiKi) :: Pi_R4 !< Ratio of a circle's circumference to its diameter in 4-byte precision + REAL(R8Ki) :: Pi_R8 !< Ratio of a circle's circumference to its diameter in 8-byte precision + REAL(QuKi) :: Pi_R16 !< Ratio of a circle's circumference to its diameter in 16-byte precision + + REAL(SiKi) :: TwoPi_R4 !< 2*pi in 4-byte precision + REAL(R8Ki) :: TwoPi_R8 !< 2*pi in 8-byte precision + REAL(QuKi) :: TwoPi_R16 !< 2*pi in 16-byte precision !======================================================================= ! Create interfaces for generic routines that use specific routines. @@ -109,10 +116,11 @@ MODULE NWTC_Num MODULE PROCEDURE GetSmllRotAngsR END INTERFACE - !> \copydoc nwtc_num::zero2twopir + !> \copydoc nwtc_num::zero2twopir4 INTERFACE Zero2TwoPi - MODULE PROCEDURE Zero2TwoPiD - MODULE PROCEDURE Zero2TwoPiR + MODULE PROCEDURE Zero2TwoPiR4 + MODULE PROCEDURE Zero2TwoPiR8 + MODULE PROCEDURE Zero2TwoPiR16 END INTERFACE !> \copydoc nwtc_num::twonormr4 @@ -194,57 +202,131 @@ MODULE NWTC_Num MODULE PROCEDURE SkewSymMatR16 END INTERFACE + !> \copydoc nwtc_num::angle_extrapinterp2_r4 + INTERFACE Angles_ExtrapInterp + MODULE PROCEDURE Angles_ExtrapInterp1_R4 + MODULE PROCEDURE Angles_ExtrapInterp1_R8 + MODULE PROCEDURE Angles_ExtrapInterp1_R16 + MODULE PROCEDURE Angles_ExtrapInterp2_R4 + MODULE PROCEDURE Angles_ExtrapInterp2_R8 + MODULE PROCEDURE Angles_ExtrapInterp2_R16 + END INTERFACE + !> \copydoc nwtc_num::addorsub2pi_r4 + INTERFACE AddOrSub2Pi + MODULE PROCEDURE AddOrSub2Pi_R4 + MODULE PROCEDURE AddOrSub2Pi_R8 + MODULE PROCEDURE AddOrSub2Pi_R16 + END INTERFACE + + !> \copydoc nwtc_num::mpi2pi_r4 + INTERFACE MPi2Pi + MODULE PROCEDURE MPi2Pi_R4 + MODULE PROCEDURE MPi2Pi_R8 + MODULE PROCEDURE MPi2Pi_R16 + END INTERFACE + CONTAINS !======================================================================= -!> This routine is used to convert NewAngle to an angle within 2*Pi of -!! OldAngle by adding or subtracting 2*Pi accordingly; it then sets -!! OldAngle equal to NewAngle. This routine is useful for converting +!> This routine is used to convert NewAngle to an angle within Pi of +!! OldAngle by adding or subtracting 2*Pi accordingly. +!! This routine is useful for converting !! angles returned from a call to the ATAN2() FUNCTION into angles that may !! exceed the -Pi to Pi limit of ATAN2(). For example, if the nacelle yaw !! angle was 179deg in the previous time step and the yaw angle increased !! by 2deg in the new time step, we want the new yaw angle returned from a !! call to the ATAN2() FUNCTION to be 181deg instead of -179deg. This !! routine assumes that the angle change between calls is not more than -!! 2*Pi in absolute value. OldAngle should be saved in the calling -!! routine. - SUBROUTINE AddOrSub2Pi ( OldAngle, NewAngle ) +!! Pi in absolute value. +!! Use AddOrSub2Pi (nwtc_num::addorsub2pi) instead of directly calling a specific routine in the generic interface. + SUBROUTINE AddOrSub2Pi_R4 ( OldAngle, NewAngle ) + ! Argument declarations: + + REAL(SiKi), INTENT(IN ) :: OldAngle !< Angle from which NewAngle will be converted to within Pi of, rad. + REAL(SiKi), INTENT(INOUT) :: NewAngle !< Angle to be converted to within 2*Pi of OldAngle, rad. + + + ! Local declarations: + + REAL(SiKi) :: DelAngle ! The difference between OldAngle and NewAngle, rad. + + + + ! Add or subtract 2*Pi in order to convert NewAngle two within Pi of OldAngle: + + + DelAngle = OldAngle - NewAngle + + DO WHILE ( ABS( DelAngle ) >= Pi_R4 ) + + NewAngle = NewAngle + SIGN( TwoPi_R4, DelAngle ) + DelAngle = OldAngle - NewAngle + + END DO + + RETURN + END SUBROUTINE AddOrSub2Pi_R4 +!======================================================================= +!> \copydoc nwtc_num::addorsub2pi_r4 + SUBROUTINE AddOrSub2Pi_R8 ( OldAngle, NewAngle ) ! Argument declarations: - REAL(ReKi), INTENT(INOUT) :: OldAngle !< Angle from which NewAngle will be converted to within 2*Pi of, rad. - REAL(ReKi), INTENT(INOUT) :: NewAngle !< Angle to be converted to within 2*Pi of OldAngle, rad. + REAL(R8Ki), INTENT(IN ) :: OldAngle ! Angle from which NewAngle will be converted to within Pi of, rad. + REAL(R8Ki), INTENT(INOUT) :: NewAngle ! Angle to be converted to within Pi of OldAngle, rad. ! Local declarations: - REAL(ReKi) :: DelAngle ! The difference between OldAngle and NewAngle, rad. + REAL(R8Ki) :: DelAngle ! The difference between OldAngle and NewAngle, rad. - ! Add or subtract 2*Pi in order to convert NewAngle two within 2*Pi of - ! OldAngle: + ! Add or subtract 2*Pi in order to convert NewAngle two within Pi of OldAngle: DelAngle = OldAngle - NewAngle - DO WHILE ( ABS( DelAngle ) >= TwoPi ) + DO WHILE ( ABS( DelAngle ) >= Pi_R8 ) - NewAngle = NewAngle + SIGN( TwoPi, DelAngle ) + NewAngle = NewAngle + SIGN( TwoPi_R8, DelAngle ) DelAngle = OldAngle - NewAngle END DO + RETURN + END SUBROUTINE AddOrSub2Pi_R8 +!======================================================================= +!> \copydoc nwtc_num::addorsub2pi_r4 + SUBROUTINE AddOrSub2Pi_R16 ( OldAngle, NewAngle ) - ! Set OldAngle to equal NewAngle: + ! Argument declarations: - OldAngle = NewAngle + REAL(QuKi), INTENT(IN ) :: OldAngle ! Angle from which NewAngle will be converted to within 2*Pi of, rad. + REAL(QuKi), INTENT(INOUT) :: NewAngle ! Angle to be converted to within 2*Pi of OldAngle, rad. + ! Local declarations: + + REAL(QuKi) :: DelAngle ! The difference between OldAngle and NewAngle, rad. + + + + ! Add or subtract 2*Pi in order to convert NewAngle two within Pi of OldAngle: + + + DelAngle = OldAngle - NewAngle + + DO WHILE ( ABS( DelAngle ) >= Pi_R16 ) + + NewAngle = NewAngle + SIGN( TwoPi_R16, DelAngle ) + DelAngle = OldAngle - NewAngle + + END DO RETURN - END SUBROUTINE AddOrSub2Pi + END SUBROUTINE AddOrSub2Pi_R16 !======================================================================= !> This routine sorts a list of real numbers. It uses the bubble sort algorithm, !! which is only suitable for short lists. @@ -3947,29 +4029,78 @@ END FUNCTION Mean ! ( Ary, AryLen ) !======================================================================= !> This routine is used to convert Angle to an equivalent value !! between \f$-\pi\f$ and \f$pi\f$. - SUBROUTINE MPi2Pi ( Angle ) +!! +!! Use MPi2Pi (nwtc_num::mpi2pi) instead of directly calling a specific routine in the generic interface. + SUBROUTINE MPi2Pi_R4 ( Angle ) + + + ! Argument declarations: + + REAL(SiKi), INTENT(INOUT) :: Angle !< Angle (in radians) to be converted + + + ! Get the angle between 0 and 2Pi. + + Angle = MODULO( Angle, TwoPi_R4 ) + + + ! Get the angle between -Pi and Pi. + + IF ( Angle > Pi_R4 ) THEN + Angle = Angle - TwoPi_R4 + END IF + + + RETURN + END SUBROUTINE MPi2Pi_R4 +!======================================================================= +!> \copydoc nwtc_num::mpi2pi_r4 + SUBROUTINE MPi2Pi_R8 ( Angle ) ! Argument declarations: - REAL(ReKi), INTENT(INOUT) :: Angle !< Angle (in radians) to be converted + REAL(R8Ki), INTENT(INOUT) :: Angle + + + ! Get the angle between 0 and 2Pi. + + Angle = MODULO( Angle, TwoPi_R8 ) + ! Get the angle between -Pi and Pi. + + IF ( Angle > Pi_R8 ) THEN + Angle = Angle - TwoPi_R8 + END IF + + + RETURN + END SUBROUTINE MPi2Pi_R8 +!======================================================================= +!> \copydoc nwtc_num::mpi2pi_r4 + SUBROUTINE MPi2Pi_R16 ( Angle ) + + + ! Argument declarations: + + REAL(QuKi), INTENT(INOUT) :: Angle + ! Get the angle between 0 and 2Pi. - Angle = MODULO( Angle, TwoPi ) + Angle = MODULO( Angle, TwoPi_R16 ) ! Get the angle between -Pi and Pi. - IF ( Angle > Pi ) THEN - Angle = Angle - TwoPi + IF ( Angle > Pi_R16 ) THEN + Angle = Angle - TwoPi_R16 END IF RETURN - END SUBROUTINE MPi2Pi + END SUBROUTINE MPi2Pi_R16 !======================================================================= !> This function takes an angle in radians and converts it to !! an angle in degrees in the range [-180,180] @@ -4066,7 +4197,7 @@ END FUNCTION OuterProductR16 !! a change in log map parameters. SUBROUTINE PerturbOrientationMatrix( Orientation, Perturbation, AngleDim ) REAL(R8Ki), INTENT(INOUT) :: Orientation(3,3) - REAL(R8Ki), INTENT(IN) :: Perturbation + REAL(R8Ki), INTENT(IN) :: Perturbation ! angle (radians) of the perturbation INTEGER, INTENT(IN) :: AngleDim ! Local variables @@ -4879,7 +5010,7 @@ END SUBROUTINE RombergInt !======================================================================= !> This routine displays a message that gives that status of the simulation and the predicted end time of day. !! It is intended to be used with SimStatus (nwtc_num::simstatus) and SimStatus_FirstTime (nwtc_num::simstatus_firsttime). - SUBROUTINE RunTimes( StrtTime, UsrTime1, SimStrtTime, UsrTime2, ZTime, UsrTime_out, DescStrIn ) + SUBROUTINE RunTimes( StrtTime, UsrTime1, SimStrtTime, UsrTime2, ZTime, UnSum, UsrTime_out, DescStrIn ) IMPLICIT NONE @@ -4890,6 +5021,7 @@ SUBROUTINE RunTimes( StrtTime, UsrTime1, SimStrtTime, UsrTime2, ZTime, UsrTime_o REAL(ReKi), INTENT(IN) :: UsrTime1 !< User CPU time for simulation initialization. REAL(ReKi), INTENT(IN) :: UsrTime2 !< User CPU time for simulation (without intialization) REAL(DbKi), INTENT(IN) :: ZTime !< The final simulation time (not necessarially TMax) + INTEGER(IntKi), INTENT(IN), OPTIONAL:: UnSum !< optional unit number of file. If present and > 0, REAL(ReKi), INTENT(OUT),OPTIONAL:: UsrTime_out !< User CPU time for entire run - optional value returned to calling routine CHARACTER(*), INTENT(IN), OPTIONAL :: DescStrIn !< optional additional string to print for SimStatus @@ -4965,6 +5097,19 @@ SUBROUTINE RunTimes( StrtTime, UsrTime1, SimStrtTime, UsrTime2, ZTime, UsrTime_o CALL WrScr ( ' Simulated Time: '//TRIM( Num2LStr( Factor*REAL( ZTime ) ) )//TRIM( TimePer ) ) CALL WrScr ( ' Time Ratio (Sim/CPU): '//TRIM( Num2LStr( TRatio ) ) ) + IF (PRESENT(UnSum)) THEN + IF (UnSum>0) THEN + WRITE( UnSum, '(//)' ) + WRITE( UnSum, '(A)') ' Total Real Time: '//TRIM( Num2LStr( Factor*ClckTime ) )//TRIM( TimePer ) + WRITE( UnSum, '(A)') ' Total CPU Time: '//TRIM( Num2LStr( Factor*UsrTime ) )//TRIM( TimePer ) + WRITE( UnSum, '(A)') ' Simulation CPU Time: '//TRIM( Num2LStr( Factor*UsrTimeSim ) )//TRIM( TimePer ) + WRITE( UnSum, '(A)') ' Simulated Time: '//TRIM( Num2LStr( Factor*REAL( ZTime ) ) )//TRIM( TimePer ) + WRITE( UnSum, '(A)') ' Time Ratio (Sim/CPU): '//TRIM( Num2LStr( TRatio ) ) + END IF + END IF + + + ENDIF IF (PRESENT(UsrTime_out)) UsrTime_out = UsrTime @@ -4975,8 +5120,8 @@ FUNCTION GetClockTime(StartClockTime, EndClockTime) ! return the number of seconds between StartClockTime and EndClockTime REAL :: GetClockTime ! Elapsed clock time for the simulation phase of the run. - INTEGER , INTENT(IN) :: StartClockTime (8) ! Start time of simulation (after initialization) - INTEGER , INTENT(IN) :: EndClockTime (8) ! Start time of simulation (after initialization) + INTEGER , INTENT(IN) :: StartClockTime (8) ! Start time of simulation (after initialization) + INTEGER , INTENT(IN) :: EndClockTime (8) ! Start time of simulation (after initialization) !bjj: This calculation will be wrong at certain times (e.g. if it's near midnight on the last day of the month), but to my knowledge, no one has complained... GetClockTime = 0.001*( EndClockTime(8) - StartClockTime(8) ) & ! Is the milliseconds of the second (range 0 to 999) - local time @@ -5054,7 +5199,14 @@ SUBROUTINE SetConstants( ) TwoPi = 2.0_ReKi*Pi Inv2Pi = 0.5_ReKi/Pi ! 1.0/TwoPi + Pi_R4 = ACOS( -1.0_SiKi ) + Pi_R8 = ACOS( -1.0_R8Ki ) + Pi_R16 = ACOS( -1.0_QuKi ) + TwoPi_R4 = Pi_R4 *2.0_SiKi + TwoPi_R8 = Pi_R8 *2.0_R8Ki + TwoPi_R16 = Pi_R16*2.0_QuKi + ! IEEE constants: CALL Set_IEEE_Constants( NaN_D, Inf_D, NaN, Inf ) @@ -5620,7 +5772,12 @@ SUBROUTINE SortUnion ( Ary1, N1, Ary2, N2, Ary, N ) END SUBROUTINE SortUnion ! ( Ary1, N1, Ary2, N2, Ary, N ) !======================================================================= !> This routine calculates the standard deviation of a population contained in Ary. - FUNCTION StdDevFn ( Ary, AryLen, Mean ) +!! +!! This can be calculated as either\n +!! \f$ \sqrt{ \frac{\sum_{i=1}^N \left(x_i -\bar{x}\right)^2 }{N-1} } \f$ \n +!! or \n +!! \f$ \sqrt{ \frac{\sum_{i=1}^N \left(x_i -\bar{x}\right)^2 }{N} } \f$ if `UseN` is true \n + FUNCTION StdDevFn ( Ary, AryLen, Mean, UseN ) ! Function declaration. @@ -5633,6 +5790,7 @@ FUNCTION StdDevFn ( Ary, AryLen, Mean ) REAL(ReKi), INTENT(IN) :: Ary (AryLen) !< Input array. REAL(ReKi), INTENT(IN) :: Mean !< The previously calculated mean of the array. + LOGICAL, OPTIONAL, INTENT(IN) :: UseN !< Use `N` insted of `N-1` in denomenator ! Local declarations. @@ -5640,8 +5798,17 @@ FUNCTION StdDevFn ( Ary, AryLen, Mean ) REAL(DbKi) :: Sum ! A temporary sum. INTEGER :: I ! The index into the array. + INTEGER :: Denom ! Denominator - + IF(PRESENT(UseN)) THEN + IF (UseN) THEN + Denom = AryLen + ELSE + Denom = AryLen-1 + ENDIF + ELSE + Denom = AryLen-1 + ENDIF Sum = 0.0_DbKi @@ -5649,7 +5816,7 @@ FUNCTION StdDevFn ( Ary, AryLen, Mean ) Sum = Sum + ( Ary(I) - Mean )**2 END DO ! I - StdDevFn = SQRT( Sum/( AryLen - 1 ) ) + StdDevFn = SQRT( Sum/( Denom ) ) RETURN @@ -5733,6 +5900,7 @@ FUNCTION SkewSymMatR16 ( x ) RESULT(M) RETURN END FUNCTION SkewSymMatR16 + !======================================================================= !> This routine takes an array of time values such as that returned from !! CALL DATE_AND_TIME ( Values=TimeAry ) @@ -5807,7 +5975,6 @@ FUNCTION traceR16(A) end do END FUNCTION traceR16 - !======================================================================= !> This function returns the \f$l_2\f$ (Euclidian) norm of a vector, !! \f$v = \left(v_1, v_2, \ldots ,v_n\right)\f$. The \f$l_2\f$-norm is defined as @@ -5858,30 +6025,58 @@ FUNCTION TwoNormR16(v) !> This routine is used to convert Angle to an equivalent value !! in the range \f$[0, 2\pi)\f$. \n !! Use Zero2TwoPi (nwtc_num::zero2twopi) instead of directly calling a specific routine in the generic interface. - SUBROUTINE Zero2TwoPiR ( Angle ) + SUBROUTINE Zero2TwoPiR4 ( Angle ) ! Argument declarations: - REAL(ReKi), INTENT(INOUT) :: Angle !< angle that is input and converted to equivalent in range \f$[0, 2\pi)\f$ + REAL(SiKi), INTENT(INOUT) :: Angle !< angle that is input and converted to equivalent in range \f$[0, 2\pi)\f$ ! Get the angle between 0 and 2Pi. - Angle = MODULO( Angle, TwoPi ) + Angle = MODULO( Angle, TwoPi_R4 ) ! Check numerical case where Angle == 2Pi. - IF ( Angle == TwoPi ) THEN + IF ( Angle == TwoPi_R4 ) THEN Angle = 0.0_ReKi END IF RETURN - END SUBROUTINE Zero2TwoPiR + END SUBROUTINE Zero2TwoPiR4 +!======================================================================= +!> \copydoc nwtc_num::zero2twopir4 + SUBROUTINE Zero2TwoPiR8 ( Angle ) + + ! This routine is used to convert Angle to an equivalent value + ! in the range [0, 2*pi). + + + ! Argument declarations: + + REAL(R8Ki), INTENT(INOUT) :: Angle + + + + ! Get the angle between 0 and 2Pi. + + Angle = MODULO( Angle, TwoPi_R8 ) + + + ! Check numerical case where Angle == 2Pi. + + IF ( Angle == TwoPi_R8 ) THEN + Angle = 0.0_DbKi + END IF + + + RETURN + END SUBROUTINE Zero2TwoPiR8 !======================================================================= -!> \copydoc nwtc_num::zero2twopir - SUBROUTINE Zero2TwoPiD ( Angle ) +!> \copydoc nwtc_num::zero2twopir4 + SUBROUTINE Zero2TwoPiR16 ( Angle ) ! This routine is used to convert Angle to an equivalent value ! in the range [0, 2*pi). @@ -5889,23 +6084,340 @@ SUBROUTINE Zero2TwoPiD ( Angle ) ! Argument declarations: - REAL(DbKi), INTENT(INOUT) :: Angle + REAL(QuKi), INTENT(INOUT) :: Angle ! Get the angle between 0 and 2Pi. - Angle = MODULO( Angle, TwoPi_D ) + Angle = MODULO( Angle, TwoPi_R16 ) ! Check numerical case where Angle == 2Pi. - IF ( Angle == TwoPi_D ) THEN + IF ( Angle == TwoPi_R16 ) THEN Angle = 0.0_DbKi END IF RETURN - END SUBROUTINE Zero2TwoPiD + END SUBROUTINE Zero2TwoPiR16 +!======================================================================= + !< This routine extrapolates or interpolates between angles + SUBROUTINE Angles_ExtrapInterp1_R4(Angle1, Angle2, tin, Angle_out, tin_out ) + REAL(SiKi), INTENT(IN ) :: Angle1 !< Angle at t1 > t2 + REAL(SiKi), INTENT(IN ) :: Angle2 !< Angle at t2 + REAL(DbKi), INTENT(IN ) :: tin(:) !< Times associated with the inputs + REAL(SiKi), INTENT(INOUT) :: Angle_out !< Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out !< time to be extrap/interp'd to + + ! local variables + INTEGER(IntKi), parameter :: order = 1 ! order of polynomial fit (max 2) + REAL(DbKi) :: t(SIZE(tin)) ! Times associated with the inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + + REAL(SiKi) :: Angle2_mod + + ! 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) + + ! ! some error checking: + ! + ! if ( size(t) .ne. order+1) then + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp1: size(t) must equal 2.' + ! RETURN + ! end if + ! + !IF ( EqualRealNos( t(1), t(2) ) ) THEN + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp1: t(1) must not equal t(2) to avoid a division-by-zero error.' + ! RETURN + !END IF + + Angle2_mod = Angle2 + call AddOrSub2Pi( Angle1, Angle2_mod ) + + Angle_out = Angle1 + (Angle2_mod - Angle1) * t_out / t(2) + +! call Zero2TwoPi(Angle_out) +! call MPi2Pi(Angle_out) + + END SUBROUTINE Angles_ExtrapInterp1_R4 +!======================================================================= + !< This routine extrapolates or interpolates between angles + SUBROUTINE Angles_ExtrapInterp1_R8(Angle1, Angle2, tin, Angle_out, tin_out) + REAL(R8Ki), INTENT(IN ) :: Angle1 !< Angle at t1 > t2 + REAL(R8Ki), INTENT(IN ) :: Angle2 !< Angle at t2 + REAL(DbKi), INTENT(IN ) :: tin(:) !< Times associated with the inputs + REAL(R8Ki), INTENT(INOUT) :: Angle_out !< Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out !< time to be extrap/interp'd to + + ! local variables + INTEGER(IntKi), parameter :: order = 1 ! order of polynomial fit (max 2) + REAL(DbKi) :: t(SIZE(tin)) ! Times associated with the inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + + REAL(R8Ki) :: Angle2_mod + + ! 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) + + ! ! some error checking: + ! + ! if ( size(t) .ne. order+1) then + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp1: size(t) must equal 2.' + ! RETURN + ! end if + ! + !IF ( EqualRealNos( t(1), t(2) ) ) THEN + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp1: t(1) must not equal t(2) to avoid a division-by-zero error.' + ! RETURN + !END IF + + Angle2_mod = Angle2 + call AddOrSub2Pi( Angle1, Angle2_mod ) + + Angle_out = Angle1 + (Angle2_mod - Angle1) * t_out / t(2) +! call Zero2TwoPi(Angle_out) +! call MPi2Pi(Angle_out) + + END SUBROUTINE Angles_ExtrapInterp1_R8 +!======================================================================= + !< This routine extrapolates or interpolates between angles + SUBROUTINE Angles_ExtrapInterp1_R16(Angle1, Angle2, tin, Angle_out, tin_out) + REAL(QuKi), INTENT(IN ) :: Angle1 !< Angle at t1 > t2 + REAL(QuKi), INTENT(IN ) :: Angle2 !< Angle at t2 + REAL(DbKi), INTENT(IN ) :: tin(:) !< Times associated with the inputs + REAL(QuKi), INTENT(INOUT) :: Angle_out !< Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out !< time to be extrap/interp'd to + + ! local variables + INTEGER(IntKi), parameter :: order = 1 ! order of polynomial fit (max 2) + REAL(DbKi) :: t(SIZE(tin)) ! Times associated with the inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + + REAL(QuKi) :: Angle2_mod + + ! 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) + + ! ! some error checking: + ! + ! if ( size(t) .ne. order+1) then + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp1: size(t) must equal 2.' + ! RETURN + ! end if + ! + !IF ( EqualRealNos( t(1), t(2) ) ) THEN + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp1: t(1) must not equal t(2) to avoid a division-by-zero error.' + ! RETURN + !END IF + + Angle2_mod = Angle2 + call AddOrSub2Pi( Angle1, Angle2_mod ) + + Angle_out = Angle1 + (Angle2_mod - Angle1) * t_out / t(2) +! call Zero2TwoPi(Angle_out) +! call MPi2Pi(Angle_out) + + END SUBROUTINE Angles_ExtrapInterp1_R16 +!======================================================================= + !< This routine extrapolates or interpolates between angles + SUBROUTINE Angles_ExtrapInterp2_R4(Angle1, Angle2, Angle3, tin, Angle_out, tin_out ) + REAL(SiKi), INTENT(IN ) :: Angle1 !< Angle at t1 > t2 > t3 + REAL(SiKi), INTENT(IN ) :: Angle2 !< Angle at t2 > t3 + REAL(SiKi), INTENT(IN ) :: Angle3 !< Angle at t3 + REAL(DbKi), INTENT(IN ) :: tin(:) !< Times associated with the inputs + REAL(SiKi), INTENT(INOUT) :: Angle_out !< Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out !< time to be extrap/interp'd to + + ! local variables + INTEGER(IntKi), parameter :: order = 2 ! order of polynomial fit (max 2) + REAL(DbKi) :: t(SIZE(tin)) ! Times associated with the inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + + REAL(DbKi) :: scaleFactor ! temporary for extrapolation/interpolation + REAL(SiKi) :: Angle2_mod + REAL(SiKi) :: Angle3_mod + + ! 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) + + ! ! some error checking: + ! + !if ( size(t) .ne. order+1) then + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp2: size(t) must equal 3.' + ! RETURN + !end if + ! + !IF ( EqualRealNos( t(1), t(2) ) ) THEN + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp2: t(1) must not equal t(2) to avoid a division-by-zero error.' + ! RETURN + !END IF + !IF ( EqualRealNos( t(2), t(3) ) ) THEN + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp2: t(2) must not equal t(3) to avoid a division-by-zero error.' + ! RETURN + !END IF + !IF ( EqualRealNos( t(1), t(3) ) ) THEN + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp2: t(1) must not equal t(3) to avoid a division-by-zero error.' + ! RETURN + !END IF + + Angle2_mod = Angle2 + Angle3_mod = Angle3 + call AddOrSub2Pi( Angle1, Angle2_mod ) + call AddOrSub2Pi( Angle2_mod, Angle3_mod ) + + scaleFactor = t_out / ( t(2) * t(3) * (t(2) - t(3)) ) + + Angle_out = Angle1 & + + ( t(3)**2 * (Angle1 - Angle2_mod) + t(2)**2*(-Angle1 + Angle3_mod) ) * scaleFactor & + + ( (t(2)-t(3))*Angle1 + t(3)*Angle2_mod - t(2)*Angle3_mod ) *scaleFactor * t_out + +! call Zero2TwoPi(Angle_out) +! call MPi2Pi(Angle_out) + + END SUBROUTINE Angles_ExtrapInterp2_R4 +!======================================================================= + !< This routine extrapolates or interpolates between angles + SUBROUTINE Angles_ExtrapInterp2_R8(Angle1, Angle2, Angle3, tin, Angle_out, tin_out) + REAL(R8Ki), INTENT(IN ) :: Angle1 !< Angle at t1 > t2 > t3 + REAL(R8Ki), INTENT(IN ) :: Angle2 !< Angle at t2 > t3 + REAL(R8Ki), INTENT(IN ) :: Angle3 !< Angle at t3 + REAL(DbKi), INTENT(IN ) :: tin(:) !< Times associated with the inputs + REAL(R8Ki), INTENT(INOUT) :: Angle_out !< Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out !< time to be extrap/interp'd to + + ! local variables + INTEGER(IntKi), parameter :: order = 2 ! order of polynomial fit (max 2) + REAL(DbKi) :: t(SIZE(tin)) ! Times associated with the inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + + REAL(DbKi) :: scaleFactor ! temporary for extrapolation/interpolation + REAL(R8Ki) :: Angle2_mod + REAL(R8Ki) :: Angle3_mod + + ! 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) + + ! some error checking: + + !if ( size(t) .ne. order+1) then + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp2: size(t) must equal 3.' + ! RETURN + !end if + ! + !IF ( EqualRealNos( t(1), t(2) ) ) THEN + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp2: t(1) must not equal t(2) to avoid a division-by-zero error.' + ! RETURN + !END IF + !IF ( EqualRealNos( t(2), t(3) ) ) THEN + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp2: t(2) must not equal t(3) to avoid a division-by-zero error.' + ! RETURN + !END IF + !IF ( EqualRealNos( t(1), t(3) ) ) THEN + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp2: t(1) must not equal t(3) to avoid a division-by-zero error.' + ! RETURN + !END IF + + Angle2_mod = Angle2 + Angle3_mod = Angle3 + call AddOrSub2Pi( Angle1, Angle2_mod ) + call AddOrSub2Pi( Angle2_mod, Angle3_mod ) + + scaleFactor = t_out / ( t(2) * t(3) * (t(2) - t(3)) ) + + Angle_out = Angle1 & + + ( t(3)**2 * (Angle1 - Angle2_mod) + t(2)**2*(-Angle1 + Angle3_mod) ) * scaleFactor & + + ( (t(2)-t(3))*Angle1 + t(3)*Angle2_mod - t(2)*Angle3_mod ) *scaleFactor * t_out +! call Zero2TwoPi(Angle_out) +! call MPi2Pi(Angle_out) + + END SUBROUTINE Angles_ExtrapInterp2_R8 +!======================================================================= + !< This routine extrapolates or interpolates between angles + SUBROUTINE Angles_ExtrapInterp2_R16(Angle1, Angle2, Angle3, tin, Angle_out, tin_out ) + REAL(QuKi), INTENT(IN ) :: Angle1 !< Angle at t1 > t2 > t3 + REAL(QuKi), INTENT(IN ) :: Angle2 !< Angle at t2 > t3 + REAL(QuKi), INTENT(IN ) :: Angle3 !< Angle at t3 + REAL(DbKi), INTENT(IN ) :: tin(:) !< Times associated with the inputs + REAL(QuKi), INTENT(INOUT) :: Angle_out !< Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out !< time to be extrap/interp'd to + + ! local variables + INTEGER(IntKi), parameter :: order = 2 ! order of polynomial fit (max 2) + REAL(DbKi) :: t(SIZE(tin)) ! Times associated with the inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + + REAL(DbKi) :: scaleFactor ! temporary for extrapolation/interpolation + REAL(QuKi) :: Angle2_mod + REAL(QuKi) :: Angle3_mod + + ! 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) + + ! some error checking: + + !if ( size(t) .ne. order+1) then + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp2: size(t) must equal 3.' + ! RETURN + !end if + ! + !IF ( EqualRealNos( t(1), t(2) ) ) THEN + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp2: t(1) must not equal t(2) to avoid a division-by-zero error.' + ! RETURN + !END IF + !IF ( EqualRealNos( t(2), t(3) ) ) THEN + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp2: t(2) must not equal t(3) to avoid a division-by-zero error.' + ! RETURN + !END IF + !IF ( EqualRealNos( t(1), t(3) ) ) THEN + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp2: t(1) must not equal t(3) to avoid a division-by-zero error.' + ! RETURN + !END IF + + Angle2_mod = Angle2 + Angle3_mod = Angle3 + call AddOrSub2Pi( Angle1, Angle2_mod ) + call AddOrSub2Pi( Angle2_mod, Angle3_mod ) + + scaleFactor = t_out / ( t(2) * t(3) * (t(2) - t(3)) ) + + Angle_out = Angle1 & + + ( t(3)**2 * (Angle1 - Angle2_mod) + t(2)**2*(-Angle1 + Angle3_mod) ) * scaleFactor & + + ( (t(2)-t(3))*Angle1 + t(3)*Angle2_mod - t(2)*Angle3_mod ) *scaleFactor * t_out +! call Zero2TwoPi(Angle_out) +! call MPi2Pi(Angle_out) + + END SUBROUTINE Angles_ExtrapInterp2_R16 !======================================================================= END MODULE NWTC_Num diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index 47e0ba983d..23635de336 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -730,8 +730,14 @@ SUBROUTINE FAST_PackVTK_BLSurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AirfoilCoords,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AirfoilCoords)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AirfoilCoords))-1 ) = PACK(InData%AirfoilCoords,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AirfoilCoords) + DO i3 = LBOUND(InData%AirfoilCoords,3), UBOUND(InData%AirfoilCoords,3) + DO i2 = LBOUND(InData%AirfoilCoords,2), UBOUND(InData%AirfoilCoords,2) + DO i1 = LBOUND(InData%AirfoilCoords,1), UBOUND(InData%AirfoilCoords,1) + ReKiBuf(Re_Xferred) = InData%AirfoilCoords(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF END SUBROUTINE FAST_PackVTK_BLSurfaceType @@ -748,12 +754,6 @@ SUBROUTINE FAST_UnPackVTK_BLSurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -789,15 +789,14 @@ SUBROUTINE FAST_UnPackVTK_BLSurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AirfoilCoords.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%AirfoilCoords)>0) OutData%AirfoilCoords = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AirfoilCoords))-1 ), mask3, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%AirfoilCoords) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%AirfoilCoords,3), UBOUND(OutData%AirfoilCoords,3) + DO i2 = LBOUND(OutData%AirfoilCoords,2), UBOUND(OutData%AirfoilCoords,2) + DO i1 = LBOUND(OutData%AirfoilCoords,1), UBOUND(OutData%AirfoilCoords,1) + OutData%AirfoilCoords(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF END SUBROUTINE FAST_UnPackVTK_BLSurfaceType @@ -1032,14 +1031,18 @@ SUBROUTINE FAST_PackVTK_SurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumSectors - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HubRad - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GroundRad - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%NacelleBox))-1 ) = PACK(InData%NacelleBox,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%NacelleBox) + IntKiBuf(Int_Xferred) = InData%NumSectors + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HubRad + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GroundRad + Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(InData%NacelleBox,2), UBOUND(InData%NacelleBox,2) + DO i1 = LBOUND(InData%NacelleBox,1), UBOUND(InData%NacelleBox,1) + ReKiBuf(Re_Xferred) = InData%NacelleBox(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO IF ( .NOT. ALLOCATED(InData%TowerRad) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1050,11 +1053,15 @@ SUBROUTINE FAST_PackVTK_SurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TowerRad,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TowerRad)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TowerRad))-1 ) = PACK(InData%TowerRad,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TowerRad) + DO i1 = LBOUND(InData%TowerRad,1), UBOUND(InData%TowerRad,1) + ReKiBuf(Re_Xferred) = InData%TowerRad(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%NWaveElevPts))-1 ) = PACK(InData%NWaveElevPts,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%NWaveElevPts) + DO i1 = LBOUND(InData%NWaveElevPts,1), UBOUND(InData%NWaveElevPts,1) + IntKiBuf(Int_Xferred) = InData%NWaveElevPts(i1) + Int_Xferred = Int_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%WaveElevXY) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1068,8 +1075,12 @@ SUBROUTINE FAST_PackVTK_SurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevXY,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElevXY)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElevXY))-1 ) = PACK(InData%WaveElevXY,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElevXY) + DO i2 = LBOUND(InData%WaveElevXY,2), UBOUND(InData%WaveElevXY,2) + DO i1 = LBOUND(InData%WaveElevXY,1), UBOUND(InData%WaveElevXY,1) + ReKiBuf(Re_Xferred) = InData%WaveElevXY(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveElev) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1084,8 +1095,12 @@ SUBROUTINE FAST_PackVTK_SurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElev)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElev))-1 ) = PACK(InData%WaveElev,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElev) + DO i2 = LBOUND(InData%WaveElev,2), UBOUND(InData%WaveElev,2) + DO i1 = LBOUND(InData%WaveElev,1), UBOUND(InData%WaveElev,1) + ReKiBuf(Re_Xferred) = InData%WaveElev(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%BladeShape) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1138,8 +1153,10 @@ SUBROUTINE FAST_PackVTK_SurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MorisonRad,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%MorisonRad)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MorisonRad))-1 ) = PACK(InData%MorisonRad,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MorisonRad) + DO i1 = LBOUND(InData%MorisonRad,1), UBOUND(InData%MorisonRad,1) + ReKiBuf(Re_Xferred) = InData%MorisonRad(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE FAST_PackVTK_SurfaceType @@ -1156,12 +1173,6 @@ SUBROUTINE FAST_UnPackVTK_SurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -1177,25 +1188,22 @@ SUBROUTINE FAST_UnPackVTK_SurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%NumSectors = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%HubRad = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%GroundRad = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%NumSectors = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%HubRad = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%GroundRad = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%NacelleBox,1) i1_u = UBOUND(OutData%NacelleBox,1) i2_l = LBOUND(OutData%NacelleBox,2) i2_u = UBOUND(OutData%NacelleBox,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%NacelleBox = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%NacelleBox))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%NacelleBox) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%NacelleBox,2), UBOUND(OutData%NacelleBox,2) + DO i1 = LBOUND(OutData%NacelleBox,1), UBOUND(OutData%NacelleBox,1) + OutData%NacelleBox(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TowerRad not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1209,27 +1217,17 @@ SUBROUTINE FAST_UnPackVTK_SurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TowerRad.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TowerRad)>0) OutData%TowerRad = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TowerRad))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%TowerRad) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TowerRad,1), UBOUND(OutData%TowerRad,1) + OutData%TowerRad(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF i1_l = LBOUND(OutData%NWaveElevPts,1) i1_u = UBOUND(OutData%NWaveElevPts,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%NWaveElevPts = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%NWaveElevPts))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%NWaveElevPts) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%NWaveElevPts,1), UBOUND(OutData%NWaveElevPts,1) + OutData%NWaveElevPts(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevXY not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1246,15 +1244,12 @@ SUBROUTINE FAST_UnPackVTK_SurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevXY.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveElevXY)>0) OutData%WaveElevXY = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElevXY))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElevXY) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveElevXY,2), UBOUND(OutData%WaveElevXY,2) + DO i1 = LBOUND(OutData%WaveElevXY,1), UBOUND(OutData%WaveElevXY,1) + OutData%WaveElevXY(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev not allocated Int_Xferred = Int_Xferred + 1 @@ -1272,15 +1267,12 @@ SUBROUTINE FAST_UnPackVTK_SurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveElev)>0) OutData%WaveElev = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElev))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElev) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveElev,2), UBOUND(OutData%WaveElev,2) + DO i1 = LBOUND(OutData%WaveElev,1), UBOUND(OutData%WaveElev,1) + OutData%WaveElev(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeShape not allocated Int_Xferred = Int_Xferred + 1 @@ -1351,15 +1343,10 @@ SUBROUTINE FAST_UnPackVTK_SurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MorisonRad.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%MorisonRad)>0) OutData%MorisonRad = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MorisonRad))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%MorisonRad) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%MorisonRad,1), UBOUND(OutData%MorisonRad,1) + OutData%MorisonRad(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE FAST_UnPackVTK_SurfaceType @@ -1621,146 +1608,154 @@ SUBROUTINE FAST_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%DT_module))-1 ) = PACK(InData%DT_module,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%DT_module) - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%n_substeps))-1 ) = PACK(InData%n_substeps,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%n_substeps) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%n_TMax_m1 - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TMax - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%InterpOrder - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumCrctn - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%KMax - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%numIceLegs - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%nBeams - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%BD_OutputSibling , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%ModuleInitialized)-1 ) = TRANSFER(PACK( InData%ModuleInitialized ,.TRUE.), IntKiBuf(1), SIZE(InData%ModuleInitialized)) - Int_Xferred = Int_Xferred + SIZE(InData%ModuleInitialized) - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT_Ujac - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%UJacSclFact - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%SizeJac_Opt1))-1 ) = PACK(InData%SizeJac_Opt1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%SizeJac_Opt1) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%CompElast - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%CompInflow - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%CompAero - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%CompServo - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%CompHydro - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%CompSub - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%CompMooring - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%CompIce - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%UseDWM , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Linearize , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%EDFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%EDFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(InData%DT_module,1), UBOUND(InData%DT_module,1) + DbKiBuf(Db_Xferred) = InData%DT_module(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%n_substeps,1), UBOUND(InData%n_substeps,1) + IntKiBuf(Int_Xferred) = InData%n_substeps(i1) + Int_Xferred = Int_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%n_TMax_m1 + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%TMax + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%InterpOrder + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumCrctn + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%KMax + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%numIceLegs + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nBeams + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%BD_OutputSibling, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%ModuleInitialized,1), UBOUND(InData%ModuleInitialized,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%ModuleInitialized(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + DbKiBuf(Db_Xferred) = InData%DT_Ujac + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%UJacSclFact + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%SizeJac_Opt1,1), UBOUND(InData%SizeJac_Opt1,1) + IntKiBuf(Int_Xferred) = InData%SizeJac_Opt1(i1) + Int_Xferred = Int_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%CompElast + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%CompInflow + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%CompAero + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%CompServo + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%CompHydro + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%CompSub + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%CompMooring + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%CompIce + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%UseDWM, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%Linearize, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%EDFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%EDFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I DO i1 = LBOUND(InData%BDBldFile,1), UBOUND(InData%BDBldFile,1) - DO I = 1, LEN(InData%BDBldFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%BDBldFile(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - DO I = 1, LEN(InData%InflowFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InflowFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%AeroFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%AeroFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%ServoFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%ServoFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%HydroFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%HydroFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%SubFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%SubFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%MooringFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%MooringFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%IceFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%IceFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TStart - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT_Out - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%WrSttsTime , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%n_SttsTime - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%n_ChkptTime - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%n_VTKTime - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TurbineType - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%WrBinOutFile , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%WrTxtOutFile , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WrBinMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%SumPrint , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WrVTK - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%VTK_Type - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%VTK_fields , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%Delim) - IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutFmt_t) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt_t(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%FmtWidth - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TChanLen - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFileRoot) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFileRoot(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%FTitle) - IntKiBuf(Int_Xferred) = ICHAR(InData%FTitle(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(InData%BDBldFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%BDBldFile(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + DO I = 1, LEN(InData%InflowFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%InflowFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%AeroFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%AeroFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%ServoFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%ServoFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%HydroFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%HydroFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%SubFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%SubFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%MooringFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%MooringFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%IceFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%IceFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DbKiBuf(Db_Xferred) = InData%TStart + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT_Out + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%WrSttsTime, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%n_SttsTime + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%n_ChkptTime + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%n_VTKTime + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TurbineType + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%WrBinOutFile, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%WrTxtOutFile, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WrBinMod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%SumPrint, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WrVTK + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%VTK_Type + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%VTK_fields, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%Delim) + IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%OutFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%OutFmt_t) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt_t(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%FmtWidth + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TChanLen + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%OutFileRoot) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutFileRoot(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%FTitle) + IntKiBuf(Int_Xferred) = ICHAR(InData%FTitle(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( .NOT. ALLOCATED(InData%LinTimes) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1771,17 +1766,19 @@ SUBROUTINE FAST_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinTimes,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LinTimes)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%LinTimes))-1 ) = PACK(InData%LinTimes,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%LinTimes) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%LinInputs - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%LinOutputs - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%LinOutJac , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%LinOutMod , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%LinTimes,1), UBOUND(InData%LinTimes,1) + DbKiBuf(Db_Xferred) = InData%LinTimes(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = InData%LinInputs + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%LinOutputs + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%LinOutJac, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%LinOutMod, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 CALL FAST_Packvtk_surfacetype( Re_Buf, Db_Buf, Int_Buf, InData%VTK_surface, ErrStat2, ErrMsg2, OnlySize ) ! VTK_surface CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1810,16 +1807,20 @@ SUBROUTINE FAST_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TurbinePos))-1 ) = PACK(InData%TurbinePos,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TurbinePos) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Lin_NumMods - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%Lin_ModOrder))-1 ) = PACK(InData%Lin_ModOrder,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%Lin_ModOrder) - DO I = 1, LEN(InData%Tdesc) - IntKiBuf(Int_Xferred) = ICHAR(InData%Tdesc(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO i1 = LBOUND(InData%TurbinePos,1), UBOUND(InData%TurbinePos,1) + ReKiBuf(Re_Xferred) = InData%TurbinePos(i1) + Re_Xferred = Re_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%Lin_NumMods + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%Lin_ModOrder,1), UBOUND(InData%Lin_ModOrder,1) + IntKiBuf(Int_Xferred) = InData%Lin_ModOrder(i1) + Int_Xferred = Int_Xferred + 1 + END DO + DO I = 1, LEN(InData%Tdesc) + IntKiBuf(Int_Xferred) = ICHAR(InData%Tdesc(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE FAST_PackParam SUBROUTINE FAST_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1835,12 +1836,6 @@ SUBROUTINE FAST_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1855,191 +1850,164 @@ SUBROUTINE FAST_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 i1_l = LBOUND(OutData%DT_module,1) i1_u = UBOUND(OutData%DT_module,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%DT_module = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%DT_module))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%DT_module) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%DT_module,1), UBOUND(OutData%DT_module,1) + OutData%DT_module(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%n_substeps,1) i1_u = UBOUND(OutData%n_substeps,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%n_substeps = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%n_substeps))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%n_substeps) - DEALLOCATE(mask1) - OutData%n_TMax_m1 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TMax = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%InterpOrder = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumCrctn = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%KMax = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%numIceLegs = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%nBeams = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%BD_OutputSibling = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%n_substeps,1), UBOUND(OutData%n_substeps,1) + OutData%n_substeps(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + OutData%n_TMax_m1 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TMax = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%InterpOrder = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumCrctn = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%KMax = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%numIceLegs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nBeams = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%BD_OutputSibling = TRANSFER(IntKiBuf(Int_Xferred), OutData%BD_OutputSibling) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%ModuleInitialized,1) i1_u = UBOUND(OutData%ModuleInitialized,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%ModuleInitialized = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%ModuleInitialized))-1 ), OutData%ModuleInitialized), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%ModuleInitialized) - DEALLOCATE(mask1) - OutData%DT_Ujac = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%UJacSclFact = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%ModuleInitialized,1), UBOUND(OutData%ModuleInitialized,1) + OutData%ModuleInitialized(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%ModuleInitialized(i1)) + Int_Xferred = Int_Xferred + 1 + END DO + OutData%DT_Ujac = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%UJacSclFact = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%SizeJac_Opt1,1) i1_u = UBOUND(OutData%SizeJac_Opt1,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%SizeJac_Opt1 = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%SizeJac_Opt1))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%SizeJac_Opt1) - DEALLOCATE(mask1) - OutData%CompElast = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%CompInflow = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%CompAero = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%CompServo = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%CompHydro = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%CompSub = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%CompMooring = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%CompIce = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%UseDWM = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%Linearize = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%EDFile) - OutData%EDFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO i1 = LBOUND(OutData%SizeJac_Opt1,1), UBOUND(OutData%SizeJac_Opt1,1) + OutData%SizeJac_Opt1(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + OutData%CompElast = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%CompInflow = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%CompAero = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%CompServo = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%CompHydro = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%CompSub = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%CompMooring = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%CompIce = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%UseDWM = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseDWM) + Int_Xferred = Int_Xferred + 1 + OutData%Linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%Linearize) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%EDFile) + OutData%EDFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I i1_l = LBOUND(OutData%BDBldFile,1) i1_u = UBOUND(OutData%BDBldFile,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. DO i1 = LBOUND(OutData%BDBldFile,1), UBOUND(OutData%BDBldFile,1) - DO I = 1, LEN(OutData%BDBldFile) - OutData%BDBldFile(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - DEALLOCATE(mask1) - DO I = 1, LEN(OutData%InflowFile) - OutData%InflowFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%AeroFile) - OutData%AeroFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%ServoFile) - OutData%ServoFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%HydroFile) - OutData%HydroFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%SubFile) - OutData%SubFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%MooringFile) - OutData%MooringFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%IceFile) - OutData%IceFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%TStart = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%DT_Out = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%WrSttsTime = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%n_SttsTime = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%n_ChkptTime = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%n_VTKTime = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TurbineType = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%WrBinOutFile = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%WrTxtOutFile = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%WrBinMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%SumPrint = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%WrVTK = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%VTK_Type = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%VTK_fields = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutFmt_t) - OutData%OutFmt_t(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%FmtWidth = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TChanLen = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFileRoot) - OutData%OutFileRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%FTitle) - OutData%FTitle(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%BDBldFile) + OutData%BDBldFile(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 END DO ! I + END DO + DO I = 1, LEN(OutData%InflowFile) + OutData%InflowFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%AeroFile) + OutData%AeroFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%ServoFile) + OutData%ServoFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%HydroFile) + OutData%HydroFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%SubFile) + OutData%SubFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%MooringFile) + OutData%MooringFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%IceFile) + OutData%IceFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%TStart = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%DT_Out = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%WrSttsTime = TRANSFER(IntKiBuf(Int_Xferred), OutData%WrSttsTime) + Int_Xferred = Int_Xferred + 1 + OutData%n_SttsTime = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%n_ChkptTime = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%n_VTKTime = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TurbineType = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WrBinOutFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%WrBinOutFile) + Int_Xferred = Int_Xferred + 1 + OutData%WrTxtOutFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%WrTxtOutFile) + Int_Xferred = Int_Xferred + 1 + OutData%WrBinMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%SumPrint = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumPrint) + Int_Xferred = Int_Xferred + 1 + OutData%WrVTK = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%VTK_Type = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%VTK_fields = TRANSFER(IntKiBuf(Int_Xferred), OutData%VTK_fields) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%Delim) + OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%OutFmt) + OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%OutFmt_t) + OutData%OutFmt_t(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%FmtWidth = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TChanLen = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%OutFileRoot) + OutData%OutFileRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%FTitle) + OutData%FTitle(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinTimes not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2053,24 +2021,19 @@ SUBROUTINE FAST_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinTimes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LinTimes)>0) OutData%LinTimes = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%LinTimes))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%LinTimes) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LinTimes,1), UBOUND(OutData%LinTimes,1) + OutData%LinTimes(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO END IF - OutData%LinInputs = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%LinOutputs = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%LinOutJac = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%LinOutMod = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%LinInputs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%LinOutputs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%LinOutJac = TRANSFER(IntKiBuf(Int_Xferred), OutData%LinOutJac) + Int_Xferred = Int_Xferred + 1 + OutData%LinOutMod = TRANSFER(IntKiBuf(Int_Xferred), OutData%LinOutMod) + Int_Xferred = Int_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -2113,32 +2076,22 @@ SUBROUTINE FAST_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) i1_l = LBOUND(OutData%TurbinePos,1) i1_u = UBOUND(OutData%TurbinePos,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%TurbinePos = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TurbinePos))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%TurbinePos) - DEALLOCATE(mask1) - OutData%Lin_NumMods = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%TurbinePos,1), UBOUND(OutData%TurbinePos,1) + OutData%TurbinePos(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%Lin_NumMods = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%Lin_ModOrder,1) i1_u = UBOUND(OutData%Lin_ModOrder,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%Lin_ModOrder = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%Lin_ModOrder))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%Lin_ModOrder) - DEALLOCATE(mask1) - DO I = 1, LEN(OutData%Tdesc) - OutData%Tdesc(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO i1 = LBOUND(OutData%Lin_ModOrder,1), UBOUND(OutData%Lin_ModOrder,1) + OutData%Lin_ModOrder(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + DO I = 1, LEN(OutData%Tdesc) + OutData%Tdesc(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE FAST_UnPackParam SUBROUTINE FAST_CopyLinType( SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, ErrMsg ) @@ -2782,12 +2735,12 @@ SUBROUTINE FAST_PackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Names_u,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%Names_u,1), UBOUND(InData%Names_u,1) + DO i1 = LBOUND(InData%Names_u,1), UBOUND(InData%Names_u,1) DO I = 1, LEN(InData%Names_u) IntKiBuf(Int_Xferred) = ICHAR(InData%Names_u(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%Names_y) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2799,12 +2752,12 @@ SUBROUTINE FAST_PackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Names_y,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%Names_y,1), UBOUND(InData%Names_y,1) + DO i1 = LBOUND(InData%Names_y,1), UBOUND(InData%Names_y,1) DO I = 1, LEN(InData%Names_y) IntKiBuf(Int_Xferred) = ICHAR(InData%Names_y(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%Names_x) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2816,12 +2769,12 @@ SUBROUTINE FAST_PackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Names_x,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%Names_x,1), UBOUND(InData%Names_x,1) + DO i1 = LBOUND(InData%Names_x,1), UBOUND(InData%Names_x,1) DO I = 1, LEN(InData%Names_x) IntKiBuf(Int_Xferred) = ICHAR(InData%Names_x(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%Names_xd) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2833,12 +2786,12 @@ SUBROUTINE FAST_PackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Names_xd,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%Names_xd,1), UBOUND(InData%Names_xd,1) + DO i1 = LBOUND(InData%Names_xd,1), UBOUND(InData%Names_xd,1) DO I = 1, LEN(InData%Names_xd) IntKiBuf(Int_Xferred) = ICHAR(InData%Names_xd(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%Names_z) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2850,12 +2803,12 @@ SUBROUTINE FAST_PackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Names_z,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%Names_z,1), UBOUND(InData%Names_z,1) + DO i1 = LBOUND(InData%Names_z,1), UBOUND(InData%Names_z,1) DO I = 1, LEN(InData%Names_z) IntKiBuf(Int_Xferred) = ICHAR(InData%Names_z(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%op_u) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2867,8 +2820,10 @@ SUBROUTINE FAST_PackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%op_u,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%op_u)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%op_u))-1 ) = PACK(InData%op_u,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%op_u) + DO i1 = LBOUND(InData%op_u,1), UBOUND(InData%op_u,1) + ReKiBuf(Re_Xferred) = InData%op_u(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%op_y) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2880,8 +2835,10 @@ SUBROUTINE FAST_PackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%op_y,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%op_y)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%op_y))-1 ) = PACK(InData%op_y,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%op_y) + DO i1 = LBOUND(InData%op_y,1), UBOUND(InData%op_y,1) + ReKiBuf(Re_Xferred) = InData%op_y(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%op_x) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2893,8 +2850,10 @@ SUBROUTINE FAST_PackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%op_x,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%op_x)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%op_x))-1 ) = PACK(InData%op_x,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%op_x) + DO i1 = LBOUND(InData%op_x,1), UBOUND(InData%op_x,1) + ReKiBuf(Re_Xferred) = InData%op_x(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%op_dx) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2906,8 +2865,10 @@ SUBROUTINE FAST_PackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%op_dx,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%op_dx)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%op_dx))-1 ) = PACK(InData%op_dx,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%op_dx) + DO i1 = LBOUND(InData%op_dx,1), UBOUND(InData%op_dx,1) + ReKiBuf(Re_Xferred) = InData%op_dx(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%op_xd) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2919,8 +2880,10 @@ SUBROUTINE FAST_PackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%op_xd,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%op_xd)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%op_xd))-1 ) = PACK(InData%op_xd,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%op_xd) + DO i1 = LBOUND(InData%op_xd,1), UBOUND(InData%op_xd,1) + ReKiBuf(Re_Xferred) = InData%op_xd(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%op_z) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2932,8 +2895,10 @@ SUBROUTINE FAST_PackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%op_z,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%op_z)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%op_z))-1 ) = PACK(InData%op_z,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%op_z) + DO i1 = LBOUND(InData%op_z,1), UBOUND(InData%op_z,1) + ReKiBuf(Re_Xferred) = InData%op_z(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%Use_u) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2945,8 +2910,10 @@ SUBROUTINE FAST_PackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Use_u,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Use_u)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%Use_u)-1 ) = TRANSFER(PACK( InData%Use_u ,.TRUE.), IntKiBuf(1), SIZE(InData%Use_u)) - Int_Xferred = Int_Xferred + SIZE(InData%Use_u) + DO i1 = LBOUND(InData%Use_u,1), UBOUND(InData%Use_u,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%Use_u(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%Use_y) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2958,8 +2925,10 @@ SUBROUTINE FAST_PackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Use_y,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Use_y)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%Use_y)-1 ) = TRANSFER(PACK( InData%Use_y ,.TRUE.), IntKiBuf(1), SIZE(InData%Use_y)) - Int_Xferred = Int_Xferred + SIZE(InData%Use_y) + DO i1 = LBOUND(InData%Use_y,1), UBOUND(InData%Use_y,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%Use_y(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%A) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2974,8 +2943,12 @@ SUBROUTINE FAST_PackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%A,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%A)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%A))-1 ) = PACK(InData%A,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%A) + DO i2 = LBOUND(InData%A,2), UBOUND(InData%A,2) + DO i1 = LBOUND(InData%A,1), UBOUND(InData%A,1) + DbKiBuf(Db_Xferred) = InData%A(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%B) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2990,8 +2963,12 @@ SUBROUTINE FAST_PackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%B,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%B)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%B))-1 ) = PACK(InData%B,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%B) + DO i2 = LBOUND(InData%B,2), UBOUND(InData%B,2) + DO i1 = LBOUND(InData%B,1), UBOUND(InData%B,1) + DbKiBuf(Db_Xferred) = InData%B(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%C) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3006,8 +2983,12 @@ SUBROUTINE FAST_PackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%C)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%C))-1 ) = PACK(InData%C,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%C) + DO i2 = LBOUND(InData%C,2), UBOUND(InData%C,2) + DO i1 = LBOUND(InData%C,1), UBOUND(InData%C,1) + DbKiBuf(Db_Xferred) = InData%C(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%D) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3022,8 +3003,12 @@ SUBROUTINE FAST_PackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%D))-1 ) = PACK(InData%D,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%D) + DO i2 = LBOUND(InData%D,2), UBOUND(InData%D,2) + DO i1 = LBOUND(InData%D,1), UBOUND(InData%D,1) + DbKiBuf(Db_Xferred) = InData%D(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%StateRotation) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3038,8 +3023,12 @@ SUBROUTINE FAST_PackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StateRotation,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%StateRotation)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%StateRotation))-1 ) = PACK(InData%StateRotation,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%StateRotation) + DO i2 = LBOUND(InData%StateRotation,2), UBOUND(InData%StateRotation,2) + DO i1 = LBOUND(InData%StateRotation,1), UBOUND(InData%StateRotation,1) + DbKiBuf(Db_Xferred) = InData%StateRotation(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%StateRel_x) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3054,8 +3043,12 @@ SUBROUTINE FAST_PackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StateRel_x,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%StateRel_x)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%StateRel_x))-1 ) = PACK(InData%StateRel_x,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%StateRel_x) + DO i2 = LBOUND(InData%StateRel_x,2), UBOUND(InData%StateRel_x,2) + DO i1 = LBOUND(InData%StateRel_x,1), UBOUND(InData%StateRel_x,1) + DbKiBuf(Db_Xferred) = InData%StateRel_x(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%StateRel_xdot) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3070,8 +3063,12 @@ SUBROUTINE FAST_PackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StateRel_xdot,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%StateRel_xdot)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%StateRel_xdot))-1 ) = PACK(InData%StateRel_xdot,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%StateRel_xdot) + DO i2 = LBOUND(InData%StateRel_xdot,2), UBOUND(InData%StateRel_xdot,2) + DO i1 = LBOUND(InData%StateRel_xdot,1), UBOUND(InData%StateRel_xdot,1) + DbKiBuf(Db_Xferred) = InData%StateRel_xdot(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%IsLoad_u) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3083,8 +3080,10 @@ SUBROUTINE FAST_PackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IsLoad_u,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%IsLoad_u)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%IsLoad_u)-1 ) = TRANSFER(PACK( InData%IsLoad_u ,.TRUE.), IntKiBuf(1), SIZE(InData%IsLoad_u)) - Int_Xferred = Int_Xferred + SIZE(InData%IsLoad_u) + DO i1 = LBOUND(InData%IsLoad_u,1), UBOUND(InData%IsLoad_u,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%IsLoad_u(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%RotFrame_u) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3096,8 +3095,10 @@ SUBROUTINE FAST_PackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_u,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RotFrame_u)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%RotFrame_u)-1 ) = TRANSFER(PACK( InData%RotFrame_u ,.TRUE.), IntKiBuf(1), SIZE(InData%RotFrame_u)) - Int_Xferred = Int_Xferred + SIZE(InData%RotFrame_u) + DO i1 = LBOUND(InData%RotFrame_u,1), UBOUND(InData%RotFrame_u,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_u(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%RotFrame_y) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3109,8 +3110,10 @@ SUBROUTINE FAST_PackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_y,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RotFrame_y)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%RotFrame_y)-1 ) = TRANSFER(PACK( InData%RotFrame_y ,.TRUE.), IntKiBuf(1), SIZE(InData%RotFrame_y)) - Int_Xferred = Int_Xferred + SIZE(InData%RotFrame_y) + DO i1 = LBOUND(InData%RotFrame_y,1), UBOUND(InData%RotFrame_y,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_y(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%RotFrame_x) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3122,8 +3125,10 @@ SUBROUTINE FAST_PackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_x,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RotFrame_x)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%RotFrame_x)-1 ) = TRANSFER(PACK( InData%RotFrame_x ,.TRUE.), IntKiBuf(1), SIZE(InData%RotFrame_x)) - Int_Xferred = Int_Xferred + SIZE(InData%RotFrame_x) + DO i1 = LBOUND(InData%RotFrame_x,1), UBOUND(InData%RotFrame_x,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_x(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%RotFrame_z) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3135,8 +3140,10 @@ SUBROUTINE FAST_PackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_z,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RotFrame_z)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%RotFrame_z)-1 ) = TRANSFER(PACK( InData%RotFrame_z ,.TRUE.), IntKiBuf(1), SIZE(InData%RotFrame_z)) - Int_Xferred = Int_Xferred + SIZE(InData%RotFrame_z) + DO i1 = LBOUND(InData%RotFrame_z,1), UBOUND(InData%RotFrame_z,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_z(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%DerivOrder_x) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3148,15 +3155,21 @@ SUBROUTINE FAST_PackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DerivOrder_x,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DerivOrder_x)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%DerivOrder_x))-1 ) = PACK(InData%DerivOrder_x,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%DerivOrder_x) + DO i1 = LBOUND(InData%DerivOrder_x,1), UBOUND(InData%DerivOrder_x,1) + IntKiBuf(Int_Xferred) = InData%DerivOrder_x(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%SizeLin))-1 ) = PACK(InData%SizeLin,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%SizeLin) - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%LinStartIndx))-1 ) = PACK(InData%LinStartIndx,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%LinStartIndx) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOutputs - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%SizeLin,1), UBOUND(InData%SizeLin,1) + IntKiBuf(Int_Xferred) = InData%SizeLin(i1) + Int_Xferred = Int_Xferred + 1 + END DO + DO i1 = LBOUND(InData%LinStartIndx,1), UBOUND(InData%LinStartIndx,1) + IntKiBuf(Int_Xferred) = InData%LinStartIndx(i1) + Int_Xferred = Int_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%NumOutputs + Int_Xferred = Int_Xferred + 1 END SUBROUTINE FAST_PackLinType SUBROUTINE FAST_UnPackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -3172,12 +3185,6 @@ SUBROUTINE FAST_UnPackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -3206,19 +3213,12 @@ SUBROUTINE FAST_UnPackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Names_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%Names_u,1), UBOUND(OutData%Names_u,1) + DO i1 = LBOUND(OutData%Names_u,1), UBOUND(OutData%Names_u,1) DO I = 1, LEN(OutData%Names_u) OutData%Names_u(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Names_y not allocated Int_Xferred = Int_Xferred + 1 @@ -3233,19 +3233,12 @@ SUBROUTINE FAST_UnPackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Names_y.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%Names_y,1), UBOUND(OutData%Names_y,1) + DO i1 = LBOUND(OutData%Names_y,1), UBOUND(OutData%Names_y,1) DO I = 1, LEN(OutData%Names_y) OutData%Names_y(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Names_x not allocated Int_Xferred = Int_Xferred + 1 @@ -3260,19 +3253,12 @@ SUBROUTINE FAST_UnPackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Names_x.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%Names_x,1), UBOUND(OutData%Names_x,1) + DO i1 = LBOUND(OutData%Names_x,1), UBOUND(OutData%Names_x,1) DO I = 1, LEN(OutData%Names_x) OutData%Names_x(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Names_xd not allocated Int_Xferred = Int_Xferred + 1 @@ -3287,19 +3273,12 @@ SUBROUTINE FAST_UnPackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Names_xd.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%Names_xd,1), UBOUND(OutData%Names_xd,1) + DO i1 = LBOUND(OutData%Names_xd,1), UBOUND(OutData%Names_xd,1) DO I = 1, LEN(OutData%Names_xd) OutData%Names_xd(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Names_z not allocated Int_Xferred = Int_Xferred + 1 @@ -3314,19 +3293,12 @@ SUBROUTINE FAST_UnPackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Names_z.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%Names_z,1), UBOUND(OutData%Names_z,1) + DO i1 = LBOUND(OutData%Names_z,1), UBOUND(OutData%Names_z,1) DO I = 1, LEN(OutData%Names_z) OutData%Names_z(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! op_u not allocated Int_Xferred = Int_Xferred + 1 @@ -3341,15 +3313,10 @@ SUBROUTINE FAST_UnPackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%op_u)>0) OutData%op_u = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%op_u))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%op_u) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%op_u,1), UBOUND(OutData%op_u,1) + OutData%op_u(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! op_y not allocated Int_Xferred = Int_Xferred + 1 @@ -3364,15 +3331,10 @@ SUBROUTINE FAST_UnPackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_y.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%op_y)>0) OutData%op_y = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%op_y))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%op_y) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%op_y,1), UBOUND(OutData%op_y,1) + OutData%op_y(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! op_x not allocated Int_Xferred = Int_Xferred + 1 @@ -3387,15 +3349,10 @@ SUBROUTINE FAST_UnPackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_x.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%op_x)>0) OutData%op_x = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%op_x))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%op_x) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%op_x,1), UBOUND(OutData%op_x,1) + OutData%op_x(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! op_dx not allocated Int_Xferred = Int_Xferred + 1 @@ -3410,15 +3367,10 @@ SUBROUTINE FAST_UnPackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_dx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%op_dx)>0) OutData%op_dx = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%op_dx))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%op_dx) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%op_dx,1), UBOUND(OutData%op_dx,1) + OutData%op_dx(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! op_xd not allocated Int_Xferred = Int_Xferred + 1 @@ -3433,15 +3385,10 @@ SUBROUTINE FAST_UnPackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_xd.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%op_xd)>0) OutData%op_xd = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%op_xd))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%op_xd) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%op_xd,1), UBOUND(OutData%op_xd,1) + OutData%op_xd(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! op_z not allocated Int_Xferred = Int_Xferred + 1 @@ -3456,15 +3403,10 @@ SUBROUTINE FAST_UnPackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_z.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%op_z)>0) OutData%op_z = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%op_z))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%op_z) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%op_z,1), UBOUND(OutData%op_z,1) + OutData%op_z(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Use_u not allocated Int_Xferred = Int_Xferred + 1 @@ -3479,15 +3421,10 @@ SUBROUTINE FAST_UnPackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Use_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Use_u)>0) OutData%Use_u = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%Use_u))-1 ), OutData%Use_u), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%Use_u) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Use_u,1), UBOUND(OutData%Use_u,1) + OutData%Use_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%Use_u(i1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Use_y not allocated Int_Xferred = Int_Xferred + 1 @@ -3502,15 +3439,10 @@ SUBROUTINE FAST_UnPackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Use_y.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Use_y)>0) OutData%Use_y = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%Use_y))-1 ), OutData%Use_y), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%Use_y) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Use_y,1), UBOUND(OutData%Use_y,1) + OutData%Use_y(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%Use_y(i1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! A not allocated Int_Xferred = Int_Xferred + 1 @@ -3528,15 +3460,12 @@ SUBROUTINE FAST_UnPackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%A.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%A)>0) OutData%A = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%A))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%A) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%A,2), UBOUND(OutData%A,2) + DO i1 = LBOUND(OutData%A,1), UBOUND(OutData%A,1) + OutData%A(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! B not allocated Int_Xferred = Int_Xferred + 1 @@ -3554,15 +3483,12 @@ SUBROUTINE FAST_UnPackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%B.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%B)>0) OutData%B = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%B))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%B) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%B,2), UBOUND(OutData%B,2) + DO i1 = LBOUND(OutData%B,1), UBOUND(OutData%B,1) + OutData%B(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C not allocated Int_Xferred = Int_Xferred + 1 @@ -3580,15 +3506,12 @@ SUBROUTINE FAST_UnPackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%C)>0) OutData%C = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%C))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%C) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%C,2), UBOUND(OutData%C,2) + DO i1 = LBOUND(OutData%C,1), UBOUND(OutData%C,1) + OutData%C(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D not allocated Int_Xferred = Int_Xferred + 1 @@ -3606,15 +3529,12 @@ SUBROUTINE FAST_UnPackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%D)>0) OutData%D = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%D))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%D) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%D,2), UBOUND(OutData%D,2) + DO i1 = LBOUND(OutData%D,1), UBOUND(OutData%D,1) + OutData%D(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StateRotation not allocated Int_Xferred = Int_Xferred + 1 @@ -3632,15 +3552,12 @@ SUBROUTINE FAST_UnPackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StateRotation.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%StateRotation)>0) OutData%StateRotation = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%StateRotation))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%StateRotation) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%StateRotation,2), UBOUND(OutData%StateRotation,2) + DO i1 = LBOUND(OutData%StateRotation,1), UBOUND(OutData%StateRotation,1) + OutData%StateRotation(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StateRel_x not allocated Int_Xferred = Int_Xferred + 1 @@ -3658,15 +3575,12 @@ SUBROUTINE FAST_UnPackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StateRel_x.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%StateRel_x)>0) OutData%StateRel_x = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%StateRel_x))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%StateRel_x) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%StateRel_x,2), UBOUND(OutData%StateRel_x,2) + DO i1 = LBOUND(OutData%StateRel_x,1), UBOUND(OutData%StateRel_x,1) + OutData%StateRel_x(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StateRel_xdot not allocated Int_Xferred = Int_Xferred + 1 @@ -3684,15 +3598,12 @@ SUBROUTINE FAST_UnPackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StateRel_xdot.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%StateRel_xdot)>0) OutData%StateRel_xdot = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%StateRel_xdot))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%StateRel_xdot) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%StateRel_xdot,2), UBOUND(OutData%StateRel_xdot,2) + DO i1 = LBOUND(OutData%StateRel_xdot,1), UBOUND(OutData%StateRel_xdot,1) + OutData%StateRel_xdot(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IsLoad_u not allocated Int_Xferred = Int_Xferred + 1 @@ -3707,15 +3618,10 @@ SUBROUTINE FAST_UnPackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%IsLoad_u)>0) OutData%IsLoad_u = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%IsLoad_u))-1 ), OutData%IsLoad_u), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%IsLoad_u) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%IsLoad_u,1), UBOUND(OutData%IsLoad_u,1) + OutData%IsLoad_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsLoad_u(i1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_u not allocated Int_Xferred = Int_Xferred + 1 @@ -3730,15 +3636,10 @@ SUBROUTINE FAST_UnPackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RotFrame_u)>0) OutData%RotFrame_u = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%RotFrame_u))-1 ), OutData%RotFrame_u), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%RotFrame_u) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%RotFrame_u,1), UBOUND(OutData%RotFrame_u,1) + OutData%RotFrame_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_u(i1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_y not allocated Int_Xferred = Int_Xferred + 1 @@ -3753,15 +3654,10 @@ SUBROUTINE FAST_UnPackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RotFrame_y)>0) OutData%RotFrame_y = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%RotFrame_y))-1 ), OutData%RotFrame_y), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%RotFrame_y) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%RotFrame_y,1), UBOUND(OutData%RotFrame_y,1) + OutData%RotFrame_y(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_y(i1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_x not allocated Int_Xferred = Int_Xferred + 1 @@ -3776,15 +3672,10 @@ SUBROUTINE FAST_UnPackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_x.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RotFrame_x)>0) OutData%RotFrame_x = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%RotFrame_x))-1 ), OutData%RotFrame_x), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%RotFrame_x) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%RotFrame_x,1), UBOUND(OutData%RotFrame_x,1) + OutData%RotFrame_x(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_x(i1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_z not allocated Int_Xferred = Int_Xferred + 1 @@ -3799,15 +3690,10 @@ SUBROUTINE FAST_UnPackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_z.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RotFrame_z)>0) OutData%RotFrame_z = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%RotFrame_z))-1 ), OutData%RotFrame_z), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%RotFrame_z) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%RotFrame_z,1), UBOUND(OutData%RotFrame_z,1) + OutData%RotFrame_z(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_z(i1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DerivOrder_x not allocated Int_Xferred = Int_Xferred + 1 @@ -3822,40 +3708,25 @@ SUBROUTINE FAST_UnPackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%DerivOrder_x)>0) OutData%DerivOrder_x = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%DerivOrder_x))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%DerivOrder_x) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%DerivOrder_x,1), UBOUND(OutData%DerivOrder_x,1) + OutData%DerivOrder_x(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF i1_l = LBOUND(OutData%SizeLin,1) i1_u = UBOUND(OutData%SizeLin,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%SizeLin = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%SizeLin))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%SizeLin) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%SizeLin,1), UBOUND(OutData%SizeLin,1) + OutData%SizeLin(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO i1_l = LBOUND(OutData%LinStartIndx,1) i1_u = UBOUND(OutData%LinStartIndx,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%LinStartIndx = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%LinStartIndx))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%LinStartIndx) - DEALLOCATE(mask1) - OutData%NumOutputs = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%LinStartIndx,1), UBOUND(OutData%LinStartIndx,1) + OutData%LinStartIndx(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + OutData%NumOutputs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE FAST_UnPackLinType SUBROUTINE FAST_CopyModLinType( SrcModLinTypeData, DstModLinTypeData, CtrlCode, ErrStat, ErrMsg ) @@ -4050,12 +3921,6 @@ SUBROUTINE FAST_UnPackModLinType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -4329,10 +4194,10 @@ SUBROUTINE FAST_PackLinFileType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RotSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Azimuth - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RotSpeed + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Azimuth + Re_Xferred = Re_Xferred + 1 END SUBROUTINE FAST_PackLinFileType SUBROUTINE FAST_UnPackLinFileType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -4348,12 +4213,6 @@ SUBROUTINE FAST_UnPackLinFileType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -4452,10 +4311,10 @@ SUBROUTINE FAST_UnPackLinFileType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%RotSpeed = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Azimuth = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%RotSpeed = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Azimuth = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE FAST_UnPackLinFileType SUBROUTINE FAST_CopyOutputFileType( SrcOutputFileTypeData, DstOutputFileTypeData, CtrlCode, ErrStat, ErrMsg ) @@ -4710,8 +4569,10 @@ SUBROUTINE FAST_PackOutputFileType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TimeData,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TimeData)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%TimeData))-1 ) = PACK(InData%TimeData,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%TimeData) + DO i1 = LBOUND(InData%TimeData,1), UBOUND(InData%TimeData,1) + DbKiBuf(Db_Xferred) = InData%TimeData(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%AllOutData) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4726,27 +4587,33 @@ SUBROUTINE FAST_PackOutputFileType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AllOutData,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AllOutData)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AllOutData))-1 ) = PACK(InData%AllOutData,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AllOutData) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%n_Out - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NOutSteps - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%numOuts))-1 ) = PACK(InData%numOuts,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%numOuts) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UnOu - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UnSum - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UnGra - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(InData%AllOutData,2), UBOUND(InData%AllOutData,2) + DO i1 = LBOUND(InData%AllOutData,1), UBOUND(InData%AllOutData,1) + ReKiBuf(Re_Xferred) = InData%AllOutData(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IntKiBuf(Int_Xferred) = InData%n_Out + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NOutSteps + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%numOuts,1), UBOUND(InData%numOuts,1) + IntKiBuf(Int_Xferred) = InData%numOuts(i1) + Int_Xferred = Int_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%UnOu + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%UnSum + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%UnGra + Int_Xferred = Int_Xferred + 1 DO i1 = LBOUND(InData%FileDescLines,1), UBOUND(InData%FileDescLines,1) - DO I = 1, LEN(InData%FileDescLines) - IntKiBuf(Int_Xferred) = ICHAR(InData%FileDescLines(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 + DO I = 1, LEN(InData%FileDescLines) + IntKiBuf(Int_Xferred) = ICHAR(InData%FileDescLines(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO IF ( .NOT. ALLOCATED(InData%ChannelNames) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4757,12 +4624,12 @@ SUBROUTINE FAST_PackOutputFileType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ChannelNames,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%ChannelNames,1), UBOUND(InData%ChannelNames,1) + DO i1 = LBOUND(InData%ChannelNames,1), UBOUND(InData%ChannelNames,1) DO I = 1, LEN(InData%ChannelNames) IntKiBuf(Int_Xferred) = ICHAR(InData%ChannelNames(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%ChannelUnits) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4774,12 +4641,12 @@ SUBROUTINE FAST_PackOutputFileType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ChannelUnits,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%ChannelUnits,1), UBOUND(InData%ChannelUnits,1) + DO i1 = LBOUND(InData%ChannelUnits,1), UBOUND(InData%ChannelUnits,1) DO I = 1, LEN(InData%ChannelUnits) IntKiBuf(Int_Xferred) = ICHAR(InData%ChannelUnits(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF DO i1 = LBOUND(InData%Module_Ver,1), UBOUND(InData%Module_Ver,1) CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Module_Ver(i1), ErrStat2, ErrMsg2, OnlySize ) ! Module_Ver @@ -4812,15 +4679,15 @@ SUBROUTINE FAST_PackOutputFileType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ENDIF END DO DO i1 = LBOUND(InData%Module_Abrev,1), UBOUND(InData%Module_Abrev,1) - DO I = 1, LEN(InData%Module_Abrev) - IntKiBuf(Int_Xferred) = ICHAR(InData%Module_Abrev(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%VTK_count - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%VTK_LastWaveIndx - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%Module_Abrev) + IntKiBuf(Int_Xferred) = ICHAR(InData%Module_Abrev(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + IntKiBuf(Int_Xferred) = InData%VTK_count + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%VTK_LastWaveIndx + Int_Xferred = Int_Xferred + 1 CALL FAST_Packlinfiletype( Re_Buf, Db_Buf, Int_Buf, InData%Lin, ErrStat2, ErrMsg2, OnlySize ) ! Lin CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4864,12 +4731,6 @@ SUBROUTINE FAST_UnPackOutputFileType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -4898,15 +4759,10 @@ SUBROUTINE FAST_UnPackOutputFileType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TimeData.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TimeData)>0) OutData%TimeData = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%TimeData))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%TimeData) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TimeData,1), UBOUND(OutData%TimeData,1) + OutData%TimeData(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AllOutData not allocated Int_Xferred = Int_Xferred + 1 @@ -4924,52 +4780,37 @@ SUBROUTINE FAST_UnPackOutputFileType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOutData.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%AllOutData)>0) OutData%AllOutData = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AllOutData))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AllOutData) - DEALLOCATE(mask2) - END IF - OutData%n_Out = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NOutSteps = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(OutData%AllOutData,2), UBOUND(OutData%AllOutData,2) + DO i1 = LBOUND(OutData%AllOutData,1), UBOUND(OutData%AllOutData,1) + OutData%AllOutData(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%n_Out = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NOutSteps = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%numOuts,1) i1_u = UBOUND(OutData%numOuts,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%numOuts = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%numOuts))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%numOuts) - DEALLOCATE(mask1) - OutData%UnOu = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%UnSum = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%UnGra = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%numOuts,1), UBOUND(OutData%numOuts,1) + OutData%numOuts(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + OutData%UnOu = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%UnSum = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%UnGra = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%FileDescLines,1) i1_u = UBOUND(OutData%FileDescLines,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. DO i1 = LBOUND(OutData%FileDescLines,1), UBOUND(OutData%FileDescLines,1) - DO I = 1, LEN(OutData%FileDescLines) - OutData%FileDescLines(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - DEALLOCATE(mask1) + DO I = 1, LEN(OutData%FileDescLines) + OutData%FileDescLines(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ChannelNames not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -4983,19 +4824,12 @@ SUBROUTINE FAST_UnPackOutputFileType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ChannelNames.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%ChannelNames,1), UBOUND(OutData%ChannelNames,1) + DO i1 = LBOUND(OutData%ChannelNames,1), UBOUND(OutData%ChannelNames,1) DO I = 1, LEN(OutData%ChannelNames) OutData%ChannelNames(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ChannelUnits not allocated Int_Xferred = Int_Xferred + 1 @@ -5010,19 +4844,12 @@ SUBROUTINE FAST_UnPackOutputFileType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ChannelUnits.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%ChannelUnits,1), UBOUND(OutData%ChannelUnits,1) + DO i1 = LBOUND(OutData%ChannelUnits,1), UBOUND(OutData%ChannelUnits,1) DO I = 1, LEN(OutData%ChannelUnits) OutData%ChannelUnits(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF i1_l = LBOUND(OutData%Module_Ver,1) i1_u = UBOUND(OutData%Module_Ver,1) @@ -5070,23 +4897,16 @@ SUBROUTINE FAST_UnPackOutputFileType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt END DO i1_l = LBOUND(OutData%Module_Abrev,1) i1_u = UBOUND(OutData%Module_Abrev,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. DO i1 = LBOUND(OutData%Module_Abrev,1), UBOUND(OutData%Module_Abrev,1) - DO I = 1, LEN(OutData%Module_Abrev) - OutData%Module_Abrev(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - DEALLOCATE(mask1) - OutData%VTK_count = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%VTK_LastWaveIndx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%Module_Abrev) + OutData%Module_Abrev(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + OutData%VTK_count = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%VTK_LastWaveIndx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -6095,8 +5915,12 @@ SUBROUTINE FAST_PackIceDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%InputTimes)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%InputTimes))-1 ) = PACK(InData%InputTimes,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%InputTimes) + DO i2 = LBOUND(InData%InputTimes,2), UBOUND(InData%InputTimes,2) + DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) + DbKiBuf(Db_Xferred) = InData%InputTimes(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF END SUBROUTINE FAST_PackIceDyn_Data @@ -6113,12 +5937,6 @@ SUBROUTINE FAST_UnPackIceDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -6679,15 +6497,12 @@ SUBROUTINE FAST_UnPackIceDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%InputTimes)>0) OutData%InputTimes = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%InputTimes))-1 ), mask2, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%InputTimes) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%InputTimes,2), UBOUND(OutData%InputTimes,2) + DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) + OutData%InputTimes(i1,i2) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF END SUBROUTINE FAST_UnPackIceDyn_Data @@ -7657,8 +7472,12 @@ SUBROUTINE FAST_PackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%InputTimes)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%InputTimes))-1 ) = PACK(InData%InputTimes,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%InputTimes) + DO i2 = LBOUND(InData%InputTimes,2), UBOUND(InData%InputTimes,2) + DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) + DbKiBuf(Db_Xferred) = InData%InputTimes(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF END SUBROUTINE FAST_PackBeamDyn_Data @@ -7675,12 +7494,6 @@ SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -8241,15 +8054,12 @@ SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%InputTimes)>0) OutData%InputTimes = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%InputTimes))-1 ), mask2, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%InputTimes) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%InputTimes,2), UBOUND(OutData%InputTimes,2) + DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) + OutData%InputTimes(i1,i2) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF END SUBROUTINE FAST_UnPackBeamDyn_Data @@ -8970,8 +8780,10 @@ SUBROUTINE FAST_PackElastoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%InputTimes)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%InputTimes))-1 ) = PACK(InData%InputTimes,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%InputTimes) + DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) + DbKiBuf(Db_Xferred) = InData%InputTimes(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF END SUBROUTINE FAST_PackElastoDyn_Data @@ -8988,12 +8800,6 @@ SUBROUTINE FAST_UnPackElastoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -9469,15 +9275,10 @@ SUBROUTINE FAST_UnPackElastoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%InputTimes)>0) OutData%InputTimes = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%InputTimes))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%InputTimes) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) + OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO END IF END SUBROUTINE FAST_UnPackElastoDyn_Data @@ -10112,8 +9913,10 @@ SUBROUTINE FAST_PackServoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%InputTimes)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%InputTimes))-1 ) = PACK(InData%InputTimes,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%InputTimes) + DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) + DbKiBuf(Db_Xferred) = InData%InputTimes(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF END SUBROUTINE FAST_PackServoDyn_Data @@ -10130,12 +9933,6 @@ SUBROUTINE FAST_UnPackServoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -10555,15 +10352,10 @@ SUBROUTINE FAST_UnPackServoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%InputTimes)>0) OutData%InputTimes = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%InputTimes))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%InputTimes) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) + OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO END IF END SUBROUTINE FAST_UnPackServoDyn_Data @@ -11198,8 +10990,10 @@ SUBROUTINE FAST_PackAeroDyn14_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%InputTimes)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%InputTimes))-1 ) = PACK(InData%InputTimes,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%InputTimes) + DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) + DbKiBuf(Db_Xferred) = InData%InputTimes(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF END SUBROUTINE FAST_PackAeroDyn14_Data @@ -11216,12 +11010,6 @@ SUBROUTINE FAST_UnPackAeroDyn14_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -11641,15 +11429,10 @@ SUBROUTINE FAST_UnPackAeroDyn14_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%InputTimes)>0) OutData%InputTimes = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%InputTimes))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%InputTimes) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) + OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO END IF END SUBROUTINE FAST_UnPackAeroDyn14_Data @@ -12284,8 +12067,10 @@ SUBROUTINE FAST_PackAeroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%InputTimes)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%InputTimes))-1 ) = PACK(InData%InputTimes,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%InputTimes) + DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) + DbKiBuf(Db_Xferred) = InData%InputTimes(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF END SUBROUTINE FAST_PackAeroDyn_Data @@ -12302,12 +12087,6 @@ SUBROUTINE FAST_UnPackAeroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -12727,15 +12506,10 @@ SUBROUTINE FAST_UnPackAeroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%InputTimes)>0) OutData%InputTimes = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%InputTimes))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%InputTimes) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) + OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO END IF END SUBROUTINE FAST_UnPackAeroDyn_Data @@ -13370,8 +13144,10 @@ SUBROUTINE FAST_PackInflowWind_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%InputTimes)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%InputTimes))-1 ) = PACK(InData%InputTimes,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%InputTimes) + DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) + DbKiBuf(Db_Xferred) = InData%InputTimes(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF END SUBROUTINE FAST_PackInflowWind_Data @@ -13388,12 +13164,6 @@ SUBROUTINE FAST_UnPackInflowWind_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -13813,15 +13583,10 @@ SUBROUTINE FAST_UnPackInflowWind_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%InputTimes)>0) OutData%InputTimes = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%InputTimes))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%InputTimes) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) + OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO END IF END SUBROUTINE FAST_UnPackInflowWind_Data @@ -14126,12 +13891,6 @@ SUBROUTINE FAST_UnPackOpenFOAM_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackOpenFOAM_Data' @@ -14559,12 +14318,6 @@ SUBROUTINE FAST_UnPackSuperController_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackSuperController_Data' @@ -15331,8 +15084,10 @@ SUBROUTINE FAST_PackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%InputTimes)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%InputTimes))-1 ) = PACK(InData%InputTimes,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%InputTimes) + DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) + DbKiBuf(Db_Xferred) = InData%InputTimes(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF END SUBROUTINE FAST_PackSubDyn_Data @@ -15349,12 +15104,6 @@ SUBROUTINE FAST_UnPackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -15774,15 +15523,10 @@ SUBROUTINE FAST_UnPackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%InputTimes)>0) OutData%InputTimes = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%InputTimes))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%InputTimes) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) + OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO END IF END SUBROUTINE FAST_UnPackSubDyn_Data @@ -16417,8 +16161,10 @@ SUBROUTINE FAST_PackExtPtfm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%InputTimes)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%InputTimes))-1 ) = PACK(InData%InputTimes,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%InputTimes) + DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) + DbKiBuf(Db_Xferred) = InData%InputTimes(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF END SUBROUTINE FAST_PackExtPtfm_Data @@ -16435,12 +16181,6 @@ SUBROUTINE FAST_UnPackExtPtfm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -16860,15 +16600,10 @@ SUBROUTINE FAST_UnPackExtPtfm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%InputTimes)>0) OutData%InputTimes = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%InputTimes))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%InputTimes) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) + OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO END IF END SUBROUTINE FAST_UnPackExtPtfm_Data @@ -17503,8 +17238,10 @@ SUBROUTINE FAST_PackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%InputTimes)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%InputTimes))-1 ) = PACK(InData%InputTimes,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%InputTimes) + DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) + DbKiBuf(Db_Xferred) = InData%InputTimes(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF END SUBROUTINE FAST_PackHydroDyn_Data @@ -17521,12 +17258,6 @@ SUBROUTINE FAST_UnPackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -17946,15 +17677,10 @@ SUBROUTINE FAST_UnPackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%InputTimes)>0) OutData%InputTimes = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%InputTimes))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%InputTimes) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) + OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO END IF END SUBROUTINE FAST_UnPackHydroDyn_Data @@ -18589,8 +18315,10 @@ SUBROUTINE FAST_PackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%InputTimes)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%InputTimes))-1 ) = PACK(InData%InputTimes,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%InputTimes) + DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) + DbKiBuf(Db_Xferred) = InData%InputTimes(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF END SUBROUTINE FAST_PackIceFloe_Data @@ -18607,12 +18335,6 @@ SUBROUTINE FAST_UnPackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -19032,15 +18754,10 @@ SUBROUTINE FAST_UnPackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%InputTimes)>0) OutData%InputTimes = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%InputTimes))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%InputTimes) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) + OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO END IF END SUBROUTINE FAST_UnPackIceFloe_Data @@ -19667,8 +19384,10 @@ SUBROUTINE FAST_PackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%InputTimes)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%InputTimes))-1 ) = PACK(InData%InputTimes,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%InputTimes) + DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) + DbKiBuf(Db_Xferred) = InData%InputTimes(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF END SUBROUTINE FAST_PackMAP_Data @@ -19685,12 +19404,6 @@ SUBROUTINE FAST_UnPackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -20106,15 +19819,10 @@ SUBROUTINE FAST_UnPackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%InputTimes)>0) OutData%InputTimes = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%InputTimes))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%InputTimes) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) + OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO END IF END SUBROUTINE FAST_UnPackMAP_Data @@ -20749,8 +20457,10 @@ SUBROUTINE FAST_PackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%InputTimes)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%InputTimes))-1 ) = PACK(InData%InputTimes,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%InputTimes) + DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) + DbKiBuf(Db_Xferred) = InData%InputTimes(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF END SUBROUTINE FAST_PackFEAMooring_Data @@ -20767,12 +20477,6 @@ SUBROUTINE FAST_UnPackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -21192,15 +20896,10 @@ SUBROUTINE FAST_UnPackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%InputTimes)>0) OutData%InputTimes = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%InputTimes))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%InputTimes) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) + OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO END IF END SUBROUTINE FAST_UnPackFEAMooring_Data @@ -21835,8 +21534,10 @@ SUBROUTINE FAST_PackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%InputTimes)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%InputTimes))-1 ) = PACK(InData%InputTimes,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%InputTimes) + DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) + DbKiBuf(Db_Xferred) = InData%InputTimes(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF END SUBROUTINE FAST_PackMoorDyn_Data @@ -21853,12 +21554,6 @@ SUBROUTINE FAST_UnPackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -22278,15 +21973,10 @@ SUBROUTINE FAST_UnPackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%InputTimes)>0) OutData%InputTimes = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%InputTimes))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%InputTimes) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) + OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO END IF END SUBROUTINE FAST_UnPackMoorDyn_Data @@ -22921,8 +22611,10 @@ SUBROUTINE FAST_PackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%InputTimes)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%InputTimes))-1 ) = PACK(InData%InputTimes,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%InputTimes) + DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) + DbKiBuf(Db_Xferred) = InData%InputTimes(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF END SUBROUTINE FAST_PackOrcaFlex_Data @@ -22939,12 +22631,6 @@ SUBROUTINE FAST_UnPackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -23364,15 +23050,10 @@ SUBROUTINE FAST_UnPackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%InputTimes)>0) OutData%InputTimes = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%InputTimes))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%InputTimes) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) + OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO END IF END SUBROUTINE FAST_UnPackOrcaFlex_Data @@ -25788,8 +25469,12 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jacobian_Opt1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Jacobian_Opt1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Jacobian_Opt1))-1 ) = PACK(InData%Jacobian_Opt1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Jacobian_Opt1) + DO i2 = LBOUND(InData%Jacobian_Opt1,2), UBOUND(InData%Jacobian_Opt1,2) + DO i1 = LBOUND(InData%Jacobian_Opt1,1), UBOUND(InData%Jacobian_Opt1,1) + ReKiBuf(Re_Xferred) = InData%Jacobian_Opt1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Jacobian_pivot) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -25801,8 +25486,10 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jacobian_pivot,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Jacobian_pivot)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%Jacobian_pivot))-1 ) = PACK(InData%Jacobian_pivot,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%Jacobian_pivot) + DO i1 = LBOUND(InData%Jacobian_pivot,1), UBOUND(InData%Jacobian_pivot,1) + IntKiBuf(Int_Xferred) = InData%Jacobian_pivot(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%Jac_u_indx) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -25817,8 +25504,12 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Jac_u_indx)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%Jac_u_indx))-1 ) = PACK(InData%Jac_u_indx,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%Jac_u_indx) + DO i2 = LBOUND(InData%Jac_u_indx,2), UBOUND(InData%Jac_u_indx,2) + DO i1 = LBOUND(InData%Jac_u_indx,1), UBOUND(InData%Jac_u_indx,1) + IntKiBuf(Int_Xferred) = InData%Jac_u_indx(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF CALL MeshPack( InData%u_ED_PlatformPtMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_ED_PlatformPtMesh CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -26253,12 +25944,6 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -27714,15 +27399,12 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jacobian_Opt1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Jacobian_Opt1)>0) OutData%Jacobian_Opt1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Jacobian_Opt1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Jacobian_Opt1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Jacobian_Opt1,2), UBOUND(OutData%Jacobian_Opt1,2) + DO i1 = LBOUND(OutData%Jacobian_Opt1,1), UBOUND(OutData%Jacobian_Opt1,1) + OutData%Jacobian_Opt1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jacobian_pivot not allocated Int_Xferred = Int_Xferred + 1 @@ -27737,15 +27419,10 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jacobian_pivot.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Jacobian_pivot)>0) OutData%Jacobian_pivot = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%Jacobian_pivot))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%Jacobian_pivot) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Jacobian_pivot,1), UBOUND(OutData%Jacobian_pivot,1) + OutData%Jacobian_pivot(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_u_indx not allocated Int_Xferred = Int_Xferred + 1 @@ -27763,15 +27440,12 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Jac_u_indx)>0) OutData%Jac_u_indx = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%Jac_u_indx))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%Jac_u_indx) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Jac_u_indx,2), UBOUND(OutData%Jac_u_indx,2) + DO i1 = LBOUND(OutData%Jac_u_indx,1), UBOUND(OutData%Jac_u_indx,1) + OutData%Jac_u_indx(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -28471,20 +28145,24 @@ SUBROUTINE FAST_PackExternInputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GenTrq - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ElecPwr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawPosCom - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawRateCom - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlPitchCom))-1 ) = PACK(InData%BlPitchCom,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlPitchCom) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HSSBrFrac - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LidarFocus))-1 ) = PACK(InData%LidarFocus,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LidarFocus) + ReKiBuf(Re_Xferred) = InData%GenTrq + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ElecPwr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawPosCom + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawRateCom + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%BlPitchCom,1), UBOUND(InData%BlPitchCom,1) + ReKiBuf(Re_Xferred) = InData%BlPitchCom(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%HSSBrFrac + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%LidarFocus,1), UBOUND(InData%LidarFocus,1) + ReKiBuf(Re_Xferred) = InData%LidarFocus(i1) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE FAST_PackExternInputType SUBROUTINE FAST_UnPackExternInputType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -28500,12 +28178,6 @@ SUBROUTINE FAST_UnPackExternInputType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -28520,38 +28192,28 @@ SUBROUTINE FAST_UnPackExternInputType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%GenTrq = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%ElecPwr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawPosCom = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawRateCom = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%GenTrq = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%ElecPwr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawPosCom = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawRateCom = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%BlPitchCom,1) i1_u = UBOUND(OutData%BlPitchCom,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%BlPitchCom = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlPitchCom))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlPitchCom) - DEALLOCATE(mask1) - OutData%HSSBrFrac = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%BlPitchCom,1), UBOUND(OutData%BlPitchCom,1) + OutData%BlPitchCom(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%HSSBrFrac = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%LidarFocus,1) i1_u = UBOUND(OutData%LidarFocus,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%LidarFocus = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LidarFocus))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LidarFocus) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LidarFocus,1), UBOUND(OutData%LidarFocus,1) + OutData%LidarFocus(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE FAST_UnPackExternInputType SUBROUTINE FAST_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -28686,24 +28348,28 @@ SUBROUTINE FAST_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TiLstPrn - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%t_global - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%NextJacCalcTime - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PrevClockTime - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%UsrTime1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%UsrTime2 - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%StrtTime))-1 ) = PACK(InData%StrtTime,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%StrtTime) - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%SimStrtTime))-1 ) = PACK(InData%SimStrtTime,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%SimStrtTime) - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%calcJacobian , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%TiLstPrn + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%t_global + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%NextJacCalcTime + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PrevClockTime + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%UsrTime1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%UsrTime2 + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%StrtTime,1), UBOUND(InData%StrtTime,1) + IntKiBuf(Int_Xferred) = InData%StrtTime(i1) + Int_Xferred = Int_Xferred + 1 + END DO + DO i1 = LBOUND(InData%SimStrtTime,1), UBOUND(InData%SimStrtTime,1) + IntKiBuf(Int_Xferred) = InData%SimStrtTime(i1) + Int_Xferred = Int_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = TRANSFER(InData%calcJacobian, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 CALL FAST_Packexterninputtype( Re_Buf, Db_Buf, Int_Buf, InData%ExternInput, ErrStat2, ErrMsg2, OnlySize ) ! ExternInput CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -28732,8 +28398,8 @@ SUBROUTINE FAST_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NextLinTimeIndx - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NextLinTimeIndx + Int_Xferred = Int_Xferred + 1 END SUBROUTINE FAST_PackMisc SUBROUTINE FAST_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -28749,12 +28415,6 @@ SUBROUTINE FAST_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -28769,42 +28429,32 @@ SUBROUTINE FAST_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%TiLstPrn = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%t_global = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%NextJacCalcTime = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%PrevClockTime = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%UsrTime1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%UsrTime2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%TiLstPrn = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%t_global = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%NextJacCalcTime = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%PrevClockTime = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%UsrTime1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%UsrTime2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%StrtTime,1) i1_u = UBOUND(OutData%StrtTime,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%StrtTime = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%StrtTime))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%StrtTime) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%StrtTime,1), UBOUND(OutData%StrtTime,1) + OutData%StrtTime(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO i1_l = LBOUND(OutData%SimStrtTime,1) i1_u = UBOUND(OutData%SimStrtTime,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%SimStrtTime = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%SimStrtTime))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%SimStrtTime) - DEALLOCATE(mask1) - OutData%calcJacobian = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%SimStrtTime,1), UBOUND(OutData%SimStrtTime,1) + OutData%SimStrtTime(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + OutData%calcJacobian = TRANSFER(IntKiBuf(Int_Xferred), OutData%calcJacobian) + Int_Xferred = Int_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -28845,8 +28495,8 @@ SUBROUTINE FAST_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%NextLinTimeIndx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NextLinTimeIndx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE FAST_UnPackMisc SUBROUTINE FAST_CopyExternInitType( SrcExternInitTypeData, DstExternInitTypeData, CtrlCode, ErrStat, ErrMsg ) @@ -28967,36 +28617,44 @@ SUBROUTINE FAST_PackExternInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%Tmax - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%SensorType - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%LidRadialVel , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TurbineID - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TurbinePos))-1 ) = PACK(InData%TurbinePos,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TurbinePos) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumSC2Ctrl - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumCtrl2SC - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%FarmIntegration , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%windGrid_n))-1 ) = PACK(InData%windGrid_n,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%windGrid_n) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%windGrid_delta))-1 ) = PACK(InData%windGrid_delta,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%windGrid_delta) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%windGrid_pZero))-1 ) = PACK(InData%windGrid_pZero,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%windGrid_pZero) - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumActForcePtsBlade - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumActForcePtsTower - Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%Tmax + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%SensorType + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%LidRadialVel, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TurbineID + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%TurbinePos,1), UBOUND(InData%TurbinePos,1) + ReKiBuf(Re_Xferred) = InData%TurbinePos(i1) + Re_Xferred = Re_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%NumSC2Ctrl + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumCtrl2SC + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%FarmIntegration, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%windGrid_n,1), UBOUND(InData%windGrid_n,1) + IntKiBuf(Int_Xferred) = InData%windGrid_n(i1) + Int_Xferred = Int_Xferred + 1 + END DO + DO i1 = LBOUND(InData%windGrid_delta,1), UBOUND(InData%windGrid_delta,1) + ReKiBuf(Re_Xferred) = InData%windGrid_delta(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%windGrid_pZero,1), UBOUND(InData%windGrid_pZero,1) + ReKiBuf(Re_Xferred) = InData%windGrid_pZero(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%NumActForcePtsBlade + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumActForcePtsTower + Int_Xferred = Int_Xferred + 1 END SUBROUTINE FAST_PackExternInitType SUBROUTINE FAST_UnPackExternInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -29012,12 +28670,6 @@ SUBROUTINE FAST_UnPackExternInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -29032,72 +28684,52 @@ SUBROUTINE FAST_UnPackExternInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%Tmax = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%SensorType = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%LidRadialVel = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%TurbineID = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%Tmax = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%SensorType = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%LidRadialVel = TRANSFER(IntKiBuf(Int_Xferred), OutData%LidRadialVel) + Int_Xferred = Int_Xferred + 1 + OutData%TurbineID = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%TurbinePos,1) i1_u = UBOUND(OutData%TurbinePos,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%TurbinePos = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TurbinePos))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TurbinePos) - DEALLOCATE(mask1) - OutData%NumSC2Ctrl = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumCtrl2SC = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%FarmIntegration = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%TurbinePos,1), UBOUND(OutData%TurbinePos,1) + OutData%TurbinePos(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%NumSC2Ctrl = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumCtrl2SC = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%FarmIntegration = TRANSFER(IntKiBuf(Int_Xferred), OutData%FarmIntegration) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%windGrid_n,1) i1_u = UBOUND(OutData%windGrid_n,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%windGrid_n = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%windGrid_n))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%windGrid_n) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%windGrid_n,1), UBOUND(OutData%windGrid_n,1) + OutData%windGrid_n(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO i1_l = LBOUND(OutData%windGrid_delta,1) i1_u = UBOUND(OutData%windGrid_delta,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%windGrid_delta = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%windGrid_delta))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%windGrid_delta) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%windGrid_delta,1), UBOUND(OutData%windGrid_delta,1) + OutData%windGrid_delta(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%windGrid_pZero,1) i1_u = UBOUND(OutData%windGrid_pZero,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%windGrid_pZero = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%windGrid_pZero))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%windGrid_pZero) - DEALLOCATE(mask1) - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%NumActForcePtsBlade = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumActForcePtsTower = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%windGrid_pZero,1), UBOUND(OutData%windGrid_pZero,1) + OutData%windGrid_pZero(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%NumActForcePtsBlade = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumActForcePtsTower = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE FAST_UnPackExternInitType SUBROUTINE FAST_CopyTurbineType( SrcTurbineTypeData, DstTurbineTypeData, CtrlCode, ErrStat, ErrMsg ) @@ -29633,8 +29265,8 @@ SUBROUTINE FAST_PackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TurbID - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TurbID + Int_Xferred = Int_Xferred + 1 CALL FAST_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p_FAST, ErrStat2, ErrMsg2, OnlySize ) ! p_FAST CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -30238,12 +29870,6 @@ SUBROUTINE FAST_UnPackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackTurbineType' @@ -30257,8 +29883,8 @@ SUBROUTINE FAST_UnPackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%TurbID = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%TurbID = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN diff --git a/modules/openfast-registry/src/Makefile b/modules/openfast-registry/src/Makefile deleted file mode 100644 index 921149cd0e..0000000000 --- a/modules/openfast-registry/src/Makefile +++ /dev/null @@ -1,67 +0,0 @@ -ifeq ($(OS),Windows_NT) - ifeq ($(OSTYPE),cygwin) - RM=rm -f - else - RM=del - endif -else - RM = rm -f -endif -.SUFFIXES: .c .o - -# i586-mingw32msvc-gcc -#CC_TOOLS = i586-mingw32msvc-gcc -CC_TOOLS = gcc -DEST_DIR = .. -CFLAGS = #-ansi -LDFLAGS = -DEBUG = -g -OBJ = registry.o \ - my_strtok.o \ - reg_parse.o \ - data.o \ - type.o \ - misc.o \ - sym.o \ - symtab_gen.o \ - gen_module_files.o \ - gen_c_types.o - -# marco's: all : $(OBJ) -$(DEST_DIR)/registry.exe : $(OBJ) - $(CC_TOOLS) -o $(DEST_DIR)/registry.exe $(DEBUG) $(LDFLAGS) $(OBJ) - -.c.o : - $(CC_TOOLS) $(CFLAGS) -c $(DEBUG) $< - -clean clena: - $(RM) $(OBJ) gen_comms.c standard.o - -superclean : clean - $(RM) $(DEST_DIR)/registry.exe Registry_tmp.* - -# regenerate this list with "makedepend -Y *.c" - -# DO NOT DELETE THIS LINE -- make depend depends on it. - -gen_module_files.o: protos.h registry.h data.h FAST_preamble.h type.o - -data.o: registry.h protos.h data.h -gen_allocs.o: protos.h registry.h data.h -gen_args.o: protos.h registry.h data.h -gen_scalar_derefs.o: protos.h registry.h data.h -gen_config.o: protos.h registry.h data.h -gen_defs.o: protos.h registry.h data.h -gen_mod_state_descr.o: protos.h registry.h data.h -gen_model_data_ord.o: protos.h registry.h data.h -gen_scalar_indices.o: protos.h registry.h data.h -gen_wrf_io.o: protos.h registry.h data.h -misc.o: protos.h registry.h data.h -my_strtok.o: registry.h protos.h data.h -reg_parse.o: registry.h protos.h data.h -registry.o: protos.h registry.h data.h Template_data.c Template_registry.c -sym.o: sym.h -type.o: registry.h protos.h data.h -gen_interp.o: registry.h protos.h data.h -gen_streams.o: registry.h protos.h data.h -gen_c_types.o: registry.h protos.h data.h diff --git a/modules/openfast-registry/src/data.h b/modules/openfast-registry/src/data.h index 80c0101bd9..bc81980c73 100644 --- a/modules/openfast-registry/src/data.h +++ b/modules/openfast-registry/src/data.h @@ -37,7 +37,7 @@ typedef struct node_struct { /* CTRL */ - int gen_wrapper ; + int gen_periodic ; struct node_struct * next ; /* fields used by rconfig nodes */ diff --git a/modules/openfast-registry/src/gen_c_types.c b/modules/openfast-registry/src/gen_c_types.c index 1e329624ce..74bd14d662 100644 --- a/modules/openfast-registry/src/gen_c_types.c +++ b/modules/openfast-registry/src/gen_c_types.c @@ -377,7 +377,10 @@ gen_c_module( FILE * fph, node_t * ModName ) fprintf(fph," %s * %s ; ",C_type( r->type->mapsto), r->name ) ; fprintf(fph," int %s_Len ;",r->name ) ; } else { - char *p = r->type->mapsto, buf[10]; + char *p = r->type->mapsto; + char buf[10]; +// bjj: this assumes all character strings are defined with numeric lengths +// It should be modified to allow use of parameters, too. (and parameters defined in the registry should also be defined in the .h file) while (*p) { if (isdigit(*p)) { long val = strtol(p, &p, 10); @@ -385,6 +388,8 @@ gen_c_module( FILE * fph, node_t * ModName ) } else { p++; } + + } if (strcmp(C_type(r->type->mapsto), "char") == 0 ){ // if it's a char we need to add the array size if (r->ndims == 0) diff --git a/modules/openfast-registry/src/gen_module_files.c b/modules/openfast-registry/src/gen_module_files.c index 84f912c9ba..e287eed479 100644 --- a/modules/openfast-registry/src/gen_module_files.c +++ b/modules/openfast-registry/src/gen_module_files.c @@ -33,13 +33,20 @@ gen_copy_c2f( FILE *fp , // *.f90 file we are writting to remove_nickname(ModName->nickname,inout,nonick) ; append_nickname((is_a_fast_interface_type(inoutlong))?ModName->nickname:"",inoutlong,addnick) ; - fprintf(fp," SUBROUTINE %s_C2Fary_Copy%s( %sData, ErrStat, ErrMsg )\n", ModName->nickname, nonick,nonick ); + fprintf(fp," SUBROUTINE %s_C2Fary_Copy%s( %sData, ErrStat, ErrMsg, SkipPointers )\n", ModName->nickname, nonick,nonick ); fprintf(fp," TYPE(%s), INTENT(INOUT) :: %sData\n" , addnick, nonick ); fprintf(fp," INTEGER(IntKi), INTENT( OUT) :: ErrStat\n" ); fprintf(fp," CHARACTER(*), INTENT( OUT) :: ErrMsg\n" ); + fprintf(fp," LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers\n" ); fprintf(fp," ! \n" ); + fprintf(fp," LOGICAL :: SkipPointers_local\n"); fprintf(fp," ErrStat = ErrID_None\n" ); - fprintf(fp," ErrMsg = \"\"\n" ); + fprintf(fp," ErrMsg = \"\"\n\n" ); + fprintf(fp," IF (PRESENT(SkipPointers)) THEN\n"); + fprintf(fp," SkipPointers_local = SkipPointers\n"); + fprintf(fp," ELSE\n"); + fprintf(fp," SkipPointers_local = .false.\n"); + fprintf(fp," END IF\n"); sprintf(tmp,"%s",addnick) ; @@ -55,11 +62,13 @@ gen_copy_c2f( FILE *fp , // *.f90 file we are writting to } else { if ( is_pointer(r) ) { fprintf(fp,"\n ! -- %s %s Data fields\n",r->name,nonick) ; - fprintf(fp," IF ( .NOT. C_ASSOCIATED( %sData%%C_obj%%%s ) ) THEN\n",nonick,r->name) ; - fprintf(fp," NULLIFY( %sData%%%s )\n",nonick,r->name) ; - fprintf(fp," ELSE\n") ; - fprintf(fp," CALL C_F_POINTER(%sData%%C_obj%%%s, %sData%%%s, (/%sData%%C_obj%%%s_Len/))\n",nonick,r->name,nonick,r->name,nonick,r->name) ; - fprintf(fp," END IF\n") ; + fprintf(fp," IF ( .NOT. SkipPointers_local ) THEN\n"); + fprintf(fp," IF ( .NOT. C_ASSOCIATED( %sData%%C_obj%%%s ) ) THEN\n",nonick,r->name) ; + fprintf(fp," NULLIFY( %sData%%%s )\n",nonick,r->name) ; + fprintf(fp," ELSE\n") ; + fprintf(fp," CALL C_F_POINTER(%sData%%C_obj%%%s, %sData%%%s, (/%sData%%C_obj%%%s_Len/))\n",nonick,r->name,nonick,r->name,nonick,r->name) ; + fprintf(fp," END IF\n") ; + fprintf(fp, " END IF\n"); } else if (!has_deferred_dim(r, 0)) { if (!strcmp(r->type->mapsto, "REAL(ReKi)") || @@ -86,6 +95,87 @@ gen_copy_c2f( FILE *fp , // *.f90 file we are writting to return(0) ; } +int +gen_copy_f2c(FILE *fp, // *.f90 file we are writting to + const node_t *ModName, // module name + char *inout, // character string written out + char *inoutlong) // not sure what this is used for +{ + node_t *q, *r; + char tmp[NAMELEN]; + char addnick[NAMELEN]; + char nonick[NAMELEN]; + + remove_nickname(ModName->nickname, inout, nonick); + append_nickname((is_a_fast_interface_type(inoutlong)) ? ModName->nickname : "", inoutlong, addnick); + fprintf(fp, " SUBROUTINE %s_F2C_Copy%s( %sData, ErrStat, ErrMsg, SkipPointers )\n", ModName->nickname, nonick, nonick); + fprintf(fp, " TYPE(%s), INTENT(INOUT) :: %sData\n", addnick, nonick); + fprintf(fp, " INTEGER(IntKi), INTENT( OUT) :: ErrStat\n"); + fprintf(fp, " CHARACTER(*), INTENT( OUT) :: ErrMsg\n"); + fprintf(fp, " LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers\n"); + fprintf(fp, " ! \n"); + fprintf(fp, " LOGICAL :: SkipPointers_local\n"); + fprintf(fp, " ErrStat = ErrID_None\n"); + fprintf(fp, " ErrMsg = \"\"\n\n"); + fprintf(fp, " IF (PRESENT(SkipPointers)) THEN\n"); + fprintf(fp, " SkipPointers_local = SkipPointers\n"); + fprintf(fp, " ELSE\n"); + fprintf(fp, " SkipPointers_local = .false.\n"); + fprintf(fp, " END IF\n"); + + sprintf(tmp, "%s", addnick); + + if ((q = get_entry(make_lower_temp(tmp), ModName->module_ddt_list)) == NULL) + { + fprintf(stderr, "Registry warning: generating %s_F2C_Copy%s: cannot find definition for %s\n", ModName->nickname, nonick, tmp); + } + else { + for (r = q->fields; r; r = r->next) + { + if (r->type != NULL) { + if (r->type->type_type == DERIVED) { // && ! r->type->usefrom + fprintf(stderr, "Registry WARNING: derived data type %s of type %s is not passed through F-C interface\n", r->name, r->type->name); + } + else { + if (is_pointer(r)) { + fprintf(fp, "\n ! -- %s %s Data fields\n", r->name, nonick); + fprintf(fp, " IF ( .NOT. SkipPointers_local ) THEN\n"); + fprintf(fp, " IF ( .NOT. %s(%sData%%%s)) THEN \n", assoc_or_allocated(r), nonick, r->name); + fprintf(fp, " %sData%%c_obj%%%s_Len = 0\n", nonick, r->name); + fprintf(fp, " %sData%%c_obj%%%s = C_NULL_PTR\n", nonick, r->name); + fprintf(fp, " ELSE\n"); + fprintf(fp, " %sData%%c_obj%%%s_Len = SIZE(%sData%%%s)\n", nonick, r->name, nonick, r->name); + fprintf(fp, " IF (%sData%%c_obj%%%s_Len > 0) &\n", nonick, r->name); + fprintf(fp, " %sData%%c_obj%%%s = C_LOC( %sData%%%s( LBOUND(%sData%%%s,1) ) ) \n", nonick, r->name, nonick, r->name, nonick, r->name ); + fprintf(fp, " END IF\n"); + fprintf(fp, " END IF\n"); + } + else if (!has_deferred_dim(r, 0)) { + if (!strcmp(r->type->mapsto, "REAL(ReKi)") || + !strcmp(r->type->mapsto, "REAL(SiKi)") || + !strcmp(r->type->mapsto, "REAL(DbKi)") || + !strcmp(r->type->mapsto, "REAL(R8Ki)") || + !strcmp(r->type->mapsto, "INTEGER(IntKi)") || + !strcmp(r->type->mapsto, "LOGICAL")) + { + fprintf(fp, " %sData%%C_obj%%%s = %sData%%%s\n", nonick, r->name, nonick, r->name); + } + else { // characters need to be copied differently + if (r->ndims == 0) { + //fprintf(stderr, "Registry WARNING: character data type %s of type %s is not passed through F-C interface\n", r->name, r->type->name); + fprintf(fp, " %sData%%C_obj%%%s = TRANSFER(%sData%%%s, %sData%%C_obj%%%s )\n", nonick, r->name, nonick, r->name, nonick, r->name); + } + } + } + } + } + } + } + + fprintf(fp, " END SUBROUTINE %s_F2C_Copy%s\n\n", ModName->nickname, nonick); + return(0); +} + int gen_copy( FILE * fp, const node_t * ModName, char * inout, char * inoutlong, const node_t * q_in ) @@ -190,13 +280,14 @@ gen_copy( FILE * fp, const node_t * ModName, char * inout, char * inoutlong, con fprintf(fp, " Dst%sData%%%s = Src%sData%%%s\n",nonick,r->name,nonick,r->name) ; if (sw_ccode && !is_pointer(r)){ - if (!strcmp(r->type->mapsto, "REAL(ReKi)") || - !strcmp(r->type->mapsto, "REAL(SiKi)") || - !strcmp(r->type->mapsto, "REAL(DbKi)") || - !strcmp(r->type->mapsto, "REAL(R8Ki)") || - !strcmp(r->type->mapsto, "INTEGER(IntKi)") || - !strcmp(r->type->mapsto, "LOGICAL") || - r->ndims == 0) + //if (!strcmp(r->type->mapsto, "REAL(ReKi)") || + // !strcmp(r->type->mapsto, "REAL(SiKi)") || + // !strcmp(r->type->mapsto, "REAL(DbKi)") || + // !strcmp(r->type->mapsto, "REAL(R8Ki)") || + // !strcmp(r->type->mapsto, "INTEGER(IntKi)") || + // !strcmp(r->type->mapsto, "LOGICAL") || + // r->ndims == 0) + if ( r->ndims == 0 ) // scalar of any type OR a character array { // fprintf(fp, " Dst%sData%%C_obj%%%s = Dst%sData%%%s\n", nonick, r->name, nonick, r->name); fprintf(fp, " Dst%sData%%C_obj%%%s = Src%sData%%C_obj%%%s\n", nonick, r->name, nonick, r->name); @@ -221,10 +312,10 @@ void gen_pack( FILE * fp, const node_t * ModName, char * inout, char *inoutlong ) { - char tmp[NAMELEN], tmp2[NAMELEN], tmp3[NAMELEN], addnick[NAMELEN], nonick[NAMELEN] ; - char nonick2[NAMELEN]; + char tmp[NAMELEN], tmp2[NAMELEN], addnick[NAMELEN], nonick[NAMELEN] ; + char nonick2[NAMELEN], indent[NAMELEN], mainIndent[6]; node_t *q, * r ; - int frst, d; + int frst, d, i; remove_nickname(ModName->nickname,inout,nonick) ; append_nickname((is_a_fast_interface_type(inoutlong))?ModName->nickname:"",inoutlong,addnick) ; @@ -416,26 +507,26 @@ gen_pack( FILE * fp, const node_t * ModName, char * inout, char *inoutlong ) for ( r = q->fields ; r ; r = r->next ) { - if (has_deferred_dim(r, 0)){ - // store whether the data type is allocated and the bounds of each dimension - fprintf(fp, " IF ( .NOT. %s(InData%%%s) ) THEN\n", assoc_or_allocated(r), r->name); - fprintf(fp, " IntKiBuf( Int_Xferred ) = 0\n"); // not allocated - fprintf(fp, " Int_Xferred = Int_Xferred + 1\n"); - //fprintf(fp, " IntKiBuf( Int_Xferred:Int_Xferred+2*%d-1 ) = 0\n", r->ndims, r->name); - //fprintf(fp, " Int_Xferred = Int_Xferred + 2*%d\n", r->ndims); - fprintf(fp, " ELSE\n"); - fprintf(fp, " IntKiBuf( Int_Xferred ) = 1\n"); // allocated - fprintf(fp, " Int_Xferred = Int_Xferred + 1\n"); - for (d = 1; d <= r->ndims; d++) { - fprintf(fp, " IntKiBuf( Int_Xferred ) = LBOUND(InData%%%s,%d)\n", r->name, d); - fprintf(fp, " IntKiBuf( Int_Xferred + 1) = UBOUND(InData%%%s,%d)\n", r->name, d); - fprintf(fp, " Int_Xferred = Int_Xferred + 2\n"); - } - fprintf(fp, "\n"); - sprintf(tmp3, " IF (SIZE(InData%%%s)>0)", r->name); - } - else{ - sprintf(tmp3, " "); + if (has_deferred_dim(r, 0)) { + // store whether the data type is allocated and the bounds of each dimension + fprintf(fp, " IF ( .NOT. %s(InData%%%s) ) THEN\n", assoc_or_allocated(r), r->name); + fprintf(fp, " IntKiBuf( Int_Xferred ) = 0\n"); // not allocated + fprintf(fp, " Int_Xferred = Int_Xferred + 1\n"); + //fprintf(fp, " IntKiBuf( Int_Xferred:Int_Xferred+2*%d-1 ) = 0\n", r->ndims, r->name); + //fprintf(fp, " Int_Xferred = Int_Xferred + 2*%d\n", r->ndims); + fprintf(fp, " ELSE\n"); + fprintf(fp, " IntKiBuf( Int_Xferred ) = 1\n"); // allocated + fprintf(fp, " Int_Xferred = Int_Xferred + 1\n"); + for (d = 1; d <= r->ndims; d++) { + fprintf(fp, " IntKiBuf( Int_Xferred ) = LBOUND(InData%%%s,%d)\n", r->name, d); + fprintf(fp, " IntKiBuf( Int_Xferred + 1) = UBOUND(InData%%%s,%d)\n", r->name, d); + fprintf(fp, " Int_Xferred = Int_Xferred + 2\n"); + } + fprintf(fp, "\n"); + strcpy(mainIndent, " "); + } + else { + strcpy(mainIndent, ""); } @@ -500,63 +591,55 @@ gen_pack( FILE * fp, const node_t * ModName, char * inout, char *inoutlong ) } } - else { // intrinsic data types + else { + // intrinsic data types // do all dimensions of arrays (no need for loop over i%d) - sprintf(tmp2, "SIZE(InData%%%s)", r->name); + strcpy(indent, " "); + strcat(indent, mainIndent); + for (d = r->ndims; d >= 1; d--) { + fprintf(fp, "%s DO i%d = LBOUND(InData%%%s,%d), UBOUND(InData%%%s,%d)\n", indent, d, r->name, d, r->name, d); + strcat(indent, " "); //create an indent + } + if (!strcmp(r->type->mapsto, "REAL(ReKi)") || !strcmp(r->type->mapsto, "REAL(SiKi)")) { - fprintf(fp, " %s ReKiBuf ( Re_Xferred:Re_Xferred+(%s)-1 ) = %sInData%%%s%s\n", - tmp3, (r->ndims>0) ? tmp2 : "1", (r->ndims>0) ? "PACK(" : "", r->name, (r->ndims>0) ? ",.TRUE.)" : ""); - fprintf(fp, " Re_Xferred = Re_Xferred + %s\n", (r->ndims>0) ? tmp2 : "1"); + fprintf(fp, "%s ReKiBuf(Re_Xferred) = InData%%%s%s\n", indent, r->name, dimstr(r->ndims)); + fprintf(fp, "%s Re_Xferred = Re_Xferred + 1\n", indent); } else if (!strcmp(r->type->mapsto, "REAL(DbKi)") || !strcmp(r->type->mapsto, "REAL(R8Ki)")) { - fprintf(fp, " %s DbKiBuf ( Db_Xferred:Db_Xferred+(%s)-1 ) = %sInData%%%s%s\n", - tmp3, (r->ndims>0) ? tmp2 : "1", (r->ndims>0) ? "PACK(" : "", r->name, (r->ndims>0) ? ",.TRUE.)" : ""); - fprintf(fp, " Db_Xferred = Db_Xferred + %s\n", (r->ndims>0) ? tmp2 : "1"); + fprintf(fp, "%s DbKiBuf(Db_Xferred) = InData%%%s%s\n", indent, r->name, dimstr(r->ndims)); + fprintf(fp, "%s Db_Xferred = Db_Xferred + 1\n", indent); } else if (!strcmp(r->type->mapsto, "INTEGER(IntKi)") ) { - fprintf(fp, " %s IntKiBuf ( Int_Xferred:Int_Xferred+(%s)-1 ) = %sInData%%%s%s\n", - tmp3, (r->ndims>0) ? tmp2 : "1", (r->ndims>0) ? "PACK(" : "", r->name, (r->ndims>0) ? ",.TRUE.)" : ""); - fprintf(fp, " Int_Xferred = Int_Xferred + %s\n", (r->ndims>0) ? tmp2 : "1"); + fprintf(fp, "%s IntKiBuf(Int_Xferred) = InData%%%s%s\n", indent, r->name, dimstr(r->ndims)); + fprintf(fp, "%s Int_Xferred = Int_Xferred + 1\n", indent); } else if (!strcmp(r->type->mapsto, "LOGICAL") ) { - fprintf(fp, " %s IntKiBuf ( Int_Xferred:Int_Xferred+%s-1 ) = TRANSFER(%s InData%%%s %s, IntKiBuf(1), %s)\n", - tmp3, (r->ndims>0) ? tmp2 : "1", (r->ndims>0) ? "PACK(" : "", r->name, (r->ndims>0) ? ",.TRUE.)" : "", - (r->ndims>0) ? tmp2 : "1"); - fprintf(fp, " Int_Xferred = Int_Xferred + %s\n", (r->ndims>0) ? tmp2 : "1"); + fprintf(fp, "%s IntKiBuf(Int_Xferred) = TRANSFER(InData%%%s%s, IntKiBuf(1))\n", indent, r->name, dimstr(r->ndims)); + fprintf(fp, "%s Int_Xferred = Int_Xferred + 1\n", indent); } else /*if (!strcmp(r->type->mapsto, "CHARACTER")) */{ - for (d = r->ndims; d >= 1; d--) { - fprintf(fp, " DO i%d = LBOUND(InData%%%s,%d), UBOUND(InData%%%s,%d)\n", d, r->name, d, r->name, d); - } + fprintf(fp, "%s DO I = 1, LEN(InData%%%s)\n", indent, r->name); + fprintf(fp, "%s IntKiBuf(Int_Xferred) = ICHAR(InData%%%s%s(I:I), IntKi)\n", indent, r->name, dimstr(r->ndims)); + fprintf(fp, "%s Int_Xferred = Int_Xferred + 1\n", indent); + fprintf(fp, "%s END DO ! I\n", indent); - fprintf(fp, " DO I = 1, LEN(InData%%%s)\n", r->name); - fprintf(fp, " IntKiBuf(Int_Xferred) = ICHAR(InData%%%s%s(I:I), IntKi)\n", r->name, dimstr(r->ndims)); - fprintf(fp, " Int_Xferred = Int_Xferred + 1\n"); - fprintf(fp, " END DO ! I\n"); + } - for (d = r->ndims; d >= 1; d--) { - fprintf(fp, " END DO !i%d\n",d); + for (d = r->ndims; d >= 1; d--) { + strcpy(indent, " "); + strcat(indent, mainIndent); + for (i = 1; i < d; i++) { + strcat(indent, " "); } + fprintf(fp, "%s END DO\n", indent); + } -// bjj: this works, but will produce errors about the source being smaller than the result, thus leaving garbage in some bytes -#if 0 - fprintf(fp, " IntKiBuf ( Int_Xferred:Int_Xferred+%s*LEN(InData%%%s)-1 ) = TRANSFER(%s InData%%%s %s, IntKiBuf(1), %s*LEN(InData%%%s))\n", - (r->ndims>0) ? tmp2 : "1", r->name, - (r->ndims>0) ? "PACK(" : "", r->name, (r->ndims>0) ? ",.TRUE.)" : "", - (r->ndims>0) ? tmp2 : "1", r->name); - fprintf(fp, " Int_Xferred = Int_Xferred + %s*LEN(InData%%%s)\n", (r->ndims>0) ? tmp2 : "1", r->name); -#endif - } /* - else - { - fprintf(fp, "! missing buffer for %s\n", r->name); - }*/ } if (has_deferred_dim(r, 0)){ @@ -571,9 +654,9 @@ gen_pack( FILE * fp, const node_t * ModName, char * inout, char *inoutlong ) void gen_unpack( FILE * fp, const node_t * ModName, char * inout, char * inoutlong ) { - char tmp[NAMELEN], tmp2[NAMELEN], tmp3[NAMELEN], addnick[NAMELEN], nonick[NAMELEN], nonick2[NAMELEN]; + char tmp[NAMELEN], tmp2[NAMELEN], indent[NAMELEN], addnick[NAMELEN], nonick[NAMELEN], nonick2[NAMELEN], mainIndent[6]; node_t *q, * r ; - int d ; + int d, i ; remove_nickname(ModName->nickname,inout,nonick) ; append_nickname((is_a_fast_interface_type(inoutlong))?ModName->nickname:"",inoutlong,addnick) ; @@ -599,12 +682,6 @@ gen_unpack( FILE * fp, const node_t * ModName, char * inout, char * inoutlong ) fprintf(fp," INTEGER(IntKi) :: Db_Xferred\n") ; fprintf(fp," INTEGER(IntKi) :: Int_Xferred\n") ; fprintf(fp," INTEGER(IntKi) :: i\n") ; - fprintf(fp," LOGICAL :: mask0\n"); - fprintf(fp," LOGICAL, ALLOCATABLE :: mask1(:)\n"); - fprintf(fp," LOGICAL, ALLOCATABLE :: mask2(:,:)\n"); - fprintf(fp," LOGICAL, ALLOCATABLE :: mask3(:,:,:)\n") ; - fprintf(fp," LOGICAL, ALLOCATABLE :: mask4(:,:,:,:)\n") ; - fprintf(fp," LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:)\n") ; for (d = 1; d <= q->max_ndims; d++){ fprintf(fp," INTEGER(IntKi) :: i%d, i%d_l, i%d_u ! bounds (upper/lower) for an array dimension %d\n", d, d, d, d); } @@ -659,18 +736,16 @@ gen_unpack( FILE * fp, const node_t * ModName, char * inout, char * inoutlong ) fprintf(fp, " IF (OutData%%c_obj%%%s_Len > 0) &\n", r->name); fprintf(fp, " OutData%%c_obj%%%s = C_LOC( OutData%%%s(i1_l) ) \n", r->name, r->name); } - - sprintf(tmp3, " IF (SIZE(OutData%%%s)>0)", r->name); + strcpy(mainIndent, " "); } else{ - sprintf(tmp3, " "); - for (d = 1; d <= r->ndims; d++) { fprintf(fp, " i%d_l = LBOUND(OutData%%%s,%d)\n", d, r->name, d); fprintf(fp, " i%d_u = UBOUND(OutData%%%s,%d)\n", d, r->name, d); sprintf(tmp2, ",i%d_l:i%d_u", d, d); strcat(tmp, tmp2); } + strcpy(mainIndent, ""); } if (!strcmp(r->type->name, "meshtype") || @@ -751,122 +826,73 @@ gen_unpack( FILE * fp, const node_t * ModName, char * inout, char * inoutlong ) } } - else if (r->ndims > 0){ //non-scalar intrinsic data types (arrays) - fprintf(fp, " ALLOCATE(mask%d(%s),STAT=ErrStat2)\n", r->ndims, (char*)&(tmp[1])); - fprintf(fp, " IF (ErrStat2 /= 0) THEN \n"); - fprintf(fp, " CALL SetErrStat(ErrID_Fatal, 'Error allocating mask%d.', ErrStat, ErrMsg,RoutineName)\n", r->ndims); - fprintf(fp, " RETURN\n"); - fprintf(fp, " END IF\n"); - fprintf(fp, " mask%d = .TRUE. \n", r->ndims); + else + { + strcpy(indent, " "); + strcat(indent, mainIndent); + for (d = r->ndims; d >= 1; d--) { + fprintf(fp, "%s DO i%d = LBOUND(OutData%%%s,%d), UBOUND(OutData%%%s,%d)\n", indent, d, r->name, d, r->name, d); + strcat(indent, " "); //create an indent + } - // do all dimensions of arrays (no need for loop over i%d) - sprintf(tmp2, "SIZE(OutData%%%s)", r->name); - if (!strcmp(r->type->mapsto, "REAL(ReKi)")) { - if (is_pointer(r)) { // bjj: this isn't very generic, but it's quick and will work for all current cases - fprintf(fp, " %s OutData%%%s = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(%s)-1 ), mask%d, 0.0_ReKi ), C_FLOAT)\n", - tmp3, r->name, tmp2, r->ndims); + if (!strcmp(r->type->mapsto, "REAL(ReKi)") || + !strcmp(r->type->mapsto, "REAL(SiKi)")) { + if (sw_ccode && is_pointer(r)) { + fprintf(fp, "%s OutData%%%s%s = REAL(ReKiBuf(Re_Xferred), C_FLOAT)\n", indent, r->name, dimstr(r->ndims)); + } + else if (!strcmp(r->type->mapsto, "REAL(SiKi)")) { + fprintf(fp, "%s OutData%%%s%s = REAL(ReKiBuf(Re_Xferred), SiKi)\n", indent, r->name, dimstr(r->ndims)); } else { - fprintf(fp, " %s OutData%%%s = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(%s)-1 ), mask%d, 0.0_ReKi )\n", - tmp3, r->name, tmp2, r->ndims); + fprintf(fp, "%s OutData%%%s%s = ReKiBuf(Re_Xferred)\n", indent, r->name, dimstr(r->ndims)); } - fprintf(fp, " Re_Xferred = Re_Xferred + %s\n", tmp2); + fprintf(fp, "%s Re_Xferred = Re_Xferred + 1\n", indent); } - else if (!strcmp(r->type->mapsto, "REAL(SiKi)")) - { - fprintf(fp, " %s OutData%%%s = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(%s)-1 ), mask%d, 0.0_ReKi ), SiKi)\n", - tmp3, r->name, tmp2, r->ndims); - fprintf(fp, " Re_Xferred = Re_Xferred + %s\n", tmp2); - } - else if (!strcmp(r->type->mapsto, "REAL(DbKi)")) { - if (is_pointer(r)) { // bjj: this isn't very generic, but it's quick and will work for all current cases - fprintf(fp, " %s OutData%%%s = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(%s)-1 ), mask%d, 0.0_DbKi ), C_DOUBLE)\n", - tmp3, r->name, tmp2, r->ndims); + else if (!strcmp(r->type->mapsto, "REAL(DbKi)") || + !strcmp(r->type->mapsto, "REAL(R8Ki)")) { + if (sw_ccode && is_pointer(r)) { + fprintf(fp, "%s OutData%%%s%s = REAL(DbKiBuf(Db_Xferred), C_DOUBLE)\n", indent, r->name, dimstr(r->ndims)); + } + else if (!strcmp(r->type->mapsto, "REAL(R8Ki)")) { + fprintf(fp, "%s OutData%%%s%s = REAL(DbKiBuf(Db_Xferred), R8Ki)\n", indent, r->name, dimstr(r->ndims)); } else { - fprintf(fp, " %s OutData%%%s = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(%s)-1 ), mask%d, 0.0_DbKi )\n", - tmp3, r->name, (r->ndims > 0) ? tmp2 : "1", r->ndims); + fprintf(fp, "%s OutData%%%s%s = DbKiBuf(Db_Xferred)\n", indent, r->name, dimstr(r->ndims)); } - fprintf(fp, " Db_Xferred = Db_Xferred + %s\n", tmp2); - } - else if (!strcmp(r->type->mapsto, "REAL(R8Ki)")) - { - fprintf(fp, " %s OutData%%%s = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(%s)-1 ), mask%d, 0.0_DbKi ), R8Ki)\n", - tmp3, r->name, tmp2, r->ndims); - fprintf(fp, " Db_Xferred = Db_Xferred + %s\n", tmp2); + fprintf(fp, "%s Db_Xferred = Db_Xferred + 1\n", indent); } else if (!strcmp(r->type->mapsto, "INTEGER(IntKi)")) { - fprintf(fp, " %s OutData%%%s = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(%s)-1 ), mask%d, 0_IntKi )\n", - tmp3, r->name, (r->ndims>0) ? tmp2 : "1", r->ndims); - fprintf(fp, " Int_Xferred = Int_Xferred + %s\n", tmp2); + fprintf(fp, "%s OutData%%%s%s = IntKiBuf(Int_Xferred)\n", indent, r->name, dimstr(r->ndims)); + fprintf(fp, "%s Int_Xferred = Int_Xferred + 1\n", indent); } else if (!strcmp(r->type->mapsto, "LOGICAL")) { - //fprintf(fp, " %s OutData%%%s = TRANSFER( UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(%s)-1 ), mask%d, 0 ), OutData%%%s)\n", - fprintf(fp, " %s OutData%%%s = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(%s)-1 ), OutData%%%s), mask%d,.TRUE.)\n", - tmp3, r->name, (r->ndims>0) ? tmp2 : "1", r->name, r->ndims); - fprintf(fp, " Int_Xferred = Int_Xferred + %s\n", tmp2); + fprintf(fp, "%s OutData%%%s%s = TRANSFER(IntKiBuf(Int_Xferred), OutData%%%s%s)\n", indent, r->name, dimstr(r->ndims), r->name, dimstr(r->ndims)); + fprintf(fp, "%s Int_Xferred = Int_Xferred + 1\n", indent); } - else /*if (!strcmp(r->type->mapsto, "CHARACTER")) */{ - - for (d = r->ndims; d >= 1; d--) { - fprintf(fp, " DO i%d = LBOUND(OutData%%%s,%d), UBOUND(OutData%%%s,%d)\n", d, r->name, d, r->name, d); - } - - fprintf(fp, " DO I = 1, LEN(OutData%%%s)\n", r->name); - fprintf(fp, " OutData%%%s%s(I:I) = CHAR(IntKiBuf(Int_Xferred))\n", r->name, dimstr(r->ndims)); - fprintf(fp, " Int_Xferred = Int_Xferred + 1\n"); - fprintf(fp, " END DO ! I\n"); - - for (d = r->ndims; d >= 1; d--) { - fprintf(fp, " END DO !i%d\n", d); - } - } + else /*if (!strcmp(r->type->mapsto, "CHARACTER")) */ { - fprintf(fp, " DEALLOCATE(mask%d)\n", r->ndims); + fprintf(fp, "%s DO I = 1, LEN(OutData%%%s)\n", indent, r->name); + fprintf(fp, "%s OutData%%%s%s(I:I) = CHAR(IntKiBuf(Int_Xferred))\n", indent, r->name, dimstr(r->ndims)); + fprintf(fp, "%s Int_Xferred = Int_Xferred + 1\n", indent); + fprintf(fp, "%s END DO ! I\n", indent); - } - else { - // scalar intrinsic data types - // do all dimensions of arrays (no need for loop over i%d) - if (!strcmp(r->type->mapsto, "REAL(ReKi)")) { - fprintf(fp, " OutData%%%s = ReKiBuf( Re_Xferred )\n", r->name); - fprintf(fp, " Re_Xferred = Re_Xferred + 1\n"); - } - else if (!strcmp(r->type->mapsto, "REAL(SiKi)")) - { - fprintf(fp, " OutData%%%s = REAL( ReKiBuf( Re_Xferred ), SiKi) \n", r->name); - fprintf(fp, " Re_Xferred = Re_Xferred + 1\n"); - } - else if (!strcmp(r->type->mapsto, "REAL(DbKi)")) { - fprintf(fp, " OutData%%%s = DbKiBuf( Db_Xferred ) \n", r->name); - fprintf(fp, " Db_Xferred = Db_Xferred + 1\n"); - } - else if (!strcmp(r->type->mapsto, "REAL(R8Ki)")) { - fprintf(fp, " OutData%%%s = REAL( DbKiBuf( Db_Xferred ), R8Ki) \n", r->name); - fprintf(fp, " Db_Xferred = Db_Xferred + 1\n"); - } - else if (!strcmp(r->type->mapsto, "INTEGER(IntKi)")) { - fprintf(fp, " OutData%%%s = IntKiBuf( Int_Xferred ) \n", r->name); - fprintf(fp, " Int_Xferred = Int_Xferred + 1\n"); - } - else if (!strcmp(r->type->mapsto, "LOGICAL")) { - fprintf(fp, " OutData%%%s = TRANSFER( IntKiBuf( Int_Xferred ), mask0 )\n", r->name); - fprintf(fp, " Int_Xferred = Int_Xferred + 1\n"); } - else /*if (!strcmp(r->type->mapsto, "CHARACTER")) */{ - - fprintf(fp, " DO I = 1, LEN(OutData%%%s)\n", r->name); - fprintf(fp, " OutData%%%s(I:I) = CHAR(IntKiBuf(Int_Xferred))\n", r->name); - fprintf(fp, " Int_Xferred = Int_Xferred + 1\n"); - fprintf(fp, " END DO ! I\n"); + for (d = r->ndims; d >= 1; d--) { + strcpy(indent, " "); + strcat(indent, mainIndent); + for (i = 1; i < d; i++) { + strcat(indent, " "); + } + fprintf(fp, "%s END DO\n", indent); } -// need to move this (scalars and strings) to the %c_obj% type, too! +// need to move scalars and strings to the %c_obj% type, too! // compare with copy routine - if (sw_ccode && !has_deferred_dim(r, 0)) { + + if (sw_ccode && !is_pointer(r) && r->ndims == 0) { if (!strcmp(r->type->mapsto, "REAL(ReKi)") || !strcmp(r->type->mapsto, "REAL(SiKi)") || !strcmp(r->type->mapsto, "REAL(DbKi)") || @@ -877,9 +903,7 @@ gen_unpack( FILE * fp, const node_t * ModName, char * inout, char * inoutlong ) fprintf(fp, " OutData%%C_obj%%%s = OutData%%%s\n", r->name, r->name); } else { // characters need to be copied differently - if (r->ndims == 0){ - fprintf(fp, " OutData%%C_obj%%%s = TRANSFER(OutData%%%s, OutData%%C_obj%%%s )\n", r->name, r->name, r->name); - } + fprintf(fp, " OutData%%C_obj%%%s = TRANSFER(OutData%%%s, OutData%%C_obj%%%s )\n", r->name, r->name, r->name); } } @@ -1000,7 +1024,7 @@ void gen_extint_order(FILE *fp, const node_t *ModName, char * typnm, char * uy, node_t *q, *r1 ; int j ; int mesh = 0 ; - char derefrecurse[NAMELEN],dex[NAMELEN],tmp[NAMELEN] ; + char derefrecurse[NAMELEN],tmp[NAMELEN] ; if ( recurselevel > MAXRECURSE ) { fprintf(stderr,"REGISTRY ERROR: too many levels of array subtypes\n") ; exit(9) ; @@ -1028,24 +1052,19 @@ void gen_extint_order(FILE *fp, const node_t *ModName, char * typnm, char * uy, } } } else if ( !strcmp( r->type->mapsto, "MeshType" ) ) { - strcpy(dex,"") ; for ( j = r->ndims ; j > 0 ; j-- ) { - fprintf(fp, " DO i%d%d = LBOUND(%s_out%s%%%s,%d),UBOUND(%s_out%s%%%s,%d)\n", 0, 1, uy, deref, r->name, j, uy, deref, r->name, j); - if ( j == r->ndims ) strcat(dex,"(") ; - sprintf(tmp,"i%d%d",0,j) ; - if ( j == 1 ) strcat(tmp,")") ; else strcat(tmp,",") ; - strcat(dex,tmp) ; + fprintf(fp, " DO i%d%d = LBOUND(%s_out%s%%%s,%d),UBOUND(%s_out%s%%%s,%d)\n", 0, j, uy, deref, r->name, j, uy, deref, r->name, j); } if ( order == 0 ) { - fprintf(fp, " CALL MeshCopy(%s(1)%s%%%s%s, %s_out%s%%%s%s, MESH_UPDATECOPY, ErrStat2, ErrMsg2 )\n", uy, deref, r->name, dex - , uy, deref, r->name, dex); + fprintf(fp, " CALL MeshCopy(%s(1)%s%%%s%s, %s_out%s%%%s%s, MESH_UPDATECOPY, ErrStat2, ErrMsg2 )\n", uy, deref, r->name, dimstr(r->ndims) + , uy, deref, r->name, dimstr(r->ndims)); } else if ( order == 1 ) { fprintf(fp," CALL MeshExtrapInterp1(%s(1)%s%%%s%s, %s(2)%s%%%s%s, tin, %s_out%s%%%s%s, tin_out, ErrStat2, ErrMsg2 )\n" - , uy, deref, r->name, dex, uy, deref, r->name, dex, uy, deref, r->name, dex); + , uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); } else if ( order == 2 ) { fprintf(fp," CALL MeshExtrapInterp2(%s(1)%s%%%s%s, %s(2)%s%%%s%s, %s(3)%s%%%s%s, tin, %s_out%s%%%s%s, tin_out, ErrStat2, ErrMsg2 )\n" - , uy, deref, r->name, dex, uy, deref, r->name, dex, uy, deref, r->name, dex, uy, deref, r->name, dex); + , uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); } fprintf(fp, " CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName)\n"); fprintf(fp, " IF (ErrStat>=AbortErrLev) RETURN\n"); @@ -1058,19 +1077,19 @@ void gen_extint_order(FILE *fp, const node_t *ModName, char * typnm, char * uy, char nonick2[NAMELEN] ; remove_nickname(r->type->module->nickname,r->type->name,nonick2) ; - strcpy(dex,"") ; + strcpy(dimstr(r->ndims),"") ; for ( j = r->ndims ; j >= 1 ; j-- ) { - fprintf(fp, " DO i%d%d = LBOUND(%s_out%s%%%s,%d), UBOUND(%s_out%s%%%s,%d)\n", 0, 1, uy, deref, r->name, j, uy, deref, r->name, j); - if ( j == r->ndims ) strcat(dex,"(") ; + fprintf(fp, " DO i%d%d = LBOUND(%s_out%s%%%s,%d), UBOUND(%s_out%s%%%s,%d)\n", 0, j, uy, deref, r->name, j, uy, deref, r->name, j); + if ( j == r->ndims ) strcat(dimstr(r->ndims),"(") ; sprintf(tmp,"i%d%d",0,j) ; if ( j == 1 ) strcat(tmp,")") ; else strcat(tmp,",") ; - strcat(dex,tmp) ; + strcat(dimstr(r->ndims),tmp) ; } fprintf(fp," CALL %s_%s_ExtrapInterp( %s%s%%%s%s, tin, %s_out%s%%%s%s, tin_out, ErrStat2, ErrMsg2 )\n", r->type->module->nickname,fast_interface_type_shortname(nonick2) - , uy, deref, r->name, dex, uy, deref, r->name, dex); + , uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); fprintf(fp," CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName)\n"); fprintf(fp," IF (ErrStat>=AbortErrLev) RETURN\n"); @@ -1139,9 +1158,9 @@ void gen_extint_order(FILE *fp, const node_t *ModName, char * typnm, char * uy, #endif void gen_extint_order(FILE *fp, const node_t *ModName, char * typnm, char * uy, const int order, node_t *r, char * deref, int recurselevel) { node_t *q, *r1; - int j; + int i, j; int mesh = 0; - char derefrecurse[NAMELEN], dex[NAMELEN], tmp[NAMELEN]; + char derefrecurse[NAMELEN], indent[NAMELEN]; if (recurselevel > MAXRECURSE) { fprintf(stderr, "REGISTRY ERROR: too many levels of array subtypes\n"); exit(9); @@ -1155,8 +1174,6 @@ void gen_extint_order(FILE *fp, const node_t *ModName, char * typnm, char * uy, } if (r->type->type_type == DERIVED) { - - if ((q = get_entry(make_lower_temp(r->type->name), ModName->module_ddt_list)) != NULL) { for (r1 = q->fields; r1; r1 = r1->next) { @@ -1175,27 +1192,22 @@ void gen_extint_order(FILE *fp, const node_t *ModName, char * typnm, char * uy, else { - strcpy(dex, ""); for (j = r->ndims; j > 0; j--) { - fprintf(fp, " DO i%d%d = LBOUND(%s_out%s%%%s,%d),UBOUND(%s_out%s%%%s,%d)\n", 0, 1, uy, deref, r->name, j, uy, deref, r->name, j); - if (j == r->ndims) strcat(dex, "("); - sprintf(tmp, "i%d%d", 0, j); - if (j == 1) strcat(tmp, ")"); else strcat(tmp, ","); - strcat(dex, tmp); + fprintf(fp, " DO i%d = LBOUND(%s_out%s%%%s,%d),UBOUND(%s_out%s%%%s,%d)\n", j, uy, deref, r->name, j, uy, deref, r->name, j); } if (!strcmp(r->type->mapsto, "MeshType")) { if (order == 0) { - fprintf(fp, " CALL MeshCopy(%s1%s%%%s%s, %s_out%s%%%s%s, MESH_UPDATECOPY, ErrStat2, ErrMsg2 )\n", uy, deref, r->name, dex - , uy, deref, r->name, dex); + fprintf(fp, " CALL MeshCopy(%s1%s%%%s%s, %s_out%s%%%s%s, MESH_UPDATECOPY, ErrStat2, ErrMsg2 )\n", uy, deref, r->name, dimstr(r->ndims) + , uy, deref, r->name, dimstr(r->ndims)); } else if (order == 1) { fprintf(fp, " CALL MeshExtrapInterp1(%s1%s%%%s%s, %s2%s%%%s%s, tin, %s_out%s%%%s%s, tin_out, ErrStat2, ErrMsg2 )\n" - , uy, deref, r->name, dex, uy, deref, r->name, dex, uy, deref, r->name, dex); + , uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); } else if (order == 2) { fprintf(fp, " CALL MeshExtrapInterp2(%s1%s%%%s%s, %s2%s%%%s%s, %s3%s%%%s%s, tin, %s_out%s%%%s%s, tin_out, ErrStat2, ErrMsg2 )\n" - , uy, deref, r->name, dex, uy, deref, r->name, dex, uy, deref, r->name, dex, uy, deref, r->name, dex); + , uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); } } else { @@ -1204,17 +1216,17 @@ void gen_extint_order(FILE *fp, const node_t *ModName, char * typnm, char * uy, if (order == 0) { fprintf(fp, " CALL %s_Copy%s(%s1%s%%%s%s, %s_out%s%%%s%s, MESH_UPDATECOPY, ErrStat2, ErrMsg2 )\n", r->type->module->nickname, fast_interface_type_shortname(nonick2) - , uy, deref, r->name, dex, uy, deref, r->name, dex); + , uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); } else if (order == 1) { fprintf(fp, " CALL %s_%s_ExtrapInterp1( %s1%s%%%s%s, %s2%s%%%s%s, tin, %s_out%s%%%s%s, tin_out, ErrStat2, ErrMsg2 )\n", r->type->module->nickname, fast_interface_type_shortname(nonick2) - , uy, deref, r->name, dex, uy, deref, r->name, dex, uy, deref, r->name, dex); + , uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); } else if (order == 2) { fprintf(fp, " CALL %s_%s_ExtrapInterp2( %s1%s%%%s%s, %s2%s%%%s%s, %s3%s%%%s%s, tin, %s_out%s%%%s%s, tin_out, ErrStat2, ErrMsg2 )\n", r->type->module->nickname, fast_interface_type_shortname(nonick2) - , uy, deref, r->name, dex, uy, deref, r->name, dex, uy, deref, r->name, dex, uy, deref, r->name, dex); + , uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); } } @@ -1230,67 +1242,59 @@ void gen_extint_order(FILE *fp, const node_t *ModName, char * typnm, char * uy, !strcmp(r->type->mapsto, "REAL(SiKi)") || !strcmp(r->type->mapsto, "REAL(R8Ki)") || !strcmp(r->type->mapsto, "REAL(DbKi)")) { - if (r->ndims == 0) { - } - else if (r->ndims == 1 && order > 0) { - fprintf(fp, " ALLOCATE(b1(SIZE(%s_out%s%%%s,1)))\n", uy, deref, r->name); - fprintf(fp, " ALLOCATE(c1(SIZE(%s_out%s%%%s,1)))\n", uy, deref, r->name); - } - else if (r->ndims == 2 && order > 0) { - fprintf(fp, " ALLOCATE(b2(SIZE(%s_out%s%%%s,1),SIZE(%s_out%s%%%s,2) ))\n", uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " ALLOCATE(c2(SIZE(%s_out%s%%%s,1),SIZE(%s_out%s%%%s,2) ))\n", uy, deref, r->name, uy, deref, r->name); - } - else if (r->ndims == 3 && order > 0) { - fprintf(fp, " ALLOCATE(b3(SIZE(%s_out%s%%%s,1),SIZE(%s_out%s%%%s,2), &\n", uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " SIZE(%s_out%s%%%s,3) ))\n", uy, deref, r->name); - fprintf(fp, " ALLOCATE(c3(SIZE(%s_out%s%%%s,1),SIZE(%s_out%s%%%s,2), &\n", uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " SIZE(%s_out%s%%%s,3) ))\n", uy, deref, r->name); - } - else if (r->ndims == 4 && order > 0) { - fprintf(fp, " ALLOCATE(b4(SIZE(%s_out%s%%%s,1),SIZE(%s_out%s%%%s,2), &\n", uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " SIZE(%s_out%s%%%s,3),SIZE(%s_out%s%%%s,4) ))\n", uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " ALLOCATE(c4(SIZE(%s_out%s%%%s,1),SIZE(%s_out%s%%%s,2), &\n", uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " SIZE(%s_out%s%%%s,3),SIZE(%s_out%s%%%s,4) ))\n", uy, deref, r->name, uy, deref, r->name); - } - else if (r->ndims == 5 && order > 0) { - fprintf(fp, " ALLOCATE(b5(SIZE(%s_out%s%%%s,1),SIZE(%s_out%s%%%s,2), &\n", uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " SIZE(%s_out%s%%%s,3),SIZE(%s_out%s%%%s,4), &\n", uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " SIZE(%s_out%s%%%s,5) ))\n", uy, deref, r->name); - fprintf(fp, " ALLOCATE(c5(SIZE(%s_out%s%%%s,1),SIZE(%s_out%s%%%s,2), &\n", uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " SIZE(%s_out%s%%%s,3),SIZE(%s_out%s%%%s,4), &\n", uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " SIZE(%s_out%s%%%s,5) ))\n", uy, deref, r->name); - } - else { - if (order > 0) fprintf(stderr, "Registry WARNING: too many dimensions for %s%%%s\n", deref, r->name); - } + if (order == 0) { + //bjj: this should probably have some "IF ALLOCATED" statements around it, but we're just calling + // the copy routine fprintf(fp, " %s_out%s%%%s = %s1%s%%%s\n", uy, deref, r->name, uy, deref, r->name); } - else if (order == 1) { - fprintf(fp, " b%d = -(%s1%s%%%s - %s2%s%%%s)/t(2)\n", r->ndims, uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " %s_out%s%%%s = %s1%s%%%s + b%d * t_out\n", uy, deref, r->name, uy, deref, r->name, r->ndims); - } - else if (order == 2) { - fprintf(fp, " b%d = (t(3)**2*(%s1%s%%%s - %s2%s%%%s) + t(2)**2*(-%s1%s%%%s + %s3%s%%%s))/(t(2)*t(3)*(t(2) - t(3)))\n", - r->ndims, uy, deref, r->name, uy, deref, r->name, uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " c%d = ( (t(2)-t(3))*%s1%s%%%s + t(3)*%s2%s%%%s - t(2)*%s3%s%%%s ) / (t(2)*t(3)*(t(2) - t(3)))\n", - r->ndims, uy, deref, r->name, uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " %s_out%s%%%s = %s1%s%%%s + b%d * t_out + c%d * t_out**2\n" - , uy, deref, r->name, uy, deref, r->name, r->ndims, r->ndims); - } - if (r->ndims >= 1 && order > 0) { - fprintf(fp, " DEALLOCATE(b%d)\n", r->ndims); - fprintf(fp, " DEALLOCATE(c%d)\n", r->ndims); + else + strcpy(indent, ""); + for (j = r->ndims; j > 0; j--) { + fprintf(fp, "%s DO i%d = LBOUND(%s_out%s%%%s,%d),UBOUND(%s_out%s%%%s,%d)\n", indent, j, uy, deref, r->name, j, uy, deref, r->name, j); + strcat(indent, " "); //create an indent + } + + if (order == 1) { + if (r->gen_periodic) { + fprintf(fp, "%s CALL Angles_ExtrapInterp( %s1%s%%%s%s, %s2%s%%%s%s, tin, %s_out%s%%%s%s, tin_out )\n", + indent, uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); + } + else { + fprintf(fp, "%s b = -(%s1%s%%%s%s - %s2%s%%%s%s)\n", indent, uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); + fprintf(fp, "%s %s_out%s%%%s%s = %s1%s%%%s%s + b * ScaleFactor\n", indent, uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); + }; + } + if (order == 2) { + if (r->gen_periodic) { + fprintf(fp, "%s CALL Angles_ExtrapInterp( %s1%s%%%s%s, %s2%s%%%s%s, %s3%s%%%s%s, tin, %s_out%s%%%s%s, tin_out )\n", + indent, uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); + } + else { + fprintf(fp, "%s b = (t(3)**2*(%s1%s%%%s%s - %s2%s%%%s%s) + t(2)**2*(-%s1%s%%%s%s + %s3%s%%%s%s))* scaleFactor\n", + indent, uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); + fprintf(fp, "%s c = ( (t(2)-t(3))*%s1%s%%%s%s + t(3)*%s2%s%%%s%s - t(2)*%s3%s%%%s%s ) * scaleFactor\n", + indent, uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); + fprintf(fp, "%s %s_out%s%%%s%s = %s1%s%%%s%s + b + c * t_out\n", + indent, uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); + } + } + for (j = r->ndims; j >= 1; j--) { + strcpy(indent, ""); + for (i = 1; i < j; i++) { + strcat(indent, " "); + } + fprintf(fp, "%s END DO\n", indent); + } } - } // check if this is an allocatable array: if (r->ndims > 0 && has_deferred_dim(r, 0)) { fprintf(fp, "END IF ! check if allocated\n"); } - } -} + +} // gen_extint_order void calc_extint_order(FILE *fp, const node_t *ModName, node_t *r, int recurselevel, int *max_ndims, int *max_nrecurs, int *max_alloc_ndims) { node_t *q, *r1 ; @@ -1327,6 +1331,7 @@ void calc_extint_order(FILE *fp, const node_t *ModName, node_t *r, int recursele !strcmp(r->type->mapsto, "REAL(R8Ki)") || !strcmp(r->type->mapsto, "REAL(DbKi)")) { if (/*order > 0 &&*/ r->ndims > *max_alloc_ndims) *max_alloc_ndims = r->ndims; + if (r->ndims > *max_ndims)* max_ndims = r->ndims; } @@ -1574,30 +1579,8 @@ gen_ExtrapInterp1(FILE *fp, const node_t * ModName, char * typnm, char * typnmlo fprintf(fp, " CHARACTER(*), PARAMETER :: RoutineName = '%s_%s_ExtrapInterp1'\n", ModName->nickname, typnm); - if (max_alloc_ndims >= 0){ - fprintf(fp, " REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation\n"); - fprintf(fp, " REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation\n"); - if (max_alloc_ndims >= 1){ - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation\n"); - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation\n"); - if (max_alloc_ndims >= 2){ - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation\n"); - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation\n"); - if (max_alloc_ndims >= 3){ - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: b3 ! temporary for extrapolation/interpolation\n"); - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: c3 ! temporary for extrapolation/interpolation\n"); - if (max_alloc_ndims >= 4){ - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:,:) :: b4 ! temporary for extrapolation/interpolation\n"); - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:,:) :: c4 ! temporary for extrapolation/interpolation\n"); - if (max_alloc_ndims >= 5){ - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:,:,:):: b5 ! temporary for extrapolation/interpolation\n"); - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:,:,:):: c5 ! temporary for extrapolation/interpolation\n"); - } // 5 - } // 4 - } // 3 - } // 2 - } // 1 - } // 0 + fprintf(fp, " REAL(DbKi) :: b ! temporary for extrapolation/interpolation\n"); + fprintf(fp, " REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation\n"); fprintf(fp, " INTEGER(IntKi) :: ErrStat2 ! local errors\n"); fprintf(fp, " CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors\n"); for (j = 1; j <= max_ndims; j++) { @@ -1605,6 +1588,9 @@ gen_ExtrapInterp1(FILE *fp, const node_t * ModName, char * typnm, char * typnmlo fprintf(fp, " INTEGER :: i%d%d ! dim%d level %d counter variable for arrays of ddts\n", i, j, j, i); } } + for (j = 1; j <= max_ndims; j++) { + fprintf(fp, " INTEGER :: i%d ! dim%d counter variable for arrays\n", j, j); + } fprintf(fp, " ! Initialize ErrStat\n"); fprintf(fp, " ErrStat = ErrID_None\n"); @@ -1618,8 +1604,9 @@ gen_ExtrapInterp1(FILE *fp, const node_t * ModName, char * typnm, char * typnmlo fprintf(fp, " IF ( EqualRealNos( t(1), t(2) ) ) THEN\n"); fprintf(fp, " CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName)\n"); fprintf(fp, " RETURN\n"); - fprintf(fp, " END IF\n"); + fprintf(fp, " END IF\n\n"); + fprintf(fp, " ScaleFactor = t_out / t(2)\n"); for (r = q->fields; r; r = r->next) { @@ -1654,45 +1641,23 @@ gen_ExtrapInterp2(FILE *fp, const node_t * ModName, char * typnm, char * typnmlo fprintf(fp, "!..................................................................................................................................\n"); fprintf(fp, "\n"); - fprintf(fp, " TYPE(%s_%s), INTENT(%s) :: %s1 ! %s at t1 > t2 > t3\n", ModName->nickname, typnmlong, (q->containsPtr == 1) ? "INOUT" : "IN", uy, typnm); fprintf(fp, " TYPE(%s_%s), INTENT(%s) :: %s2 ! %s at t2 > t3\n", ModName->nickname, typnmlong, (q->containsPtr == 1) ? "INOUT" : "IN", uy, typnm); fprintf(fp, " TYPE(%s_%s), INTENT(%s) :: %s3 ! %s at t3\n", ModName->nickname, typnmlong, (q->containsPtr == 1) ? "INOUT" : "IN", uy, typnm); fprintf(fp, " REAL(%s), INTENT(IN ) :: tin(3) ! Times associated with the %ss\n", xtypnm, typnm); fprintf(fp, " TYPE(%s_%s), INTENT(INOUT) :: %s_out ! %s at tin_out\n", ModName->nickname, typnmlong, uy, typnm); fprintf(fp, " REAL(%s), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to\n", xtypnm); - fprintf(fp, " INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation\n"); + + fprintf(fp, " INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation\n" ); fprintf(fp, " CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None\n"); fprintf(fp, " ! local variables\n"); fprintf(fp, " REAL(%s) :: t(3) ! Times associated with the %ss\n", xtypnm, typnm); fprintf(fp, " REAL(%s) :: t_out ! Time to which to be extrap/interpd\n", xtypnm); fprintf(fp, " INTEGER(IntKi) :: order ! order of polynomial fit (max 2)\n"); - - if (max_alloc_ndims >= 0){ - fprintf(fp, " REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation\n"); - fprintf(fp, " REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation\n"); - if (max_alloc_ndims >= 1){ - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation\n"); - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation\n"); - if (max_alloc_ndims >= 2){ - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation\n"); - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation\n"); - if (max_alloc_ndims >= 3){ - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: b3 ! temporary for extrapolation/interpolation\n"); - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: c3 ! temporary for extrapolation/interpolation\n"); - if (max_alloc_ndims >= 4){ - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:,:) :: b4 ! temporary for extrapolation/interpolation\n"); - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:,:) :: c4 ! temporary for extrapolation/interpolation\n"); - if (max_alloc_ndims >= 5){ - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:,:,:):: b5 ! temporary for extrapolation/interpolation\n"); - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:,:,:):: c5 ! temporary for extrapolation/interpolation\n"); - } // 5 - } // 4 - } // 3 - } // 2 - } // 1 - } // 0 + fprintf(fp, " REAL(DbKi) :: b ! temporary for extrapolation/interpolation\n"); + fprintf(fp, " REAL(DbKi) :: c ! temporary for extrapolation/interpolation\n"); + fprintf(fp, " REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation\n"); fprintf(fp, " INTEGER(IntKi) :: ErrStat2 ! local errors\n"); fprintf(fp, " CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors\n"); fprintf(fp, " CHARACTER(*), PARAMETER :: RoutineName = '%s_%s_ExtrapInterp2'\n", ModName->nickname, typnm); @@ -1701,6 +1666,9 @@ gen_ExtrapInterp2(FILE *fp, const node_t * ModName, char * typnm, char * typnmlo fprintf(fp, " INTEGER :: i%d%d ! dim%d level %d counter variable for arrays of ddts\n", i, j, j, i); } } + for (j = 1; j <= max_ndims; j++) { + fprintf(fp, " INTEGER :: i%d ! dim%d counter variable for arrays\n", j, j); + } fprintf(fp, " ! Initialize ErrStat\n"); fprintf(fp, " ErrStat = ErrID_None\n"); fprintf(fp, " ErrMsg = \"\"\n"); @@ -1720,7 +1688,11 @@ gen_ExtrapInterp2(FILE *fp, const node_t * ModName, char * typnm, char * typnmlo fprintf(fp, " ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN\n"); fprintf(fp, " CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName)\n"); fprintf(fp, " RETURN\n"); - fprintf(fp, " END IF\n"); + fprintf(fp, " END IF\n\n"); + + fprintf(fp, " ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3)))\n"); + + for (r = q->fields; r; r = r->next) { @@ -2256,6 +2228,7 @@ gen_module( FILE * fp , node_t * ModName, char * prog_ver ) gen_unpack( fp, ModName, ddtname, ddtnamelong ) ; if ( sw_ccode ) { gen_copy_c2f( fp, ModName, ddtname, ddtnamelong ) ; + gen_copy_f2c(fp, ModName, ddtname, ddtnamelong); } } diff --git a/modules/openfast-registry/src/reg_parse.c b/modules/openfast-registry/src/reg_parse.c index 0ec9f3c7db..37d457abc2 100644 --- a/modules/openfast-registry/src/reg_parse.c +++ b/modules/openfast-registry/src/reg_parse.c @@ -95,7 +95,7 @@ pre_parse( char * dir, FILE * infile, FILE * outfile, int usefrom_sw ) // See if it might be in the current directory sprintf( include_file_name , "%s", p ) ; // first name in line from registry file, without the include or usefrom for ( p2 = include_file_name ; !( *p2 == ' ' || *p2 == '\t' || *p2 == '\n' ) && *p2 != '\0' ; p2++ ) {} - *p2 = '\0' ; // drop tailing white space + *p2 = '\0' ; // drop tailing white space if ( (q=index(include_file_name,'\n')) != NULL ) *q = '\0' ; if (( include_fp = fopen( include_file_name , "r" )) != NULL ) { foundit = 1 ; goto gotit ; } @@ -269,7 +269,7 @@ pre_parse( char * dir, FILE * infile, FILE * outfile, int usefrom_sw ) -normal: +//normal: /* otherwise output the line as is */ fprintf(outfile,"%s\n",parseline_save) ; parseline[0] = '\0' ; /* reset parseline */ @@ -284,8 +284,8 @@ reg_parse( FILE * infile ) /* Had to increase size for SOA from 4096 to 7000, Manish Shrivastava 2010 */ char inln[INLN_SIZE], parseline[PARSELINE_SIZE] ; char *p ; - char *tokens[MAXTOKENS], *ditto[MAXTOKENS] ; - int i ; + char *tokens[MAXTOKENS],*ditto[MAXTOKENS] ; + int i ; int defining_state_field, defining_rconfig_field, defining_i1_field ; parseline[0] = '\0' ; @@ -449,7 +449,6 @@ reg_parse( FILE * infile ) strcpy(field_struct->units,"-") ; if ( strcmp( tokens[FIELD_UNITS], "-" ) ) /* that is, if not equal "-" */ { strcpy( field_struct->units , tokens[FIELD_UNITS] ) ; } - #ifdef OVERSTRICT if ( field_struct->type != NULL ) if ( field_struct->type->type_type == DERIVED && field_struct->ndims > 0 ) @@ -615,27 +614,19 @@ set_dim_len ( char * dimspec , node_t * dim_entry ) int set_ctrl( char *ctrl , node_t * field_struct ) -// process CTRL keys -- only 'h' (hidden) and 'e' (exposed). Default is not to generate a wrapper, -// so something must be specified, either h or e +// process CTRL keys -- only '2pi' (interpolation of values with 2pi period). Default is no special interpolation. { - char prev = '\0' ; - char x ; char tmp[NAMELEN] ; char *p ; - int i ; strcpy(tmp,ctrl) ; if (( p = index(tmp,'=') ) != NULL ) { *p = '\0' ; } - for ( i = 0 ; i < strlen(tmp) ; i++ ) - { - x = tolower(tmp[i]) ; - if ( x == 'h' ) { - field_struct->gen_wrapper = WRAP_HIDDEN_FIELD ; - } else if ( x == 'e' ) { - field_struct->gen_wrapper = WRAP_EXPOSED_FIELD ; - } else { - field_struct->gen_wrapper = WRAP_NONE ; /* default */ - } + if (!strcmp(make_lower_temp(tmp), "2pi")) { + field_struct->gen_periodic = PERIOD_2PI; + } + else { + field_struct->gen_periodic = PERIOD_NONE; } + return(0) ; } diff --git a/modules/openfast-registry/src/registry.h b/modules/openfast-registry/src/registry.h index 0356025fb2..524bbe7e1a 100644 --- a/modules/openfast-registry/src/registry.h +++ b/modules/openfast-registry/src/registry.h @@ -23,9 +23,9 @@ enum type_type { SIMPLE , DERIVED } ; enum proc_orient { ALL_Z_ON_PROC , ALL_X_ON_PROC , ALL_Y_ON_PROC } ; /* wrapping options */ -#define WRAP_HIDDEN_FIELD 2 -#define WRAP_EXPOSED_FIELD 1 -#define WRAP_NONE 0 +#define PERIOD_2PI 2 +#define PERIOD_OTHER 1 +#define PERIOD_NONE 0 /* node_kind mask settings */ diff --git a/modules/openfoam/src/OpenFOAM_Types.f90 b/modules/openfoam/src/OpenFOAM_Types.f90 index 5364e2f702..cafa53ba83 100644 --- a/modules/openfoam/src/OpenFOAM_Types.f90 +++ b/modules/openfoam/src/OpenFOAM_Types.f90 @@ -369,14 +369,14 @@ SUBROUTINE OpFM_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumSC2Ctrl - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumCtrl2SC - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumActForcePtsBlade - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumActForcePtsTower - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumSC2Ctrl + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumCtrl2SC + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumActForcePtsBlade + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumActForcePtsTower + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ASSOCIATED(InData%StructBldRNodes) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -387,8 +387,10 @@ SUBROUTINE OpFM_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StructBldRNodes,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%StructBldRNodes)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%StructBldRNodes))-1 ) = PACK(InData%StructBldRNodes,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%StructBldRNodes) + DO i1 = LBOUND(InData%StructBldRNodes,1), UBOUND(InData%StructBldRNodes,1) + ReKiBuf(Re_Xferred) = InData%StructBldRNodes(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%StructTwrHNodes) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -400,15 +402,17 @@ SUBROUTINE OpFM_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StructTwrHNodes,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%StructTwrHNodes)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%StructTwrHNodes))-1 ) = PACK(InData%StructTwrHNodes,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%StructTwrHNodes) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%BladeLength - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TowerHeight - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TowerBaseHeight - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%StructTwrHNodes,1), UBOUND(InData%StructTwrHNodes,1) + ReKiBuf(Re_Xferred) = InData%StructTwrHNodes(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%BladeLength + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TowerHeight + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TowerBaseHeight + Re_Xferred = Re_Xferred + 1 END SUBROUTINE OpFM_PackInitInput SUBROUTINE OpFM_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -424,12 +428,6 @@ SUBROUTINE OpFM_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -444,17 +442,17 @@ SUBROUTINE OpFM_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%NumSC2Ctrl = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NumSC2Ctrl = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 OutData%C_obj%NumSC2Ctrl = OutData%NumSC2Ctrl - OutData%NumCtrl2SC = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NumCtrl2SC = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 OutData%C_obj%NumCtrl2SC = OutData%NumCtrl2SC - OutData%NumActForcePtsBlade = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NumActForcePtsBlade = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 OutData%C_obj%NumActForcePtsBlade = OutData%NumActForcePtsBlade - OutData%NumActForcePtsTower = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NumActForcePtsTower = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 OutData%C_obj%NumActForcePtsTower = OutData%NumActForcePtsTower IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StructBldRNodes not allocated Int_Xferred = Int_Xferred + 1 @@ -472,15 +470,10 @@ SUBROUTINE OpFM_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E OutData%c_obj%StructBldRNodes_Len = SIZE(OutData%StructBldRNodes) IF (OutData%c_obj%StructBldRNodes_Len > 0) & OutData%c_obj%StructBldRNodes = C_LOC( OutData%StructBldRNodes(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%StructBldRNodes)>0) OutData%StructBldRNodes = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%StructBldRNodes))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%StructBldRNodes) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%StructBldRNodes,1), UBOUND(OutData%StructBldRNodes,1) + OutData%StructBldRNodes(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StructTwrHNodes not allocated Int_Xferred = Int_Xferred + 1 @@ -498,57 +491,112 @@ SUBROUTINE OpFM_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E OutData%c_obj%StructTwrHNodes_Len = SIZE(OutData%StructTwrHNodes) IF (OutData%c_obj%StructTwrHNodes_Len > 0) & OutData%c_obj%StructTwrHNodes = C_LOC( OutData%StructTwrHNodes(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%StructTwrHNodes)>0) OutData%StructTwrHNodes = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%StructTwrHNodes))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%StructTwrHNodes) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%StructTwrHNodes,1), UBOUND(OutData%StructTwrHNodes,1) + OutData%StructTwrHNodes(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%BladeLength = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%BladeLength = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 OutData%C_obj%BladeLength = OutData%BladeLength - OutData%TowerHeight = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%TowerHeight = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 OutData%C_obj%TowerHeight = OutData%TowerHeight - OutData%TowerBaseHeight = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%TowerBaseHeight = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 OutData%C_obj%TowerBaseHeight = OutData%TowerBaseHeight END SUBROUTINE OpFM_UnPackInitInput - SUBROUTINE OpFM_C2Fary_CopyInitInput( InitInputData, ErrStat, ErrMsg ) + SUBROUTINE OpFM_C2Fary_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers ) TYPE(OpFM_InitInputType), INTENT(INOUT) :: InitInputData 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 InitInputData%NumSC2Ctrl = InitInputData%C_obj%NumSC2Ctrl InitInputData%NumCtrl2SC = InitInputData%C_obj%NumCtrl2SC InitInputData%NumActForcePtsBlade = InitInputData%C_obj%NumActForcePtsBlade InitInputData%NumActForcePtsTower = InitInputData%C_obj%NumActForcePtsTower ! -- StructBldRNodes InitInput Data fields - IF ( .NOT. C_ASSOCIATED( InitInputData%C_obj%StructBldRNodes ) ) THEN - NULLIFY( InitInputData%StructBldRNodes ) - ELSE - CALL C_F_POINTER(InitInputData%C_obj%StructBldRNodes, InitInputData%StructBldRNodes, (/InitInputData%C_obj%StructBldRNodes_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InitInputData%C_obj%StructBldRNodes ) ) THEN + NULLIFY( InitInputData%StructBldRNodes ) + ELSE + CALL C_F_POINTER(InitInputData%C_obj%StructBldRNodes, InitInputData%StructBldRNodes, (/InitInputData%C_obj%StructBldRNodes_Len/)) + END IF END IF ! -- StructTwrHNodes InitInput Data fields - IF ( .NOT. C_ASSOCIATED( InitInputData%C_obj%StructTwrHNodes ) ) THEN - NULLIFY( InitInputData%StructTwrHNodes ) - ELSE - CALL C_F_POINTER(InitInputData%C_obj%StructTwrHNodes, InitInputData%StructTwrHNodes, (/InitInputData%C_obj%StructTwrHNodes_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InitInputData%C_obj%StructTwrHNodes ) ) THEN + NULLIFY( InitInputData%StructTwrHNodes ) + ELSE + CALL C_F_POINTER(InitInputData%C_obj%StructTwrHNodes, InitInputData%StructTwrHNodes, (/InitInputData%C_obj%StructTwrHNodes_Len/)) + END IF END IF InitInputData%BladeLength = InitInputData%C_obj%BladeLength InitInputData%TowerHeight = InitInputData%C_obj%TowerHeight InitInputData%TowerBaseHeight = InitInputData%C_obj%TowerBaseHeight END SUBROUTINE OpFM_C2Fary_CopyInitInput + SUBROUTINE OpFM_F2C_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(OpFM_InitInputType), INTENT(INOUT) :: InitInputData + 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 + InitInputData%C_obj%NumSC2Ctrl = InitInputData%NumSC2Ctrl + InitInputData%C_obj%NumCtrl2SC = InitInputData%NumCtrl2SC + InitInputData%C_obj%NumActForcePtsBlade = InitInputData%NumActForcePtsBlade + InitInputData%C_obj%NumActForcePtsTower = InitInputData%NumActForcePtsTower + + ! -- StructBldRNodes InitInput Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InitInputData%StructBldRNodes)) THEN + InitInputData%c_obj%StructBldRNodes_Len = 0 + InitInputData%c_obj%StructBldRNodes = C_NULL_PTR + 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) ) ) + END IF + END IF + + ! -- StructTwrHNodes InitInput Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InitInputData%StructTwrHNodes)) THEN + InitInputData%c_obj%StructTwrHNodes_Len = 0 + InitInputData%c_obj%StructTwrHNodes = C_NULL_PTR + 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) ) ) + END IF + END IF + InitInputData%C_obj%BladeLength = InitInputData%BladeLength + InitInputData%C_obj%TowerHeight = InitInputData%TowerHeight + InitInputData%C_obj%TowerBaseHeight = InitInputData%TowerBaseHeight + END SUBROUTINE OpFM_F2C_CopyInitInput + SUBROUTINE OpFM_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(OpFM_InitOutputType), INTENT(IN) :: SrcInitOutputData TYPE(OpFM_InitOutputType), INTENT(INOUT) :: DstInitOutputData @@ -713,12 +761,12 @@ SUBROUTINE OpFM_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) + DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) DO I = 1, LEN(InData%WriteOutputHdr) IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdr(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -730,12 +778,12 @@ SUBROUTINE OpFM_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) + DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) DO I = 1, LEN(InData%WriteOutputUnt) IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUnt(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -780,12 +828,6 @@ SUBROUTINE OpFM_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -813,19 +855,12 @@ SUBROUTINE OpFM_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) DO I = 1, LEN(OutData%WriteOutputHdr) OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated Int_Xferred = Int_Xferred + 1 @@ -840,19 +875,12 @@ SUBROUTINE OpFM_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) DO I = 1, LEN(OutData%WriteOutputUnt) OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -896,15 +924,40 @@ SUBROUTINE OpFM_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END SUBROUTINE OpFM_UnPackInitOutput - SUBROUTINE OpFM_C2Fary_CopyInitOutput( InitOutputData, ErrStat, ErrMsg ) + SUBROUTINE OpFM_C2Fary_CopyInitOutput( InitOutputData, ErrStat, ErrMsg, SkipPointers ) TYPE(OpFM_InitOutputType), INTENT(INOUT) :: InitOutputData 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 OpFM_C2Fary_CopyInitOutput + SUBROUTINE OpFM_F2C_CopyInitOutput( InitOutputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(OpFM_InitOutputType), INTENT(INOUT) :: InitOutputData + 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 OpFM_F2C_CopyInitOutput + SUBROUTINE OpFM_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) TYPE(OpFM_MiscVarType), INTENT(INOUT) :: SrcMiscData TYPE(OpFM_MiscVarType), INTENT(INOUT) :: DstMiscData @@ -1701,12 +1754,6 @@ SUBROUTINE OpFM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -2171,15 +2218,40 @@ SUBROUTINE OpFM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg END IF END SUBROUTINE OpFM_UnPackMisc - SUBROUTINE OpFM_C2Fary_CopyMisc( MiscData, ErrStat, ErrMsg ) + SUBROUTINE OpFM_C2Fary_CopyMisc( MiscData, ErrStat, ErrMsg, SkipPointers ) TYPE(OpFM_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 OpFM_C2Fary_CopyMisc + SUBROUTINE OpFM_F2C_CopyMisc( MiscData, ErrStat, ErrMsg, SkipPointers ) + TYPE(OpFM_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 OpFM_F2C_CopyMisc + SUBROUTINE OpFM_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) TYPE(OpFM_ParameterType), INTENT(IN) :: SrcParamData TYPE(OpFM_ParameterType), INTENT(INOUT) :: DstParamData @@ -2354,20 +2426,20 @@ SUBROUTINE OpFM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AirDens - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumBl - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NMappings - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NnodesVel - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NnodesForce - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NnodesForceBlade - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NnodesForceTower - Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AirDens + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumBl + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NMappings + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NnodesVel + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NnodesForce + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NnodesForceBlade + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NnodesForceTower + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ASSOCIATED(InData%forceBldRnodes) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2378,8 +2450,10 @@ SUBROUTINE OpFM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%forceBldRnodes,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%forceBldRnodes)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%forceBldRnodes))-1 ) = PACK(InData%forceBldRnodes,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%forceBldRnodes) + DO i1 = LBOUND(InData%forceBldRnodes,1), UBOUND(InData%forceBldRnodes,1) + ReKiBuf(Re_Xferred) = InData%forceBldRnodes(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%forceTwrHnodes) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2391,15 +2465,17 @@ SUBROUTINE OpFM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%forceTwrHnodes,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%forceTwrHnodes)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%forceTwrHnodes))-1 ) = PACK(InData%forceTwrHnodes,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%forceTwrHnodes) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%BladeLength - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TowerHeight - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TowerBaseHeight - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%forceTwrHnodes,1), UBOUND(InData%forceTwrHnodes,1) + ReKiBuf(Re_Xferred) = InData%forceTwrHnodes(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%BladeLength + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TowerHeight + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TowerBaseHeight + Re_Xferred = Re_Xferred + 1 END SUBROUTINE OpFM_PackParam SUBROUTINE OpFM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2415,12 +2491,6 @@ SUBROUTINE OpFM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -2435,26 +2505,26 @@ SUBROUTINE OpFM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%AirDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%AirDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 OutData%C_obj%AirDens = OutData%AirDens - OutData%NumBl = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NumBl = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 OutData%C_obj%NumBl = OutData%NumBl - OutData%NMappings = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NMappings = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 OutData%C_obj%NMappings = OutData%NMappings - OutData%NnodesVel = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NnodesVel = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 OutData%C_obj%NnodesVel = OutData%NnodesVel - OutData%NnodesForce = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NnodesForce = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 OutData%C_obj%NnodesForce = OutData%NnodesForce - OutData%NnodesForceBlade = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NnodesForceBlade = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 OutData%C_obj%NnodesForceBlade = OutData%NnodesForceBlade - OutData%NnodesForceTower = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NnodesForceTower = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 OutData%C_obj%NnodesForceTower = OutData%NnodesForceTower IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! forceBldRnodes not allocated Int_Xferred = Int_Xferred + 1 @@ -2472,15 +2542,10 @@ SUBROUTINE OpFM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs OutData%c_obj%forceBldRnodes_Len = SIZE(OutData%forceBldRnodes) IF (OutData%c_obj%forceBldRnodes_Len > 0) & OutData%c_obj%forceBldRnodes = C_LOC( OutData%forceBldRnodes(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%forceBldRnodes)>0) OutData%forceBldRnodes = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%forceBldRnodes))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%forceBldRnodes) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%forceBldRnodes,1), UBOUND(OutData%forceBldRnodes,1) + OutData%forceBldRnodes(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! forceTwrHnodes not allocated Int_Xferred = Int_Xferred + 1 @@ -2498,34 +2563,37 @@ SUBROUTINE OpFM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs OutData%c_obj%forceTwrHnodes_Len = SIZE(OutData%forceTwrHnodes) IF (OutData%c_obj%forceTwrHnodes_Len > 0) & OutData%c_obj%forceTwrHnodes = C_LOC( OutData%forceTwrHnodes(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%forceTwrHnodes)>0) OutData%forceTwrHnodes = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%forceTwrHnodes))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%forceTwrHnodes) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%forceTwrHnodes,1), UBOUND(OutData%forceTwrHnodes,1) + OutData%forceTwrHnodes(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%BladeLength = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%BladeLength = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 OutData%C_obj%BladeLength = OutData%BladeLength - OutData%TowerHeight = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%TowerHeight = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 OutData%C_obj%TowerHeight = OutData%TowerHeight - OutData%TowerBaseHeight = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%TowerBaseHeight = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 OutData%C_obj%TowerBaseHeight = OutData%TowerBaseHeight END SUBROUTINE OpFM_UnPackParam - SUBROUTINE OpFM_C2Fary_CopyParam( ParamData, ErrStat, ErrMsg ) + SUBROUTINE OpFM_C2Fary_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) TYPE(OpFM_ParameterType), INTENT(INOUT) :: ParamData 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 ParamData%AirDens = ParamData%C_obj%AirDens ParamData%NumBl = ParamData%C_obj%NumBl ParamData%NMappings = ParamData%C_obj%NMappings @@ -2535,23 +2603,78 @@ SUBROUTINE OpFM_C2Fary_CopyParam( ParamData, ErrStat, ErrMsg ) ParamData%NnodesForceTower = ParamData%C_obj%NnodesForceTower ! -- forceBldRnodes Param Data fields - IF ( .NOT. C_ASSOCIATED( ParamData%C_obj%forceBldRnodes ) ) THEN - NULLIFY( ParamData%forceBldRnodes ) - ELSE - CALL C_F_POINTER(ParamData%C_obj%forceBldRnodes, ParamData%forceBldRnodes, (/ParamData%C_obj%forceBldRnodes_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ParamData%C_obj%forceBldRnodes ) ) THEN + NULLIFY( ParamData%forceBldRnodes ) + ELSE + CALL C_F_POINTER(ParamData%C_obj%forceBldRnodes, ParamData%forceBldRnodes, (/ParamData%C_obj%forceBldRnodes_Len/)) + END IF END IF ! -- forceTwrHnodes Param Data fields - IF ( .NOT. C_ASSOCIATED( ParamData%C_obj%forceTwrHnodes ) ) THEN - NULLIFY( ParamData%forceTwrHnodes ) - ELSE - CALL C_F_POINTER(ParamData%C_obj%forceTwrHnodes, ParamData%forceTwrHnodes, (/ParamData%C_obj%forceTwrHnodes_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ParamData%C_obj%forceTwrHnodes ) ) THEN + NULLIFY( ParamData%forceTwrHnodes ) + ELSE + CALL C_F_POINTER(ParamData%C_obj%forceTwrHnodes, ParamData%forceTwrHnodes, (/ParamData%C_obj%forceTwrHnodes_Len/)) + END IF END IF ParamData%BladeLength = ParamData%C_obj%BladeLength ParamData%TowerHeight = ParamData%C_obj%TowerHeight ParamData%TowerBaseHeight = ParamData%C_obj%TowerBaseHeight END SUBROUTINE OpFM_C2Fary_CopyParam + SUBROUTINE OpFM_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) + TYPE(OpFM_ParameterType), INTENT(INOUT) :: ParamData + 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 + ParamData%C_obj%AirDens = ParamData%AirDens + ParamData%C_obj%NumBl = ParamData%NumBl + ParamData%C_obj%NMappings = ParamData%NMappings + ParamData%C_obj%NnodesVel = ParamData%NnodesVel + ParamData%C_obj%NnodesForce = ParamData%NnodesForce + ParamData%C_obj%NnodesForceBlade = ParamData%NnodesForceBlade + ParamData%C_obj%NnodesForceTower = ParamData%NnodesForceTower + + ! -- forceBldRnodes Param Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(ParamData%forceBldRnodes)) THEN + ParamData%c_obj%forceBldRnodes_Len = 0 + ParamData%c_obj%forceBldRnodes = C_NULL_PTR + 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) ) ) + END IF + END IF + + ! -- forceTwrHnodes Param Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(ParamData%forceTwrHnodes)) THEN + ParamData%c_obj%forceTwrHnodes_Len = 0 + ParamData%c_obj%forceTwrHnodes = C_NULL_PTR + 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) ) ) + END IF + END IF + ParamData%C_obj%BladeLength = ParamData%BladeLength + ParamData%C_obj%TowerHeight = ParamData%TowerHeight + ParamData%C_obj%TowerBaseHeight = ParamData%TowerBaseHeight + END SUBROUTINE OpFM_F2C_CopyParam + SUBROUTINE OpFM_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) TYPE(OpFM_InputType), INTENT(IN) :: SrcInputData TYPE(OpFM_InputType), INTENT(INOUT) :: DstInputData @@ -3044,8 +3167,10 @@ SUBROUTINE OpFM_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pxVel,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%pxVel)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%pxVel))-1 ) = PACK(InData%pxVel,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%pxVel) + DO i1 = LBOUND(InData%pxVel,1), UBOUND(InData%pxVel,1) + ReKiBuf(Re_Xferred) = InData%pxVel(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%pyVel) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3057,8 +3182,10 @@ SUBROUTINE OpFM_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pyVel,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%pyVel)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%pyVel))-1 ) = PACK(InData%pyVel,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%pyVel) + DO i1 = LBOUND(InData%pyVel,1), UBOUND(InData%pyVel,1) + ReKiBuf(Re_Xferred) = InData%pyVel(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%pzVel) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3070,8 +3197,10 @@ SUBROUTINE OpFM_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pzVel,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%pzVel)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%pzVel))-1 ) = PACK(InData%pzVel,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%pzVel) + DO i1 = LBOUND(InData%pzVel,1), UBOUND(InData%pzVel,1) + ReKiBuf(Re_Xferred) = InData%pzVel(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%pxForce) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3083,8 +3212,10 @@ SUBROUTINE OpFM_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pxForce,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%pxForce)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%pxForce))-1 ) = PACK(InData%pxForce,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%pxForce) + DO i1 = LBOUND(InData%pxForce,1), UBOUND(InData%pxForce,1) + ReKiBuf(Re_Xferred) = InData%pxForce(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%pyForce) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3096,8 +3227,10 @@ SUBROUTINE OpFM_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pyForce,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%pyForce)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%pyForce))-1 ) = PACK(InData%pyForce,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%pyForce) + DO i1 = LBOUND(InData%pyForce,1), UBOUND(InData%pyForce,1) + ReKiBuf(Re_Xferred) = InData%pyForce(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%pzForce) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3109,8 +3242,10 @@ SUBROUTINE OpFM_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pzForce,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%pzForce)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%pzForce))-1 ) = PACK(InData%pzForce,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%pzForce) + DO i1 = LBOUND(InData%pzForce,1), UBOUND(InData%pzForce,1) + ReKiBuf(Re_Xferred) = InData%pzForce(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%pOrientation) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3122,8 +3257,10 @@ SUBROUTINE OpFM_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pOrientation,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%pOrientation)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%pOrientation))-1 ) = PACK(InData%pOrientation,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%pOrientation) + DO i1 = LBOUND(InData%pOrientation,1), UBOUND(InData%pOrientation,1) + ReKiBuf(Re_Xferred) = InData%pOrientation(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%fx) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3135,8 +3272,10 @@ SUBROUTINE OpFM_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fx,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%fx)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%fx))-1 ) = PACK(InData%fx,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%fx) + DO i1 = LBOUND(InData%fx,1), UBOUND(InData%fx,1) + ReKiBuf(Re_Xferred) = InData%fx(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%fy) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3148,8 +3287,10 @@ SUBROUTINE OpFM_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fy,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%fy)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%fy))-1 ) = PACK(InData%fy,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%fy) + DO i1 = LBOUND(InData%fy,1), UBOUND(InData%fy,1) + ReKiBuf(Re_Xferred) = InData%fy(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%fz) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3161,8 +3302,10 @@ SUBROUTINE OpFM_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fz,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%fz)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%fz))-1 ) = PACK(InData%fz,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%fz) + DO i1 = LBOUND(InData%fz,1), UBOUND(InData%fz,1) + ReKiBuf(Re_Xferred) = InData%fz(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%momentx) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3174,8 +3317,10 @@ SUBROUTINE OpFM_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%momentx,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%momentx)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%momentx))-1 ) = PACK(InData%momentx,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%momentx) + DO i1 = LBOUND(InData%momentx,1), UBOUND(InData%momentx,1) + ReKiBuf(Re_Xferred) = InData%momentx(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%momenty) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3187,8 +3332,10 @@ SUBROUTINE OpFM_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%momenty,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%momenty)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%momenty))-1 ) = PACK(InData%momenty,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%momenty) + DO i1 = LBOUND(InData%momenty,1), UBOUND(InData%momenty,1) + ReKiBuf(Re_Xferred) = InData%momenty(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%momentz) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3200,8 +3347,10 @@ SUBROUTINE OpFM_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%momentz,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%momentz)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%momentz))-1 ) = PACK(InData%momentz,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%momentz) + DO i1 = LBOUND(InData%momentz,1), UBOUND(InData%momentz,1) + ReKiBuf(Re_Xferred) = InData%momentz(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%forceNodesChord) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3213,8 +3362,10 @@ SUBROUTINE OpFM_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%forceNodesChord,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%forceNodesChord)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%forceNodesChord))-1 ) = PACK(InData%forceNodesChord,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%forceNodesChord) + DO i1 = LBOUND(InData%forceNodesChord,1), UBOUND(InData%forceNodesChord,1) + ReKiBuf(Re_Xferred) = InData%forceNodesChord(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%SuperController) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3226,8 +3377,10 @@ SUBROUTINE OpFM_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SuperController,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%SuperController)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SuperController))-1 ) = PACK(InData%SuperController,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SuperController) + DO i1 = LBOUND(InData%SuperController,1), UBOUND(InData%SuperController,1) + ReKiBuf(Re_Xferred) = InData%SuperController(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE OpFM_PackInput @@ -3244,12 +3397,6 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -3280,15 +3427,10 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs OutData%c_obj%pxVel_Len = SIZE(OutData%pxVel) IF (OutData%c_obj%pxVel_Len > 0) & OutData%c_obj%pxVel = C_LOC( OutData%pxVel(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%pxVel)>0) OutData%pxVel = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%pxVel))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%pxVel) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%pxVel,1), UBOUND(OutData%pxVel,1) + OutData%pxVel(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! pyVel not allocated Int_Xferred = Int_Xferred + 1 @@ -3306,15 +3448,10 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs OutData%c_obj%pyVel_Len = SIZE(OutData%pyVel) IF (OutData%c_obj%pyVel_Len > 0) & OutData%c_obj%pyVel = C_LOC( OutData%pyVel(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%pyVel)>0) OutData%pyVel = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%pyVel))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%pyVel) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%pyVel,1), UBOUND(OutData%pyVel,1) + OutData%pyVel(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! pzVel not allocated Int_Xferred = Int_Xferred + 1 @@ -3332,15 +3469,10 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs OutData%c_obj%pzVel_Len = SIZE(OutData%pzVel) IF (OutData%c_obj%pzVel_Len > 0) & OutData%c_obj%pzVel = C_LOC( OutData%pzVel(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%pzVel)>0) OutData%pzVel = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%pzVel))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%pzVel) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%pzVel,1), UBOUND(OutData%pzVel,1) + OutData%pzVel(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! pxForce not allocated Int_Xferred = Int_Xferred + 1 @@ -3358,15 +3490,10 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs OutData%c_obj%pxForce_Len = SIZE(OutData%pxForce) IF (OutData%c_obj%pxForce_Len > 0) & OutData%c_obj%pxForce = C_LOC( OutData%pxForce(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%pxForce)>0) OutData%pxForce = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%pxForce))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%pxForce) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%pxForce,1), UBOUND(OutData%pxForce,1) + OutData%pxForce(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! pyForce not allocated Int_Xferred = Int_Xferred + 1 @@ -3384,15 +3511,10 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs OutData%c_obj%pyForce_Len = SIZE(OutData%pyForce) IF (OutData%c_obj%pyForce_Len > 0) & OutData%c_obj%pyForce = C_LOC( OutData%pyForce(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%pyForce)>0) OutData%pyForce = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%pyForce))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%pyForce) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%pyForce,1), UBOUND(OutData%pyForce,1) + OutData%pyForce(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! pzForce not allocated Int_Xferred = Int_Xferred + 1 @@ -3410,15 +3532,10 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs OutData%c_obj%pzForce_Len = SIZE(OutData%pzForce) IF (OutData%c_obj%pzForce_Len > 0) & OutData%c_obj%pzForce = C_LOC( OutData%pzForce(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%pzForce)>0) OutData%pzForce = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%pzForce))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%pzForce) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%pzForce,1), UBOUND(OutData%pzForce,1) + OutData%pzForce(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! pOrientation not allocated Int_Xferred = Int_Xferred + 1 @@ -3436,15 +3553,10 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs OutData%c_obj%pOrientation_Len = SIZE(OutData%pOrientation) IF (OutData%c_obj%pOrientation_Len > 0) & OutData%c_obj%pOrientation = C_LOC( OutData%pOrientation(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%pOrientation)>0) OutData%pOrientation = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%pOrientation))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%pOrientation) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%pOrientation,1), UBOUND(OutData%pOrientation,1) + OutData%pOrientation(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fx not allocated Int_Xferred = Int_Xferred + 1 @@ -3462,15 +3574,10 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs OutData%c_obj%fx_Len = SIZE(OutData%fx) IF (OutData%c_obj%fx_Len > 0) & OutData%c_obj%fx = C_LOC( OutData%fx(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%fx)>0) OutData%fx = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%fx))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%fx) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%fx,1), UBOUND(OutData%fx,1) + OutData%fx(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fy not allocated Int_Xferred = Int_Xferred + 1 @@ -3488,15 +3595,10 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs OutData%c_obj%fy_Len = SIZE(OutData%fy) IF (OutData%c_obj%fy_Len > 0) & OutData%c_obj%fy = C_LOC( OutData%fy(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%fy)>0) OutData%fy = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%fy))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%fy) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%fy,1), UBOUND(OutData%fy,1) + OutData%fy(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fz not allocated Int_Xferred = Int_Xferred + 1 @@ -3514,15 +3616,10 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs OutData%c_obj%fz_Len = SIZE(OutData%fz) IF (OutData%c_obj%fz_Len > 0) & OutData%c_obj%fz = C_LOC( OutData%fz(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%fz)>0) OutData%fz = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%fz))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%fz) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%fz,1), UBOUND(OutData%fz,1) + OutData%fz(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! momentx not allocated Int_Xferred = Int_Xferred + 1 @@ -3540,15 +3637,10 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs OutData%c_obj%momentx_Len = SIZE(OutData%momentx) IF (OutData%c_obj%momentx_Len > 0) & OutData%c_obj%momentx = C_LOC( OutData%momentx(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%momentx)>0) OutData%momentx = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%momentx))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%momentx) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%momentx,1), UBOUND(OutData%momentx,1) + OutData%momentx(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! momenty not allocated Int_Xferred = Int_Xferred + 1 @@ -3566,15 +3658,10 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs OutData%c_obj%momenty_Len = SIZE(OutData%momenty) IF (OutData%c_obj%momenty_Len > 0) & OutData%c_obj%momenty = C_LOC( OutData%momenty(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%momenty)>0) OutData%momenty = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%momenty))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%momenty) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%momenty,1), UBOUND(OutData%momenty,1) + OutData%momenty(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! momentz not allocated Int_Xferred = Int_Xferred + 1 @@ -3592,15 +3679,10 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs OutData%c_obj%momentz_Len = SIZE(OutData%momentz) IF (OutData%c_obj%momentz_Len > 0) & OutData%c_obj%momentz = C_LOC( OutData%momentz(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%momentz)>0) OutData%momentz = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%momentz))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%momentz) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%momentz,1), UBOUND(OutData%momentz,1) + OutData%momentz(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! forceNodesChord not allocated Int_Xferred = Int_Xferred + 1 @@ -3618,15 +3700,10 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs OutData%c_obj%forceNodesChord_Len = SIZE(OutData%forceNodesChord) IF (OutData%c_obj%forceNodesChord_Len > 0) & OutData%c_obj%forceNodesChord = C_LOC( OutData%forceNodesChord(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%forceNodesChord)>0) OutData%forceNodesChord = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%forceNodesChord))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%forceNodesChord) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%forceNodesChord,1), UBOUND(OutData%forceNodesChord,1) + OutData%forceNodesChord(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SuperController not allocated Int_Xferred = Int_Xferred + 1 @@ -3644,132 +3721,362 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs OutData%c_obj%SuperController_Len = SIZE(OutData%SuperController) IF (OutData%c_obj%SuperController_Len > 0) & OutData%c_obj%SuperController = C_LOC( OutData%SuperController(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%SuperController)>0) OutData%SuperController = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SuperController))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%SuperController) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%SuperController,1), UBOUND(OutData%SuperController,1) + OutData%SuperController(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE OpFM_UnPackInput - SUBROUTINE OpFM_C2Fary_CopyInput( InputData, ErrStat, ErrMsg ) + SUBROUTINE OpFM_C2Fary_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) TYPE(OpFM_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" - ! -- pxVel Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pxVel ) ) THEN - NULLIFY( InputData%pxVel ) + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers ELSE - CALL C_F_POINTER(InputData%C_obj%pxVel, InputData%pxVel, (/InputData%C_obj%pxVel_Len/)) + SkipPointers_local = .false. + END IF + + ! -- pxVel Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pxVel ) ) THEN + NULLIFY( InputData%pxVel ) + ELSE + CALL C_F_POINTER(InputData%C_obj%pxVel, InputData%pxVel, (/InputData%C_obj%pxVel_Len/)) + END IF END IF ! -- pyVel Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pyVel ) ) THEN - NULLIFY( InputData%pyVel ) - ELSE - CALL C_F_POINTER(InputData%C_obj%pyVel, InputData%pyVel, (/InputData%C_obj%pyVel_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pyVel ) ) THEN + NULLIFY( InputData%pyVel ) + ELSE + CALL C_F_POINTER(InputData%C_obj%pyVel, InputData%pyVel, (/InputData%C_obj%pyVel_Len/)) + END IF END IF ! -- pzVel Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pzVel ) ) THEN - NULLIFY( InputData%pzVel ) - ELSE - CALL C_F_POINTER(InputData%C_obj%pzVel, InputData%pzVel, (/InputData%C_obj%pzVel_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pzVel ) ) THEN + NULLIFY( InputData%pzVel ) + ELSE + CALL C_F_POINTER(InputData%C_obj%pzVel, InputData%pzVel, (/InputData%C_obj%pzVel_Len/)) + END IF END IF ! -- pxForce Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pxForce ) ) THEN - NULLIFY( InputData%pxForce ) - ELSE - CALL C_F_POINTER(InputData%C_obj%pxForce, InputData%pxForce, (/InputData%C_obj%pxForce_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pxForce ) ) THEN + NULLIFY( InputData%pxForce ) + ELSE + CALL C_F_POINTER(InputData%C_obj%pxForce, InputData%pxForce, (/InputData%C_obj%pxForce_Len/)) + END IF END IF ! -- pyForce Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pyForce ) ) THEN - NULLIFY( InputData%pyForce ) - ELSE - CALL C_F_POINTER(InputData%C_obj%pyForce, InputData%pyForce, (/InputData%C_obj%pyForce_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pyForce ) ) THEN + NULLIFY( InputData%pyForce ) + ELSE + CALL C_F_POINTER(InputData%C_obj%pyForce, InputData%pyForce, (/InputData%C_obj%pyForce_Len/)) + END IF END IF ! -- pzForce Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pzForce ) ) THEN - NULLIFY( InputData%pzForce ) - ELSE - CALL C_F_POINTER(InputData%C_obj%pzForce, InputData%pzForce, (/InputData%C_obj%pzForce_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pzForce ) ) THEN + NULLIFY( InputData%pzForce ) + ELSE + CALL C_F_POINTER(InputData%C_obj%pzForce, InputData%pzForce, (/InputData%C_obj%pzForce_Len/)) + END IF END IF ! -- pOrientation Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pOrientation ) ) THEN - NULLIFY( InputData%pOrientation ) - ELSE - CALL C_F_POINTER(InputData%C_obj%pOrientation, InputData%pOrientation, (/InputData%C_obj%pOrientation_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pOrientation ) ) THEN + NULLIFY( InputData%pOrientation ) + ELSE + CALL C_F_POINTER(InputData%C_obj%pOrientation, InputData%pOrientation, (/InputData%C_obj%pOrientation_Len/)) + END IF END IF ! -- fx Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%fx ) ) THEN - NULLIFY( InputData%fx ) - ELSE - CALL C_F_POINTER(InputData%C_obj%fx, InputData%fx, (/InputData%C_obj%fx_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%fx ) ) THEN + NULLIFY( InputData%fx ) + ELSE + CALL C_F_POINTER(InputData%C_obj%fx, InputData%fx, (/InputData%C_obj%fx_Len/)) + END IF END IF ! -- fy Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%fy ) ) THEN - NULLIFY( InputData%fy ) - ELSE - CALL C_F_POINTER(InputData%C_obj%fy, InputData%fy, (/InputData%C_obj%fy_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%fy ) ) THEN + NULLIFY( InputData%fy ) + ELSE + CALL C_F_POINTER(InputData%C_obj%fy, InputData%fy, (/InputData%C_obj%fy_Len/)) + END IF END IF ! -- fz Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%fz ) ) THEN - NULLIFY( InputData%fz ) - ELSE - CALL C_F_POINTER(InputData%C_obj%fz, InputData%fz, (/InputData%C_obj%fz_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%fz ) ) THEN + NULLIFY( InputData%fz ) + ELSE + CALL C_F_POINTER(InputData%C_obj%fz, InputData%fz, (/InputData%C_obj%fz_Len/)) + END IF END IF ! -- momentx Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%momentx ) ) THEN - NULLIFY( InputData%momentx ) - ELSE - CALL C_F_POINTER(InputData%C_obj%momentx, InputData%momentx, (/InputData%C_obj%momentx_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%momentx ) ) THEN + NULLIFY( InputData%momentx ) + ELSE + CALL C_F_POINTER(InputData%C_obj%momentx, InputData%momentx, (/InputData%C_obj%momentx_Len/)) + END IF END IF ! -- momenty Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%momenty ) ) THEN - NULLIFY( InputData%momenty ) - ELSE - CALL C_F_POINTER(InputData%C_obj%momenty, InputData%momenty, (/InputData%C_obj%momenty_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%momenty ) ) THEN + NULLIFY( InputData%momenty ) + ELSE + CALL C_F_POINTER(InputData%C_obj%momenty, InputData%momenty, (/InputData%C_obj%momenty_Len/)) + END IF END IF ! -- momentz Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%momentz ) ) THEN - NULLIFY( InputData%momentz ) - ELSE - CALL C_F_POINTER(InputData%C_obj%momentz, InputData%momentz, (/InputData%C_obj%momentz_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%momentz ) ) THEN + NULLIFY( InputData%momentz ) + ELSE + CALL C_F_POINTER(InputData%C_obj%momentz, InputData%momentz, (/InputData%C_obj%momentz_Len/)) + END IF END IF ! -- forceNodesChord Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%forceNodesChord ) ) THEN - NULLIFY( InputData%forceNodesChord ) - ELSE - CALL C_F_POINTER(InputData%C_obj%forceNodesChord, InputData%forceNodesChord, (/InputData%C_obj%forceNodesChord_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%forceNodesChord ) ) THEN + NULLIFY( InputData%forceNodesChord ) + ELSE + CALL C_F_POINTER(InputData%C_obj%forceNodesChord, InputData%forceNodesChord, (/InputData%C_obj%forceNodesChord_Len/)) + END IF END IF ! -- SuperController Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%SuperController ) ) THEN - NULLIFY( InputData%SuperController ) - ELSE - CALL C_F_POINTER(InputData%C_obj%SuperController, InputData%SuperController, (/InputData%C_obj%SuperController_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%SuperController ) ) THEN + NULLIFY( InputData%SuperController ) + ELSE + CALL C_F_POINTER(InputData%C_obj%SuperController, InputData%SuperController, (/InputData%C_obj%SuperController_Len/)) + END IF END IF END SUBROUTINE OpFM_C2Fary_CopyInput + SUBROUTINE OpFM_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(OpFM_InputType), INTENT(INOUT) :: InputData + 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 + + ! -- pxVel Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%pxVel)) THEN + InputData%c_obj%pxVel_Len = 0 + InputData%c_obj%pxVel = C_NULL_PTR + 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) ) ) + END IF + END IF + + ! -- pyVel Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%pyVel)) THEN + InputData%c_obj%pyVel_Len = 0 + InputData%c_obj%pyVel = C_NULL_PTR + 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) ) ) + END IF + END IF + + ! -- pzVel Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%pzVel)) THEN + InputData%c_obj%pzVel_Len = 0 + InputData%c_obj%pzVel = C_NULL_PTR + 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) ) ) + END IF + END IF + + ! -- pxForce Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%pxForce)) THEN + InputData%c_obj%pxForce_Len = 0 + InputData%c_obj%pxForce = C_NULL_PTR + 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) ) ) + END IF + END IF + + ! -- pyForce Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%pyForce)) THEN + InputData%c_obj%pyForce_Len = 0 + InputData%c_obj%pyForce = C_NULL_PTR + 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) ) ) + END IF + END IF + + ! -- pzForce Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%pzForce)) THEN + InputData%c_obj%pzForce_Len = 0 + InputData%c_obj%pzForce = C_NULL_PTR + 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) ) ) + END IF + END IF + + ! -- pOrientation Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%pOrientation)) THEN + InputData%c_obj%pOrientation_Len = 0 + InputData%c_obj%pOrientation = C_NULL_PTR + 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) ) ) + END IF + END IF + + ! -- fx Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%fx)) THEN + InputData%c_obj%fx_Len = 0 + InputData%c_obj%fx = C_NULL_PTR + 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) ) ) + END IF + END IF + + ! -- fy Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%fy)) THEN + InputData%c_obj%fy_Len = 0 + InputData%c_obj%fy = C_NULL_PTR + 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) ) ) + END IF + END IF + + ! -- fz Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%fz)) THEN + InputData%c_obj%fz_Len = 0 + InputData%c_obj%fz = C_NULL_PTR + 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) ) ) + END IF + END IF + + ! -- momentx Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%momentx)) THEN + InputData%c_obj%momentx_Len = 0 + InputData%c_obj%momentx = C_NULL_PTR + 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) ) ) + END IF + END IF + + ! -- momenty Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%momenty)) THEN + InputData%c_obj%momenty_Len = 0 + InputData%c_obj%momenty = C_NULL_PTR + 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) ) ) + END IF + END IF + + ! -- momentz Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%momentz)) THEN + InputData%c_obj%momentz_Len = 0 + InputData%c_obj%momentz = C_NULL_PTR + 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) ) ) + END IF + END IF + + ! -- forceNodesChord Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%forceNodesChord)) THEN + InputData%c_obj%forceNodesChord_Len = 0 + InputData%c_obj%forceNodesChord = C_NULL_PTR + 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) ) ) + END IF + END IF + + ! -- SuperController Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%SuperController)) THEN + InputData%c_obj%SuperController_Len = 0 + InputData%c_obj%SuperController = C_NULL_PTR + ELSE + InputData%c_obj%SuperController_Len = SIZE(InputData%SuperController) + IF (InputData%c_obj%SuperController_Len > 0) & + InputData%c_obj%SuperController = C_LOC( InputData%SuperController( LBOUND(InputData%SuperController,1) ) ) + END IF + END IF + END SUBROUTINE OpFM_F2C_CopyInput + SUBROUTINE OpFM_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(OpFM_OutputType), INTENT(IN) :: SrcOutputData TYPE(OpFM_OutputType), INTENT(INOUT) :: DstOutputData @@ -3856,7 +4163,6 @@ SUBROUTINE OpFM_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err END IF END IF DstOutputData%WriteOutput = SrcOutputData%WriteOutput - DstOutputData%C_obj%WriteOutput = SrcOutputData%C_obj%WriteOutput ENDIF END SUBROUTINE OpFM_CopyOutput @@ -3997,8 +4303,10 @@ SUBROUTINE OpFM_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%u)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%u))-1 ) = PACK(InData%u,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%u) + DO i1 = LBOUND(InData%u,1), UBOUND(InData%u,1) + ReKiBuf(Re_Xferred) = InData%u(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%v) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4010,8 +4318,10 @@ SUBROUTINE OpFM_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%v,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%v)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%v))-1 ) = PACK(InData%v,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%v) + DO i1 = LBOUND(InData%v,1), UBOUND(InData%v,1) + ReKiBuf(Re_Xferred) = InData%v(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%w) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4023,8 +4333,10 @@ SUBROUTINE OpFM_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%w,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%w)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%w))-1 ) = PACK(InData%w,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%w) + DO i1 = LBOUND(InData%w,1), UBOUND(InData%w,1) + ReKiBuf(Re_Xferred) = InData%w(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%SuperController) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4036,8 +4348,10 @@ SUBROUTINE OpFM_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SuperController,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%SuperController)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SuperController))-1 ) = PACK(InData%SuperController,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SuperController) + DO i1 = LBOUND(InData%SuperController,1), UBOUND(InData%SuperController,1) + ReKiBuf(Re_Xferred) = InData%SuperController(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutput) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4049,8 +4363,10 @@ SUBROUTINE OpFM_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WriteOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE OpFM_PackOutput @@ -4067,12 +4383,6 @@ SUBROUTINE OpFM_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -4103,15 +4413,10 @@ SUBROUTINE OpFM_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM OutData%c_obj%u_Len = SIZE(OutData%u) IF (OutData%c_obj%u_Len > 0) & OutData%c_obj%u = C_LOC( OutData%u(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%u)>0) OutData%u = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%u))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%u) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%u,1), UBOUND(OutData%u,1) + OutData%u(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! v not allocated Int_Xferred = Int_Xferred + 1 @@ -4129,15 +4434,10 @@ SUBROUTINE OpFM_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM OutData%c_obj%v_Len = SIZE(OutData%v) IF (OutData%c_obj%v_Len > 0) & OutData%c_obj%v = C_LOC( OutData%v(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%v)>0) OutData%v = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%v))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%v) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%v,1), UBOUND(OutData%v,1) + OutData%v(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! w not allocated Int_Xferred = Int_Xferred + 1 @@ -4155,15 +4455,10 @@ SUBROUTINE OpFM_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM OutData%c_obj%w_Len = SIZE(OutData%w) IF (OutData%c_obj%w_Len > 0) & OutData%c_obj%w = C_LOC( OutData%w(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%w)>0) OutData%w = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%w))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%w) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%w,1), UBOUND(OutData%w,1) + OutData%w(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SuperController not allocated Int_Xferred = Int_Xferred + 1 @@ -4181,15 +4476,10 @@ SUBROUTINE OpFM_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM OutData%c_obj%SuperController_Len = SIZE(OutData%SuperController) IF (OutData%c_obj%SuperController_Len > 0) & OutData%c_obj%SuperController = C_LOC( OutData%SuperController(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%SuperController)>0) OutData%SuperController = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SuperController))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%SuperController) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%SuperController,1), UBOUND(OutData%SuperController,1) + OutData%SuperController(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutput not allocated Int_Xferred = Int_Xferred + 1 @@ -4204,55 +4494,131 @@ SUBROUTINE OpFM_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WriteOutput)>0) OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE OpFM_UnPackOutput - SUBROUTINE OpFM_C2Fary_CopyOutput( OutputData, ErrStat, ErrMsg ) + SUBROUTINE OpFM_C2Fary_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) TYPE(OpFM_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" - ! -- u Output Data fields - IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%u ) ) THEN - NULLIFY( OutputData%u ) + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers ELSE - CALL C_F_POINTER(OutputData%C_obj%u, OutputData%u, (/OutputData%C_obj%u_Len/)) + SkipPointers_local = .false. + END IF + + ! -- u Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%u ) ) THEN + NULLIFY( OutputData%u ) + ELSE + CALL C_F_POINTER(OutputData%C_obj%u, OutputData%u, (/OutputData%C_obj%u_Len/)) + END IF END IF ! -- v Output Data fields - IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%v ) ) THEN - NULLIFY( OutputData%v ) - ELSE - CALL C_F_POINTER(OutputData%C_obj%v, OutputData%v, (/OutputData%C_obj%v_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%v ) ) THEN + NULLIFY( OutputData%v ) + ELSE + CALL C_F_POINTER(OutputData%C_obj%v, OutputData%v, (/OutputData%C_obj%v_Len/)) + END IF END IF ! -- w Output Data fields - IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%w ) ) THEN - NULLIFY( OutputData%w ) - ELSE - CALL C_F_POINTER(OutputData%C_obj%w, OutputData%w, (/OutputData%C_obj%w_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%w ) ) THEN + NULLIFY( OutputData%w ) + ELSE + CALL C_F_POINTER(OutputData%C_obj%w, OutputData%w, (/OutputData%C_obj%w_Len/)) + END IF END IF ! -- SuperController Output Data fields - IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%SuperController ) ) THEN - NULLIFY( OutputData%SuperController ) - ELSE - CALL C_F_POINTER(OutputData%C_obj%SuperController, OutputData%SuperController, (/OutputData%C_obj%SuperController_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%SuperController ) ) THEN + NULLIFY( OutputData%SuperController ) + ELSE + CALL C_F_POINTER(OutputData%C_obj%SuperController, OutputData%SuperController, (/OutputData%C_obj%SuperController_Len/)) + END IF END IF END SUBROUTINE OpFM_C2Fary_CopyOutput + SUBROUTINE OpFM_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(OpFM_OutputType), INTENT(INOUT) :: OutputData + 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 + + ! -- u Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OutputData%u)) THEN + OutputData%c_obj%u_Len = 0 + OutputData%c_obj%u = C_NULL_PTR + 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) ) ) + END IF + END IF + + ! -- v Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OutputData%v)) THEN + OutputData%c_obj%v_Len = 0 + OutputData%c_obj%v = C_NULL_PTR + 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) ) ) + END IF + END IF + + ! -- w Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OutputData%w)) THEN + OutputData%c_obj%w_Len = 0 + OutputData%c_obj%w = C_NULL_PTR + 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) ) ) + END IF + END IF + + ! -- SuperController Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OutputData%SuperController)) THEN + OutputData%c_obj%SuperController_Len = 0 + OutputData%c_obj%SuperController = C_NULL_PTR + ELSE + OutputData%c_obj%SuperController_Len = SIZE(OutputData%SuperController) + IF (OutputData%c_obj%SuperController_Len > 0) & + OutputData%c_obj%SuperController = C_LOC( OutputData%SuperController( LBOUND(OutputData%SuperController,1) ) ) + END IF + END IF + END SUBROUTINE OpFM_F2C_CopyOutput + SUBROUTINE OpFM_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) ! @@ -4328,12 +4694,12 @@ SUBROUTINE OpFM_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! 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 :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -4346,125 +4712,97 @@ SUBROUTINE OpFM_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ASSOCIATED(u_out%pxVel) .AND. ASSOCIATED(u1%pxVel)) THEN - ALLOCATE(b1(SIZE(u_out%pxVel,1))) - ALLOCATE(c1(SIZE(u_out%pxVel,1))) - b1 = -(u1%pxVel - u2%pxVel)/t(2) - u_out%pxVel = u1%pxVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%pxVel,1),UBOUND(u_out%pxVel,1) + b = -(u1%pxVel(i1) - u2%pxVel(i1)) + u_out%pxVel(i1) = u1%pxVel(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%pyVel) .AND. ASSOCIATED(u1%pyVel)) THEN - ALLOCATE(b1(SIZE(u_out%pyVel,1))) - ALLOCATE(c1(SIZE(u_out%pyVel,1))) - b1 = -(u1%pyVel - u2%pyVel)/t(2) - u_out%pyVel = u1%pyVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%pyVel,1),UBOUND(u_out%pyVel,1) + b = -(u1%pyVel(i1) - u2%pyVel(i1)) + u_out%pyVel(i1) = u1%pyVel(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%pzVel) .AND. ASSOCIATED(u1%pzVel)) THEN - ALLOCATE(b1(SIZE(u_out%pzVel,1))) - ALLOCATE(c1(SIZE(u_out%pzVel,1))) - b1 = -(u1%pzVel - u2%pzVel)/t(2) - u_out%pzVel = u1%pzVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%pzVel,1),UBOUND(u_out%pzVel,1) + b = -(u1%pzVel(i1) - u2%pzVel(i1)) + u_out%pzVel(i1) = u1%pzVel(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%pxForce) .AND. ASSOCIATED(u1%pxForce)) THEN - ALLOCATE(b1(SIZE(u_out%pxForce,1))) - ALLOCATE(c1(SIZE(u_out%pxForce,1))) - b1 = -(u1%pxForce - u2%pxForce)/t(2) - u_out%pxForce = u1%pxForce + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%pxForce,1),UBOUND(u_out%pxForce,1) + b = -(u1%pxForce(i1) - u2%pxForce(i1)) + u_out%pxForce(i1) = u1%pxForce(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%pyForce) .AND. ASSOCIATED(u1%pyForce)) THEN - ALLOCATE(b1(SIZE(u_out%pyForce,1))) - ALLOCATE(c1(SIZE(u_out%pyForce,1))) - b1 = -(u1%pyForce - u2%pyForce)/t(2) - u_out%pyForce = u1%pyForce + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%pyForce,1),UBOUND(u_out%pyForce,1) + b = -(u1%pyForce(i1) - u2%pyForce(i1)) + u_out%pyForce(i1) = u1%pyForce(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%pzForce) .AND. ASSOCIATED(u1%pzForce)) THEN - ALLOCATE(b1(SIZE(u_out%pzForce,1))) - ALLOCATE(c1(SIZE(u_out%pzForce,1))) - b1 = -(u1%pzForce - u2%pzForce)/t(2) - u_out%pzForce = u1%pzForce + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%pzForce,1),UBOUND(u_out%pzForce,1) + b = -(u1%pzForce(i1) - u2%pzForce(i1)) + u_out%pzForce(i1) = u1%pzForce(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%pOrientation) .AND. ASSOCIATED(u1%pOrientation)) THEN - ALLOCATE(b1(SIZE(u_out%pOrientation,1))) - ALLOCATE(c1(SIZE(u_out%pOrientation,1))) - b1 = -(u1%pOrientation - u2%pOrientation)/t(2) - u_out%pOrientation = u1%pOrientation + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%pOrientation,1),UBOUND(u_out%pOrientation,1) + b = -(u1%pOrientation(i1) - u2%pOrientation(i1)) + u_out%pOrientation(i1) = u1%pOrientation(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%fx) .AND. ASSOCIATED(u1%fx)) THEN - ALLOCATE(b1(SIZE(u_out%fx,1))) - ALLOCATE(c1(SIZE(u_out%fx,1))) - b1 = -(u1%fx - u2%fx)/t(2) - u_out%fx = u1%fx + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%fx,1),UBOUND(u_out%fx,1) + b = -(u1%fx(i1) - u2%fx(i1)) + u_out%fx(i1) = u1%fx(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%fy) .AND. ASSOCIATED(u1%fy)) THEN - ALLOCATE(b1(SIZE(u_out%fy,1))) - ALLOCATE(c1(SIZE(u_out%fy,1))) - b1 = -(u1%fy - u2%fy)/t(2) - u_out%fy = u1%fy + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%fy,1),UBOUND(u_out%fy,1) + b = -(u1%fy(i1) - u2%fy(i1)) + u_out%fy(i1) = u1%fy(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%fz) .AND. ASSOCIATED(u1%fz)) THEN - ALLOCATE(b1(SIZE(u_out%fz,1))) - ALLOCATE(c1(SIZE(u_out%fz,1))) - b1 = -(u1%fz - u2%fz)/t(2) - u_out%fz = u1%fz + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%fz,1),UBOUND(u_out%fz,1) + b = -(u1%fz(i1) - u2%fz(i1)) + u_out%fz(i1) = u1%fz(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%momentx) .AND. ASSOCIATED(u1%momentx)) THEN - ALLOCATE(b1(SIZE(u_out%momentx,1))) - ALLOCATE(c1(SIZE(u_out%momentx,1))) - b1 = -(u1%momentx - u2%momentx)/t(2) - u_out%momentx = u1%momentx + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%momentx,1),UBOUND(u_out%momentx,1) + b = -(u1%momentx(i1) - u2%momentx(i1)) + u_out%momentx(i1) = u1%momentx(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%momenty) .AND. ASSOCIATED(u1%momenty)) THEN - ALLOCATE(b1(SIZE(u_out%momenty,1))) - ALLOCATE(c1(SIZE(u_out%momenty,1))) - b1 = -(u1%momenty - u2%momenty)/t(2) - u_out%momenty = u1%momenty + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%momenty,1),UBOUND(u_out%momenty,1) + b = -(u1%momenty(i1) - u2%momenty(i1)) + u_out%momenty(i1) = u1%momenty(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%momentz) .AND. ASSOCIATED(u1%momentz)) THEN - ALLOCATE(b1(SIZE(u_out%momentz,1))) - ALLOCATE(c1(SIZE(u_out%momentz,1))) - b1 = -(u1%momentz - u2%momentz)/t(2) - u_out%momentz = u1%momentz + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%momentz,1),UBOUND(u_out%momentz,1) + b = -(u1%momentz(i1) - u2%momentz(i1)) + u_out%momentz(i1) = u1%momentz(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%forceNodesChord) .AND. ASSOCIATED(u1%forceNodesChord)) THEN - ALLOCATE(b1(SIZE(u_out%forceNodesChord,1))) - ALLOCATE(c1(SIZE(u_out%forceNodesChord,1))) - b1 = -(u1%forceNodesChord - u2%forceNodesChord)/t(2) - u_out%forceNodesChord = u1%forceNodesChord + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%forceNodesChord,1),UBOUND(u_out%forceNodesChord,1) + b = -(u1%forceNodesChord(i1) - u2%forceNodesChord(i1)) + u_out%forceNodesChord(i1) = u1%forceNodesChord(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%SuperController) .AND. ASSOCIATED(u1%SuperController)) THEN - ALLOCATE(b1(SIZE(u_out%SuperController,1))) - ALLOCATE(c1(SIZE(u_out%SuperController,1))) - b1 = -(u1%SuperController - u2%SuperController)/t(2) - u_out%SuperController = u1%SuperController + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%SuperController,1),UBOUND(u_out%SuperController,1) + b = -(u1%SuperController(i1) - u2%SuperController(i1)) + u_out%SuperController(i1) = u1%SuperController(i1) + b * ScaleFactor + END DO END IF ! check if allocated END SUBROUTINE OpFM_Input_ExtrapInterp1 @@ -4495,13 +4833,14 @@ SUBROUTINE OpFM_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -4520,140 +4859,112 @@ SUBROUTINE OpFM_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ASSOCIATED(u_out%pxVel) .AND. ASSOCIATED(u1%pxVel)) THEN - ALLOCATE(b1(SIZE(u_out%pxVel,1))) - ALLOCATE(c1(SIZE(u_out%pxVel,1))) - b1 = (t(3)**2*(u1%pxVel - u2%pxVel) + t(2)**2*(-u1%pxVel + u3%pxVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%pxVel + t(3)*u2%pxVel - t(2)*u3%pxVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%pxVel = u1%pxVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%pxVel,1),UBOUND(u_out%pxVel,1) + b = (t(3)**2*(u1%pxVel(i1) - u2%pxVel(i1)) + t(2)**2*(-u1%pxVel(i1) + u3%pxVel(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%pxVel(i1) + t(3)*u2%pxVel(i1) - t(2)*u3%pxVel(i1) ) * scaleFactor + u_out%pxVel(i1) = u1%pxVel(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%pyVel) .AND. ASSOCIATED(u1%pyVel)) THEN - ALLOCATE(b1(SIZE(u_out%pyVel,1))) - ALLOCATE(c1(SIZE(u_out%pyVel,1))) - b1 = (t(3)**2*(u1%pyVel - u2%pyVel) + t(2)**2*(-u1%pyVel + u3%pyVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%pyVel + t(3)*u2%pyVel - t(2)*u3%pyVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%pyVel = u1%pyVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%pyVel,1),UBOUND(u_out%pyVel,1) + b = (t(3)**2*(u1%pyVel(i1) - u2%pyVel(i1)) + t(2)**2*(-u1%pyVel(i1) + u3%pyVel(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%pyVel(i1) + t(3)*u2%pyVel(i1) - t(2)*u3%pyVel(i1) ) * scaleFactor + u_out%pyVel(i1) = u1%pyVel(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%pzVel) .AND. ASSOCIATED(u1%pzVel)) THEN - ALLOCATE(b1(SIZE(u_out%pzVel,1))) - ALLOCATE(c1(SIZE(u_out%pzVel,1))) - b1 = (t(3)**2*(u1%pzVel - u2%pzVel) + t(2)**2*(-u1%pzVel + u3%pzVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%pzVel + t(3)*u2%pzVel - t(2)*u3%pzVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%pzVel = u1%pzVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%pzVel,1),UBOUND(u_out%pzVel,1) + b = (t(3)**2*(u1%pzVel(i1) - u2%pzVel(i1)) + t(2)**2*(-u1%pzVel(i1) + u3%pzVel(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%pzVel(i1) + t(3)*u2%pzVel(i1) - t(2)*u3%pzVel(i1) ) * scaleFactor + u_out%pzVel(i1) = u1%pzVel(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%pxForce) .AND. ASSOCIATED(u1%pxForce)) THEN - ALLOCATE(b1(SIZE(u_out%pxForce,1))) - ALLOCATE(c1(SIZE(u_out%pxForce,1))) - b1 = (t(3)**2*(u1%pxForce - u2%pxForce) + t(2)**2*(-u1%pxForce + u3%pxForce))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%pxForce + t(3)*u2%pxForce - t(2)*u3%pxForce ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%pxForce = u1%pxForce + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%pxForce,1),UBOUND(u_out%pxForce,1) + b = (t(3)**2*(u1%pxForce(i1) - u2%pxForce(i1)) + t(2)**2*(-u1%pxForce(i1) + u3%pxForce(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%pxForce(i1) + t(3)*u2%pxForce(i1) - t(2)*u3%pxForce(i1) ) * scaleFactor + u_out%pxForce(i1) = u1%pxForce(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%pyForce) .AND. ASSOCIATED(u1%pyForce)) THEN - ALLOCATE(b1(SIZE(u_out%pyForce,1))) - ALLOCATE(c1(SIZE(u_out%pyForce,1))) - b1 = (t(3)**2*(u1%pyForce - u2%pyForce) + t(2)**2*(-u1%pyForce + u3%pyForce))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%pyForce + t(3)*u2%pyForce - t(2)*u3%pyForce ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%pyForce = u1%pyForce + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%pyForce,1),UBOUND(u_out%pyForce,1) + b = (t(3)**2*(u1%pyForce(i1) - u2%pyForce(i1)) + t(2)**2*(-u1%pyForce(i1) + u3%pyForce(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%pyForce(i1) + t(3)*u2%pyForce(i1) - t(2)*u3%pyForce(i1) ) * scaleFactor + u_out%pyForce(i1) = u1%pyForce(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%pzForce) .AND. ASSOCIATED(u1%pzForce)) THEN - ALLOCATE(b1(SIZE(u_out%pzForce,1))) - ALLOCATE(c1(SIZE(u_out%pzForce,1))) - b1 = (t(3)**2*(u1%pzForce - u2%pzForce) + t(2)**2*(-u1%pzForce + u3%pzForce))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%pzForce + t(3)*u2%pzForce - t(2)*u3%pzForce ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%pzForce = u1%pzForce + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%pzForce,1),UBOUND(u_out%pzForce,1) + b = (t(3)**2*(u1%pzForce(i1) - u2%pzForce(i1)) + t(2)**2*(-u1%pzForce(i1) + u3%pzForce(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%pzForce(i1) + t(3)*u2%pzForce(i1) - t(2)*u3%pzForce(i1) ) * scaleFactor + u_out%pzForce(i1) = u1%pzForce(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%pOrientation) .AND. ASSOCIATED(u1%pOrientation)) THEN - ALLOCATE(b1(SIZE(u_out%pOrientation,1))) - ALLOCATE(c1(SIZE(u_out%pOrientation,1))) - b1 = (t(3)**2*(u1%pOrientation - u2%pOrientation) + t(2)**2*(-u1%pOrientation + u3%pOrientation))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%pOrientation + t(3)*u2%pOrientation - t(2)*u3%pOrientation ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%pOrientation = u1%pOrientation + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%pOrientation,1),UBOUND(u_out%pOrientation,1) + b = (t(3)**2*(u1%pOrientation(i1) - u2%pOrientation(i1)) + t(2)**2*(-u1%pOrientation(i1) + u3%pOrientation(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%pOrientation(i1) + t(3)*u2%pOrientation(i1) - t(2)*u3%pOrientation(i1) ) * scaleFactor + u_out%pOrientation(i1) = u1%pOrientation(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%fx) .AND. ASSOCIATED(u1%fx)) THEN - ALLOCATE(b1(SIZE(u_out%fx,1))) - ALLOCATE(c1(SIZE(u_out%fx,1))) - b1 = (t(3)**2*(u1%fx - u2%fx) + t(2)**2*(-u1%fx + u3%fx))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%fx + t(3)*u2%fx - t(2)*u3%fx ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%fx = u1%fx + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%fx,1),UBOUND(u_out%fx,1) + b = (t(3)**2*(u1%fx(i1) - u2%fx(i1)) + t(2)**2*(-u1%fx(i1) + u3%fx(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%fx(i1) + t(3)*u2%fx(i1) - t(2)*u3%fx(i1) ) * scaleFactor + u_out%fx(i1) = u1%fx(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%fy) .AND. ASSOCIATED(u1%fy)) THEN - ALLOCATE(b1(SIZE(u_out%fy,1))) - ALLOCATE(c1(SIZE(u_out%fy,1))) - b1 = (t(3)**2*(u1%fy - u2%fy) + t(2)**2*(-u1%fy + u3%fy))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%fy + t(3)*u2%fy - t(2)*u3%fy ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%fy = u1%fy + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%fy,1),UBOUND(u_out%fy,1) + b = (t(3)**2*(u1%fy(i1) - u2%fy(i1)) + t(2)**2*(-u1%fy(i1) + u3%fy(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%fy(i1) + t(3)*u2%fy(i1) - t(2)*u3%fy(i1) ) * scaleFactor + u_out%fy(i1) = u1%fy(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%fz) .AND. ASSOCIATED(u1%fz)) THEN - ALLOCATE(b1(SIZE(u_out%fz,1))) - ALLOCATE(c1(SIZE(u_out%fz,1))) - b1 = (t(3)**2*(u1%fz - u2%fz) + t(2)**2*(-u1%fz + u3%fz))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%fz + t(3)*u2%fz - t(2)*u3%fz ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%fz = u1%fz + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%fz,1),UBOUND(u_out%fz,1) + b = (t(3)**2*(u1%fz(i1) - u2%fz(i1)) + t(2)**2*(-u1%fz(i1) + u3%fz(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%fz(i1) + t(3)*u2%fz(i1) - t(2)*u3%fz(i1) ) * scaleFactor + u_out%fz(i1) = u1%fz(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%momentx) .AND. ASSOCIATED(u1%momentx)) THEN - ALLOCATE(b1(SIZE(u_out%momentx,1))) - ALLOCATE(c1(SIZE(u_out%momentx,1))) - b1 = (t(3)**2*(u1%momentx - u2%momentx) + t(2)**2*(-u1%momentx + u3%momentx))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%momentx + t(3)*u2%momentx - t(2)*u3%momentx ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%momentx = u1%momentx + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%momentx,1),UBOUND(u_out%momentx,1) + b = (t(3)**2*(u1%momentx(i1) - u2%momentx(i1)) + t(2)**2*(-u1%momentx(i1) + u3%momentx(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%momentx(i1) + t(3)*u2%momentx(i1) - t(2)*u3%momentx(i1) ) * scaleFactor + u_out%momentx(i1) = u1%momentx(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%momenty) .AND. ASSOCIATED(u1%momenty)) THEN - ALLOCATE(b1(SIZE(u_out%momenty,1))) - ALLOCATE(c1(SIZE(u_out%momenty,1))) - b1 = (t(3)**2*(u1%momenty - u2%momenty) + t(2)**2*(-u1%momenty + u3%momenty))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%momenty + t(3)*u2%momenty - t(2)*u3%momenty ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%momenty = u1%momenty + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%momenty,1),UBOUND(u_out%momenty,1) + b = (t(3)**2*(u1%momenty(i1) - u2%momenty(i1)) + t(2)**2*(-u1%momenty(i1) + u3%momenty(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%momenty(i1) + t(3)*u2%momenty(i1) - t(2)*u3%momenty(i1) ) * scaleFactor + u_out%momenty(i1) = u1%momenty(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%momentz) .AND. ASSOCIATED(u1%momentz)) THEN - ALLOCATE(b1(SIZE(u_out%momentz,1))) - ALLOCATE(c1(SIZE(u_out%momentz,1))) - b1 = (t(3)**2*(u1%momentz - u2%momentz) + t(2)**2*(-u1%momentz + u3%momentz))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%momentz + t(3)*u2%momentz - t(2)*u3%momentz ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%momentz = u1%momentz + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%momentz,1),UBOUND(u_out%momentz,1) + b = (t(3)**2*(u1%momentz(i1) - u2%momentz(i1)) + t(2)**2*(-u1%momentz(i1) + u3%momentz(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%momentz(i1) + t(3)*u2%momentz(i1) - t(2)*u3%momentz(i1) ) * scaleFactor + u_out%momentz(i1) = u1%momentz(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%forceNodesChord) .AND. ASSOCIATED(u1%forceNodesChord)) THEN - ALLOCATE(b1(SIZE(u_out%forceNodesChord,1))) - ALLOCATE(c1(SIZE(u_out%forceNodesChord,1))) - b1 = (t(3)**2*(u1%forceNodesChord - u2%forceNodesChord) + t(2)**2*(-u1%forceNodesChord + u3%forceNodesChord))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%forceNodesChord + t(3)*u2%forceNodesChord - t(2)*u3%forceNodesChord ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%forceNodesChord = u1%forceNodesChord + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%forceNodesChord,1),UBOUND(u_out%forceNodesChord,1) + b = (t(3)**2*(u1%forceNodesChord(i1) - u2%forceNodesChord(i1)) + t(2)**2*(-u1%forceNodesChord(i1) + u3%forceNodesChord(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%forceNodesChord(i1) + t(3)*u2%forceNodesChord(i1) - t(2)*u3%forceNodesChord(i1) ) * scaleFactor + u_out%forceNodesChord(i1) = u1%forceNodesChord(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%SuperController) .AND. ASSOCIATED(u1%SuperController)) THEN - ALLOCATE(b1(SIZE(u_out%SuperController,1))) - ALLOCATE(c1(SIZE(u_out%SuperController,1))) - b1 = (t(3)**2*(u1%SuperController - u2%SuperController) + t(2)**2*(-u1%SuperController + u3%SuperController))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%SuperController + t(3)*u2%SuperController - t(2)*u3%SuperController ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%SuperController = u1%SuperController + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%SuperController,1),UBOUND(u_out%SuperController,1) + b = (t(3)**2*(u1%SuperController(i1) - u2%SuperController(i1)) + t(2)**2*(-u1%SuperController(i1) + u3%SuperController(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%SuperController(i1) + t(3)*u2%SuperController(i1) - t(2)*u3%SuperController(i1) ) * scaleFactor + u_out%SuperController(i1) = u1%SuperController(i1) + b + c * t_out + END DO END IF ! check if allocated END SUBROUTINE OpFM_Input_ExtrapInterp2 @@ -4732,12 +5043,12 @@ SUBROUTINE OpFM_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! 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 :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -4750,45 +5061,37 @@ SUBROUTINE OpFM_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ASSOCIATED(y_out%u) .AND. ASSOCIATED(y1%u)) THEN - ALLOCATE(b1(SIZE(y_out%u,1))) - ALLOCATE(c1(SIZE(y_out%u,1))) - b1 = -(y1%u - y2%u)/t(2) - y_out%u = y1%u + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%u,1),UBOUND(y_out%u,1) + b = -(y1%u(i1) - y2%u(i1)) + y_out%u(i1) = y1%u(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(y_out%v) .AND. ASSOCIATED(y1%v)) THEN - ALLOCATE(b1(SIZE(y_out%v,1))) - ALLOCATE(c1(SIZE(y_out%v,1))) - b1 = -(y1%v - y2%v)/t(2) - y_out%v = y1%v + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%v,1),UBOUND(y_out%v,1) + b = -(y1%v(i1) - y2%v(i1)) + y_out%v(i1) = y1%v(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(y_out%w) .AND. ASSOCIATED(y1%w)) THEN - ALLOCATE(b1(SIZE(y_out%w,1))) - ALLOCATE(c1(SIZE(y_out%w,1))) - b1 = -(y1%w - y2%w)/t(2) - y_out%w = y1%w + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%w,1),UBOUND(y_out%w,1) + b = -(y1%w(i1) - y2%w(i1)) + y_out%w(i1) = y1%w(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(y_out%SuperController) .AND. ASSOCIATED(y1%SuperController)) THEN - ALLOCATE(b1(SIZE(y_out%SuperController,1))) - ALLOCATE(c1(SIZE(y_out%SuperController,1))) - b1 = -(y1%SuperController - y2%SuperController)/t(2) - y_out%SuperController = y1%SuperController + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%SuperController,1),UBOUND(y_out%SuperController,1) + b = -(y1%SuperController(i1) - y2%SuperController(i1)) + y_out%SuperController(i1) = y1%SuperController(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END IF ! check if allocated END SUBROUTINE OpFM_Output_ExtrapInterp1 @@ -4819,13 +5122,14 @@ SUBROUTINE OpFM_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -4844,50 +5148,42 @@ SUBROUTINE OpFM_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ASSOCIATED(y_out%u) .AND. ASSOCIATED(y1%u)) THEN - ALLOCATE(b1(SIZE(y_out%u,1))) - ALLOCATE(c1(SIZE(y_out%u,1))) - b1 = (t(3)**2*(y1%u - y2%u) + t(2)**2*(-y1%u + y3%u))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%u + t(3)*y2%u - t(2)*y3%u ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%u = y1%u + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%u,1),UBOUND(y_out%u,1) + b = (t(3)**2*(y1%u(i1) - y2%u(i1)) + t(2)**2*(-y1%u(i1) + y3%u(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%u(i1) + t(3)*y2%u(i1) - t(2)*y3%u(i1) ) * scaleFactor + y_out%u(i1) = y1%u(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(y_out%v) .AND. ASSOCIATED(y1%v)) THEN - ALLOCATE(b1(SIZE(y_out%v,1))) - ALLOCATE(c1(SIZE(y_out%v,1))) - b1 = (t(3)**2*(y1%v - y2%v) + t(2)**2*(-y1%v + y3%v))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%v + t(3)*y2%v - t(2)*y3%v ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%v = y1%v + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%v,1),UBOUND(y_out%v,1) + b = (t(3)**2*(y1%v(i1) - y2%v(i1)) + t(2)**2*(-y1%v(i1) + y3%v(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%v(i1) + t(3)*y2%v(i1) - t(2)*y3%v(i1) ) * scaleFactor + y_out%v(i1) = y1%v(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(y_out%w) .AND. ASSOCIATED(y1%w)) THEN - ALLOCATE(b1(SIZE(y_out%w,1))) - ALLOCATE(c1(SIZE(y_out%w,1))) - b1 = (t(3)**2*(y1%w - y2%w) + t(2)**2*(-y1%w + y3%w))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%w + t(3)*y2%w - t(2)*y3%w ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%w = y1%w + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%w,1),UBOUND(y_out%w,1) + b = (t(3)**2*(y1%w(i1) - y2%w(i1)) + t(2)**2*(-y1%w(i1) + y3%w(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%w(i1) + t(3)*y2%w(i1) - t(2)*y3%w(i1) ) * scaleFactor + y_out%w(i1) = y1%w(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(y_out%SuperController) .AND. ASSOCIATED(y1%SuperController)) THEN - ALLOCATE(b1(SIZE(y_out%SuperController,1))) - ALLOCATE(c1(SIZE(y_out%SuperController,1))) - b1 = (t(3)**2*(y1%SuperController - y2%SuperController) + t(2)**2*(-y1%SuperController + y3%SuperController))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%SuperController + t(3)*y2%SuperController - t(2)*y3%SuperController ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%SuperController = y1%SuperController + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%SuperController,1),UBOUND(y_out%SuperController,1) + b = (t(3)**2*(y1%SuperController(i1) - y2%SuperController(i1)) + t(2)**2*(-y1%SuperController(i1) + y3%SuperController(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%SuperController(i1) + t(3)*y2%SuperController(i1) - t(2)*y3%SuperController(i1) ) * scaleFactor + y_out%SuperController(i1) = y1%SuperController(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END IF ! check if allocated END SUBROUTINE OpFM_Output_ExtrapInterp2 diff --git a/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 b/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 index 8efb21566c..51a40873d8 100644 --- a/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 +++ b/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 @@ -204,16 +204,16 @@ SUBROUTINE Orca_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMax - Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(InData%InputFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + ReKiBuf(Re_Xferred) = InData%TMax + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Orca_PackInitInput SUBROUTINE Orca_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -229,12 +229,6 @@ SUBROUTINE Orca_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -250,16 +244,16 @@ SUBROUTINE Orca_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%TMax = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(OutData%InputFile) + OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%TMax = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Orca_UnPackInitInput SUBROUTINE Orca_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -452,12 +446,12 @@ SUBROUTINE Orca_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) + DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) DO I = 1, LEN(InData%WriteOutputHdr) IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdr(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -469,12 +463,12 @@ SUBROUTINE Orca_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) + DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) DO I = 1, LEN(InData%WriteOutputUnt) IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUnt(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF END SUBROUTINE Orca_PackInitOutput @@ -491,12 +485,6 @@ SUBROUTINE Orca_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -564,19 +552,12 @@ SUBROUTINE Orca_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) DO I = 1, LEN(OutData%WriteOutputHdr) OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated Int_Xferred = Int_Xferred + 1 @@ -591,19 +572,12 @@ SUBROUTINE Orca_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) DO I = 1, LEN(OutData%WriteOutputUnt) OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF END SUBROUTINE Orca_UnPackInitOutput @@ -706,26 +680,26 @@ SUBROUTINE Orca_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%DLL_FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%DLL_InitProcName) - IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_InitProcName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%DLL_CalcProcName) - IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_CalcProcName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%DLL_EndProcName) - IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_EndProcName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%DirRoot) - IntKiBuf(Int_Xferred) = ICHAR(InData%DirRoot(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(InData%DLL_FileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_FileName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%DLL_InitProcName) + IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_InitProcName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%DLL_CalcProcName) + IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_CalcProcName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%DLL_EndProcName) + IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_EndProcName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%DirRoot) + IntKiBuf(Int_Xferred) = ICHAR(InData%DirRoot(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE Orca_PackInputFile SUBROUTINE Orca_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -741,12 +715,6 @@ SUBROUTINE Orca_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Orca_UnPackInputFile' @@ -760,26 +728,26 @@ SUBROUTINE Orca_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%DLL_FileName) - OutData%DLL_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%DLL_InitProcName) - OutData%DLL_InitProcName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%DLL_CalcProcName) - OutData%DLL_CalcProcName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%DLL_EndProcName) - OutData%DLL_EndProcName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%DirRoot) - OutData%DirRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%DLL_FileName) + OutData%DLL_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%DLL_InitProcName) + OutData%DLL_InitProcName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%DLL_CalcProcName) + OutData%DLL_CalcProcName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%DLL_EndProcName) + OutData%DLL_EndProcName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%DirRoot) + OutData%DirRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE Orca_UnPackInputFile SUBROUTINE Orca_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -873,8 +841,8 @@ SUBROUTINE Orca_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyOtherState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyOtherState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Orca_PackOtherState SUBROUTINE Orca_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -890,12 +858,6 @@ SUBROUTINE Orca_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Orca_UnPackOtherState' @@ -909,8 +871,8 @@ SUBROUTINE Orca_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyOtherState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyOtherState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Orca_UnPackOtherState SUBROUTINE Orca_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -1032,12 +994,20 @@ SUBROUTINE Orca_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PtfmAM))-1 ) = PACK(InData%PtfmAM,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PtfmAM) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PtfmFt))-1 ) = PACK(InData%PtfmFt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PtfmFt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_PtfmAM))-1 ) = PACK(InData%F_PtfmAM,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_PtfmAM) + DO i2 = LBOUND(InData%PtfmAM,2), UBOUND(InData%PtfmAM,2) + DO i1 = LBOUND(InData%PtfmAM,1), UBOUND(InData%PtfmAM,1) + ReKiBuf(Re_Xferred) = InData%PtfmAM(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i1 = LBOUND(InData%PtfmFt,1), UBOUND(InData%PtfmFt,1) + ReKiBuf(Re_Xferred) = InData%PtfmFt(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%F_PtfmAM,1), UBOUND(InData%F_PtfmAM,1) + ReKiBuf(Re_Xferred) = InData%F_PtfmAM(i1) + Re_Xferred = Re_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%AllOuts) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1048,11 +1018,13 @@ SUBROUTINE Orca_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AllOuts,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AllOuts)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AllOuts))-1 ) = PACK(InData%AllOuts,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AllOuts) + DO i1 = LBOUND(InData%AllOuts,1), UBOUND(InData%AllOuts,1) + ReKiBuf(Re_Xferred) = InData%AllOuts(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%LastTimeStep - Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%LastTimeStep + Db_Xferred = Db_Xferred + 1 END SUBROUTINE Orca_PackMisc SUBROUTINE Orca_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1068,12 +1040,6 @@ SUBROUTINE Orca_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -1093,37 +1059,24 @@ SUBROUTINE Orca_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg i1_u = UBOUND(OutData%PtfmAM,1) i2_l = LBOUND(OutData%PtfmAM,2) i2_u = UBOUND(OutData%PtfmAM,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%PtfmAM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PtfmAM))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PtfmAM) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PtfmAM,2), UBOUND(OutData%PtfmAM,2) + DO i1 = LBOUND(OutData%PtfmAM,1), UBOUND(OutData%PtfmAM,1) + OutData%PtfmAM(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%PtfmFt,1) i1_u = UBOUND(OutData%PtfmFt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%PtfmFt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PtfmFt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PtfmFt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%PtfmFt,1), UBOUND(OutData%PtfmFt,1) + OutData%PtfmFt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%F_PtfmAM,1) i1_u = UBOUND(OutData%F_PtfmAM,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%F_PtfmAM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_PtfmAM))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_PtfmAM) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%F_PtfmAM,1), UBOUND(OutData%F_PtfmAM,1) + OutData%F_PtfmAM(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AllOuts not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1137,18 +1090,13 @@ SUBROUTINE Orca_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOuts.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%AllOuts)>0) OutData%AllOuts = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AllOuts))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AllOuts) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AllOuts,1), UBOUND(OutData%AllOuts,1) + OutData%AllOuts(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%LastTimeStep = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%LastTimeStep = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 END SUBROUTINE Orca_UnPackMisc SUBROUTINE Orca_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -1314,8 +1262,8 @@ SUBROUTINE Orca_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 CALL DLLTypePack( InData%DLL_Orca, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! DLL_Orca CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1344,14 +1292,14 @@ SUBROUTINE Orca_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - DO I = 1, LEN(InData%SimNamePath) - IntKiBuf(Int_Xferred) = ICHAR(InData%SimNamePath(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%SimNamePathLen - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%SimNamePath) + IntKiBuf(Int_Xferred) = ICHAR(InData%SimNamePath(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%SimNamePathLen + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1408,12 +1356,6 @@ SUBROUTINE Orca_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1428,8 +1370,8 @@ SUBROUTINE Orca_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -1470,14 +1412,14 @@ SUBROUTINE Orca_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - DO I = 1, LEN(OutData%SimNamePath) - OutData%SimNamePath(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%SimNamePathLen = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%SimNamePath) + OutData%SimNamePath(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%SimNamePathLen = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1690,12 +1632,6 @@ SUBROUTINE Orca_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Orca_UnPackInput' @@ -1921,8 +1857,10 @@ SUBROUTINE Orca_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WriteOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE Orca_PackOutput @@ -1939,12 +1877,6 @@ SUBROUTINE Orca_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -2012,15 +1944,10 @@ SUBROUTINE Orca_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WriteOutput)>0) OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE Orca_UnPackOutput @@ -2115,8 +2042,8 @@ SUBROUTINE Orca_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Dummy - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Dummy + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Orca_PackContState SUBROUTINE Orca_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2132,12 +2059,6 @@ SUBROUTINE Orca_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Orca_UnPackContState' @@ -2151,8 +2072,8 @@ SUBROUTINE Orca_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%Dummy = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%Dummy = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Orca_UnPackContState SUBROUTINE Orca_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) @@ -2246,8 +2167,8 @@ SUBROUTINE Orca_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Dummy - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Dummy + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Orca_PackDiscState SUBROUTINE Orca_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2263,12 +2184,6 @@ SUBROUTINE Orca_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Orca_UnPackDiscState' @@ -2282,8 +2197,8 @@ SUBROUTINE Orca_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%Dummy = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%Dummy = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Orca_UnPackDiscState SUBROUTINE Orca_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -2377,8 +2292,8 @@ SUBROUTINE Orca_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyConstrState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Orca_PackConstrState SUBROUTINE Orca_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2394,12 +2309,6 @@ SUBROUTINE Orca_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Orca_UnPackConstrState' @@ -2413,8 +2322,8 @@ SUBROUTINE Orca_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyConstrState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyConstrState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Orca_UnPackConstrState @@ -2492,8 +2401,8 @@ SUBROUTINE Orca_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'Orca_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -2508,6 +2417,8 @@ SUBROUTINE Orca_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(u1%PtfmMesh, u2%PtfmMesh, tin, u_out%PtfmMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE Orca_Input_ExtrapInterp1 @@ -2539,8 +2450,9 @@ SUBROUTINE Orca_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'Orca_Input_ExtrapInterp2' @@ -2562,6 +2474,8 @@ SUBROUTINE Orca_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(u1%PtfmMesh, u2%PtfmMesh, u3%PtfmMesh, tin, u_out%PtfmMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE Orca_Input_ExtrapInterp2 @@ -2641,12 +2555,12 @@ SUBROUTINE Orca_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'Orca_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! 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 :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -2659,15 +2573,15 @@ SUBROUTINE Orca_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(y1%PtfmMesh, y2%PtfmMesh, tin, y_out%PtfmMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END IF ! check if allocated END SUBROUTINE Orca_Output_ExtrapInterp1 @@ -2698,13 +2612,14 @@ SUBROUTINE Orca_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'Orca_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -2723,16 +2638,16 @@ SUBROUTINE Orca_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(y1%PtfmMesh, y2%PtfmMesh, y3%PtfmMesh, tin, y_out%PtfmMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END IF ! check if allocated END SUBROUTINE Orca_Output_ExtrapInterp2 diff --git a/modules/servodyn/src/ServoDyn_Types.f90 b/modules/servodyn/src/ServoDyn_Types.f90 index 972b6214c9..1b13f3e024 100644 --- a/modules/servodyn/src/ServoDyn_Types.f90 +++ b/modules/servodyn/src/ServoDyn_Types.f90 @@ -494,18 +494,18 @@ SUBROUTINE SrvD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Linearize , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumBl - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(InData%InputFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%Linearize, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumBl + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( .NOT. ALLOCATED(InData%BlPitchInit) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -516,25 +516,31 @@ SUBROUTINE SrvD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlPitchInit,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BlPitchInit)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlPitchInit))-1 ) = PACK(InData%BlPitchInit,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlPitchInit) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%r_N_O_G))-1 ) = PACK(InData%r_N_O_G,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%r_N_O_G) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%r_TwrBase))-1 ) = PACK(InData%r_TwrBase,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%r_TwrBase) - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%Tmax - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AvgWindSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AirDens - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumSC2Ctrl - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumCtrl2SC - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%BlPitchInit,1), UBOUND(InData%BlPitchInit,1) + ReKiBuf(Re_Xferred) = InData%BlPitchInit(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%Gravity + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%r_N_O_G,1), UBOUND(InData%r_N_O_G,1) + ReKiBuf(Re_Xferred) = InData%r_N_O_G(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%r_TwrBase,1), UBOUND(InData%r_TwrBase,1) + ReKiBuf(Re_Xferred) = InData%r_TwrBase(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DbKiBuf(Db_Xferred) = InData%Tmax + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AvgWindSpeed + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AirDens + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumSC2Ctrl + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumCtrl2SC + Int_Xferred = Int_Xferred + 1 END SUBROUTINE SrvD_PackInitInput SUBROUTINE SrvD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -550,12 +556,6 @@ SUBROUTINE SrvD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -570,18 +570,18 @@ SUBROUTINE SrvD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%Linearize = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NumBl = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%InputFile) + OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%Linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%Linearize) + Int_Xferred = Int_Xferred + 1 + OutData%NumBl = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlPitchInit not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -595,50 +595,35 @@ SUBROUTINE SrvD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitchInit.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BlPitchInit)>0) OutData%BlPitchInit = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlPitchInit))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlPitchInit) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BlPitchInit,1), UBOUND(OutData%BlPitchInit,1) + OutData%BlPitchInit(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%Gravity = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%Gravity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%r_N_O_G,1) i1_u = UBOUND(OutData%r_N_O_G,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%r_N_O_G = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%r_N_O_G))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%r_N_O_G) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%r_N_O_G,1), UBOUND(OutData%r_N_O_G,1) + OutData%r_N_O_G(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%r_TwrBase,1) i1_u = UBOUND(OutData%r_TwrBase,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%r_TwrBase = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%r_TwrBase))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%r_TwrBase) - DEALLOCATE(mask1) - OutData%Tmax = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%AvgWindSpeed = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%AirDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NumSC2Ctrl = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumCtrl2SC = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%r_TwrBase,1), UBOUND(OutData%r_TwrBase,1) + OutData%r_TwrBase(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%Tmax = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%AvgWindSpeed = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AirDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NumSC2Ctrl = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumCtrl2SC = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE SrvD_UnPackInitInput SUBROUTINE SrvD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -907,12 +892,12 @@ SUBROUTINE SrvD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) + DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) DO I = 1, LEN(InData%WriteOutputHdr) IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdr(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -924,12 +909,12 @@ SUBROUTINE SrvD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) + DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) DO I = 1, LEN(InData%WriteOutputUnt) IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUnt(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -959,10 +944,10 @@ SUBROUTINE SrvD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%CouplingScheme - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%UseHSSBrake , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%CouplingScheme + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%UseHSSBrake, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%LinNames_y) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -973,12 +958,12 @@ SUBROUTINE SrvD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_y,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%LinNames_y,1), UBOUND(InData%LinNames_y,1) + DO i1 = LBOUND(InData%LinNames_y,1), UBOUND(InData%LinNames_y,1) DO I = 1, LEN(InData%LinNames_y) IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_y(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LinNames_u) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -990,12 +975,12 @@ SUBROUTINE SrvD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_u,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%LinNames_u,1), UBOUND(InData%LinNames_u,1) + DO i1 = LBOUND(InData%LinNames_u,1), UBOUND(InData%LinNames_u,1) DO I = 1, LEN(InData%LinNames_u) IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_u(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%RotFrame_y) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1007,8 +992,10 @@ SUBROUTINE SrvD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_y,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RotFrame_y)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%RotFrame_y)-1 ) = TRANSFER(PACK( InData%RotFrame_y ,.TRUE.), IntKiBuf(1), SIZE(InData%RotFrame_y)) - Int_Xferred = Int_Xferred + SIZE(InData%RotFrame_y) + DO i1 = LBOUND(InData%RotFrame_y,1), UBOUND(InData%RotFrame_y,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_y(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%RotFrame_u) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1020,8 +1007,10 @@ SUBROUTINE SrvD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_u,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RotFrame_u)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%RotFrame_u)-1 ) = TRANSFER(PACK( InData%RotFrame_u ,.TRUE.), IntKiBuf(1), SIZE(InData%RotFrame_u)) - Int_Xferred = Int_Xferred + SIZE(InData%RotFrame_u) + DO i1 = LBOUND(InData%RotFrame_u,1), UBOUND(InData%RotFrame_u,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_u(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%IsLoad_u) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1033,8 +1022,10 @@ SUBROUTINE SrvD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IsLoad_u,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%IsLoad_u)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%IsLoad_u)-1 ) = TRANSFER(PACK( InData%IsLoad_u ,.TRUE.), IntKiBuf(1), SIZE(InData%IsLoad_u)) - Int_Xferred = Int_Xferred + SIZE(InData%IsLoad_u) + DO i1 = LBOUND(InData%IsLoad_u,1), UBOUND(InData%IsLoad_u,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%IsLoad_u(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF END SUBROUTINE SrvD_PackInitOutput @@ -1051,12 +1042,6 @@ SUBROUTINE SrvD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1084,19 +1069,12 @@ SUBROUTINE SrvD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) DO I = 1, LEN(OutData%WriteOutputHdr) OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated Int_Xferred = Int_Xferred + 1 @@ -1111,19 +1089,12 @@ SUBROUTINE SrvD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) DO I = 1, LEN(OutData%WriteOutputUnt) OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -1165,10 +1136,10 @@ SUBROUTINE SrvD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%CouplingScheme = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%UseHSSBrake = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%CouplingScheme = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%UseHSSBrake = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseHSSBrake) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_y not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1182,19 +1153,12 @@ SUBROUTINE SrvD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%LinNames_y,1), UBOUND(OutData%LinNames_y,1) + DO i1 = LBOUND(OutData%LinNames_y,1), UBOUND(OutData%LinNames_y,1) DO I = 1, LEN(OutData%LinNames_y) OutData%LinNames_y(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_u not allocated Int_Xferred = Int_Xferred + 1 @@ -1209,19 +1173,12 @@ SUBROUTINE SrvD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%LinNames_u,1), UBOUND(OutData%LinNames_u,1) + DO i1 = LBOUND(OutData%LinNames_u,1), UBOUND(OutData%LinNames_u,1) DO I = 1, LEN(OutData%LinNames_u) OutData%LinNames_u(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_y not allocated Int_Xferred = Int_Xferred + 1 @@ -1236,15 +1193,10 @@ SUBROUTINE SrvD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RotFrame_y)>0) OutData%RotFrame_y = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%RotFrame_y))-1 ), OutData%RotFrame_y), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%RotFrame_y) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%RotFrame_y,1), UBOUND(OutData%RotFrame_y,1) + OutData%RotFrame_y(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_y(i1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_u not allocated Int_Xferred = Int_Xferred + 1 @@ -1259,15 +1211,10 @@ SUBROUTINE SrvD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RotFrame_u)>0) OutData%RotFrame_u = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%RotFrame_u))-1 ), OutData%RotFrame_u), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%RotFrame_u) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%RotFrame_u,1), UBOUND(OutData%RotFrame_u,1) + OutData%RotFrame_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_u(i1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IsLoad_u not allocated Int_Xferred = Int_Xferred + 1 @@ -1282,15 +1229,10 @@ SUBROUTINE SrvD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%IsLoad_u)>0) OutData%IsLoad_u = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%IsLoad_u))-1 ), OutData%IsLoad_u), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%IsLoad_u) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%IsLoad_u,1), UBOUND(OutData%IsLoad_u,1) + OutData%IsLoad_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsLoad_u(i1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF END SUBROUTINE SrvD_UnPackInitOutput @@ -1588,104 +1530,110 @@ SUBROUTINE SrvD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%PCMode - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TPCOn - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%TPitManS))-1 ) = PACK(InData%TPitManS,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%TPitManS) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PitManRat))-1 ) = PACK(InData%PitManRat,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PitManRat) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlPitchF))-1 ) = PACK(InData%BlPitchF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlPitchF) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%VSContrl - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%GenModel - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GenEff - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%GenTiStr , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%GenTiStp , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SpdGenOn - Re_Xferred = Re_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TimGenOn - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TimGenOf - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%VS_RtGnSp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%VS_RtTq - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%VS_Rgn2K - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%VS_SlPc - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SIG_SlPc - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SIG_SySp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SIG_RtTq - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SIG_PORt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TEC_Freq - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TEC_NPol - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TEC_SRes - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TEC_RRes - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TEC_VLL - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TEC_SLR - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TEC_RLR - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TEC_MR - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%HSSBrMode - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%THSSBrDp - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%HSSBrDT - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HSSBrTqF - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%YCMode - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TYCOn - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawNeut - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawDamp - Re_Xferred = Re_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TYawManS - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawManRat - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NacYawF - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%SumPrint , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%OutFile - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TabDelim , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%Tstart - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%PCMode + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%TPCOn + Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(InData%TPitManS,1), UBOUND(InData%TPitManS,1) + DbKiBuf(Db_Xferred) = InData%TPitManS(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%PitManRat,1), UBOUND(InData%PitManRat,1) + ReKiBuf(Re_Xferred) = InData%PitManRat(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%BlPitchF,1), UBOUND(InData%BlPitchF,1) + ReKiBuf(Re_Xferred) = InData%BlPitchF(i1) + Re_Xferred = Re_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%VSContrl + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%GenModel + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GenEff + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%GenTiStr, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%GenTiStp, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SpdGenOn + Re_Xferred = Re_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%TimGenOn + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%TimGenOf + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VS_RtGnSp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VS_RtTq + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VS_Rgn2K + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VS_SlPc + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SIG_SlPc + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SIG_SySp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SIG_RtTq + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SIG_PORt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEC_Freq + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TEC_NPol + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEC_SRes + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEC_RRes + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEC_VLL + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEC_SLR + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEC_RLR + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEC_MR + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%HSSBrMode + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%THSSBrDp + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%HSSBrDT + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HSSBrTqF + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%YCMode + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%TYCOn + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawNeut + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawSpr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawDamp + Re_Xferred = Re_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%TYawManS + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawManRat + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NacYawF + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%SumPrint, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%OutFile + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TabDelim, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%OutFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DbKiBuf(Db_Xferred) = InData%Tstart + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%OutList) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1696,59 +1644,59 @@ SUBROUTINE SrvD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutList,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) + DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) DO I = 1, LEN(InData%OutList) IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF - DO I = 1, LEN(InData%DLL_FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%DLL_ProcName) - IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_ProcName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%DLL_InFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_InFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DLL_DT - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%DLL_Ramp , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%BPCutoff - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NacYaw_North - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Ptch_Cntrl - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Ptch_SetPnt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Ptch_Min - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Ptch_Max - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtchRate_Min - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtchRate_Max - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Gain_OM - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GenSpd_MinOM - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GenSpd_MaxOM - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GenSpd_Dem - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GenTrq_Dem - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GenPwr_Dem - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DLL_NumTrq - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%DLL_FileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_FileName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%DLL_ProcName) + IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_ProcName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%DLL_InFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_InFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DbKiBuf(Db_Xferred) = InData%DLL_DT + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%DLL_Ramp, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%BPCutoff + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NacYaw_North + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Ptch_Cntrl + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Ptch_SetPnt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Ptch_Min + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Ptch_Max + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtchRate_Min + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtchRate_Max + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Gain_OM + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GenSpd_MinOM + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GenSpd_MaxOM + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GenSpd_Dem + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GenTrq_Dem + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GenPwr_Dem + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DLL_NumTrq + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%GenSpd_TLU) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1759,8 +1707,10 @@ SUBROUTINE SrvD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GenSpd_TLU,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%GenSpd_TLU)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GenSpd_TLU))-1 ) = PACK(InData%GenSpd_TLU,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GenSpd_TLU) + DO i1 = LBOUND(InData%GenSpd_TLU,1), UBOUND(InData%GenSpd_TLU,1) + ReKiBuf(Re_Xferred) = InData%GenSpd_TLU(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%GenTrq_TLU) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1772,21 +1722,23 @@ SUBROUTINE SrvD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GenTrq_TLU,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%GenTrq_TLU)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GenTrq_TLU))-1 ) = PACK(InData%GenTrq_TLU,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GenTrq_TLU) + DO i1 = LBOUND(InData%GenTrq_TLU,1), UBOUND(InData%GenTrq_TLU,1) + ReKiBuf(Re_Xferred) = InData%GenTrq_TLU(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%CompNTMD , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%NTMDfile) - IntKiBuf(Int_Xferred) = ICHAR(InData%NTMDfile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%CompTTMD , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%TTMDfile) - IntKiBuf(Int_Xferred) = ICHAR(InData%TTMDfile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%CompNTMD, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%NTMDfile) + IntKiBuf(Int_Xferred) = ICHAR(InData%NTMDfile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%CompTTMD, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%TTMDfile) + IntKiBuf(Int_Xferred) = ICHAR(InData%TTMDfile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE SrvD_PackInputFile SUBROUTINE SrvD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1802,12 +1754,6 @@ SUBROUTINE SrvD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1822,131 +1768,116 @@ SUBROUTINE SrvD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%PCMode = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TPCOn = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%PCMode = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TPCOn = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 i1_l = LBOUND(OutData%TPitManS,1) i1_u = UBOUND(OutData%TPitManS,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%TPitManS = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%TPitManS))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%TPitManS) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TPitManS,1), UBOUND(OutData%TPitManS,1) + OutData%TPitManS(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%PitManRat,1) i1_u = UBOUND(OutData%PitManRat,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%PitManRat = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PitManRat))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PitManRat) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%PitManRat,1), UBOUND(OutData%PitManRat,1) + OutData%PitManRat(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%BlPitchF,1) i1_u = UBOUND(OutData%BlPitchF,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%BlPitchF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlPitchF))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlPitchF) - DEALLOCATE(mask1) - OutData%VSContrl = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%GenModel = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%GenEff = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GenTiStr = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%GenTiStp = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%SpdGenOn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TimGenOn = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%TimGenOf = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%VS_RtGnSp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%VS_RtTq = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%VS_Rgn2K = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%VS_SlPc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SIG_SlPc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SIG_SySp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SIG_RtTq = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SIG_PORt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_Freq = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_NPol = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TEC_SRes = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_RRes = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_VLL = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_SLR = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_RLR = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_MR = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HSSBrMode = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%THSSBrDp = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%HSSBrDT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%HSSBrTqF = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YCMode = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TYCOn = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%YawNeut = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawSpr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawDamp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TYawManS = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%YawManRat = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NacYawF = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SumPrint = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%OutFile = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TabDelim = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%Tstart = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%BlPitchF,1), UBOUND(OutData%BlPitchF,1) + OutData%BlPitchF(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%VSContrl = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%GenModel = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%GenEff = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GenTiStr = TRANSFER(IntKiBuf(Int_Xferred), OutData%GenTiStr) + Int_Xferred = Int_Xferred + 1 + OutData%GenTiStp = TRANSFER(IntKiBuf(Int_Xferred), OutData%GenTiStp) + Int_Xferred = Int_Xferred + 1 + OutData%SpdGenOn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TimGenOn = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%TimGenOf = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%VS_RtGnSp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%VS_RtTq = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%VS_Rgn2K = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%VS_SlPc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SIG_SlPc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SIG_SySp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SIG_RtTq = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SIG_PORt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEC_Freq = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEC_NPol = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TEC_SRes = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEC_RRes = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEC_VLL = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEC_SLR = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEC_RLR = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEC_MR = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HSSBrMode = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%THSSBrDp = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%HSSBrDT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%HSSBrTqF = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YCMode = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TYCOn = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%YawNeut = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawSpr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawDamp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TYawManS = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%YawManRat = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NacYawF = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SumPrint = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumPrint) + Int_Xferred = Int_Xferred + 1 + OutData%OutFile = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TabDelim = TRANSFER(IntKiBuf(Int_Xferred), OutData%TabDelim) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%OutFmt) + OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%Tstart = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutList not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1960,66 +1891,59 @@ SUBROUTINE SrvD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) + DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) DO I = 1, LEN(OutData%OutList) OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) - END IF - DO I = 1, LEN(OutData%DLL_FileName) - OutData%DLL_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%DLL_ProcName) - OutData%DLL_ProcName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%DLL_InFile) - OutData%DLL_InFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%DLL_DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%DLL_Ramp = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%BPCutoff = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NacYaw_North = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Ptch_Cntrl = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%Ptch_SetPnt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Ptch_Min = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Ptch_Max = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtchRate_Min = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtchRate_Max = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Gain_OM = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GenSpd_MinOM = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GenSpd_MaxOM = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GenSpd_Dem = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GenTrq_Dem = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GenPwr_Dem = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%DLL_NumTrq = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + END DO + END IF + DO I = 1, LEN(OutData%DLL_FileName) + OutData%DLL_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%DLL_ProcName) + OutData%DLL_ProcName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%DLL_InFile) + OutData%DLL_InFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%DLL_DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%DLL_Ramp = TRANSFER(IntKiBuf(Int_Xferred), OutData%DLL_Ramp) + Int_Xferred = Int_Xferred + 1 + OutData%BPCutoff = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NacYaw_North = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Ptch_Cntrl = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Ptch_SetPnt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Ptch_Min = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Ptch_Max = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtchRate_Min = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtchRate_Max = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Gain_OM = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GenSpd_MinOM = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GenSpd_MaxOM = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GenSpd_Dem = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GenTrq_Dem = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GenPwr_Dem = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%DLL_NumTrq = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GenSpd_TLU not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2033,15 +1957,10 @@ SUBROUTINE SrvD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GenSpd_TLU.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%GenSpd_TLU)>0) OutData%GenSpd_TLU = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GenSpd_TLU))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GenSpd_TLU) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%GenSpd_TLU,1), UBOUND(OutData%GenSpd_TLU,1) + OutData%GenSpd_TLU(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GenTrq_TLU not allocated Int_Xferred = Int_Xferred + 1 @@ -2056,28 +1975,23 @@ SUBROUTINE SrvD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GenTrq_TLU.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%GenTrq_TLU)>0) OutData%GenTrq_TLU = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GenTrq_TLU))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GenTrq_TLU) - DEALLOCATE(mask1) - END IF - OutData%CompNTMD = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%NTMDfile) - OutData%NTMDfile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%CompTTMD = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%TTMDfile) - OutData%TTMDfile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO i1 = LBOUND(OutData%GenTrq_TLU,1), UBOUND(OutData%GenTrq_TLU,1) + OutData%GenTrq_TLU(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%CompNTMD = TRANSFER(IntKiBuf(Int_Xferred), OutData%CompNTMD) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%NTMDfile) + OutData%NTMDfile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%CompTTMD = TRANSFER(IntKiBuf(Int_Xferred), OutData%CompTTMD) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%TTMDfile) + OutData%TTMDfile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE SrvD_UnPackInputFile SUBROUTINE SrvD_CopyBladedDLLType( SrcBladedDLLTypeData, DstBladedDLLTypeData, CtrlCode, ErrStat, ErrMsg ) @@ -2234,23 +2148,29 @@ SUBROUTINE SrvD_PackBladedDLLType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%avrSWAP,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%avrSWAP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%avrSWAP))-1 ) = PACK(InData%avrSWAP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%avrSWAP) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HSSBrFrac - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HSSBrTrqC - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawRateCom - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GenTrq - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%GenState - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlPitchCom))-1 ) = PACK(InData%BlPitchCom,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlPitchCom) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PrevBlPitch))-1 ) = PACK(InData%PrevBlPitch,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PrevBlPitch) + DO i1 = LBOUND(InData%avrSWAP,1), UBOUND(InData%avrSWAP,1) + ReKiBuf(Re_Xferred) = InData%avrSWAP(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%HSSBrFrac + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HSSBrTrqC + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawRateCom + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GenTrq + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%GenState + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%BlPitchCom,1), UBOUND(InData%BlPitchCom,1) + ReKiBuf(Re_Xferred) = InData%BlPitchCom(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%PrevBlPitch,1), UBOUND(InData%PrevBlPitch,1) + ReKiBuf(Re_Xferred) = InData%PrevBlPitch(i1) + Re_Xferred = Re_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%SCoutput) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2261,8 +2181,10 @@ SUBROUTINE SrvD_PackBladedDLLType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SCoutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%SCoutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SCoutput))-1 ) = PACK(InData%SCoutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SCoutput) + DO i1 = LBOUND(InData%SCoutput,1), UBOUND(InData%SCoutput,1) + ReKiBuf(Re_Xferred) = InData%SCoutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE SrvD_PackBladedDLLType @@ -2279,12 +2201,6 @@ SUBROUTINE SrvD_UnPackBladedDLLType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -2312,48 +2228,33 @@ SUBROUTINE SrvD_UnPackBladedDLLType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%avrSWAP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%avrSWAP)>0) OutData%avrSWAP = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%avrSWAP))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%avrSWAP) - DEALLOCATE(mask1) - END IF - OutData%HSSBrFrac = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HSSBrTrqC = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawRateCom = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GenTrq = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GenState = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%avrSWAP,1), UBOUND(OutData%avrSWAP,1) + OutData%avrSWAP(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%HSSBrFrac = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HSSBrTrqC = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawRateCom = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GenTrq = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GenState = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%BlPitchCom,1) i1_u = UBOUND(OutData%BlPitchCom,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%BlPitchCom = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlPitchCom))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlPitchCom) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BlPitchCom,1), UBOUND(OutData%BlPitchCom,1) + OutData%BlPitchCom(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%PrevBlPitch,1) i1_u = UBOUND(OutData%PrevBlPitch,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%PrevBlPitch = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PrevBlPitch))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PrevBlPitch) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%PrevBlPitch,1), UBOUND(OutData%PrevBlPitch,1) + OutData%PrevBlPitch(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SCoutput not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2367,15 +2268,10 @@ SUBROUTINE SrvD_UnPackBladedDLLType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SCoutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%SCoutput)>0) OutData%SCoutput = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SCoutput))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%SCoutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%SCoutput,1), UBOUND(OutData%SCoutput,1) + OutData%SCoutput(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE SrvD_UnPackBladedDLLType @@ -2513,8 +2409,8 @@ SUBROUTINE SrvD_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyContState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyContState + Re_Xferred = Re_Xferred + 1 CALL TMD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%NTMD, ErrStat2, ErrMsg2, OnlySize ) ! NTMD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2586,12 +2482,6 @@ SUBROUTINE SrvD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_UnPackContState' @@ -2605,8 +2495,8 @@ SUBROUTINE SrvD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyContState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyContState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -2892,12 +2782,6 @@ SUBROUTINE SrvD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_UnPackDiscState' @@ -3127,8 +3011,8 @@ SUBROUTINE SrvD_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyConstrState + Re_Xferred = Re_Xferred + 1 CALL TMD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%NTMD, ErrStat2, ErrMsg2, OnlySize ) ! NTMD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3200,12 +3084,6 @@ SUBROUTINE SrvD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_UnPackConstrState' @@ -3219,8 +3097,8 @@ SUBROUTINE SrvD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyConstrState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyConstrState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -3576,8 +3454,10 @@ SUBROUTINE SrvD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BegPitMan,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BegPitMan)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%BegPitMan)-1 ) = TRANSFER(PACK( InData%BegPitMan ,.TRUE.), IntKiBuf(1), SIZE(InData%BegPitMan)) - Int_Xferred = Int_Xferred + SIZE(InData%BegPitMan) + DO i1 = LBOUND(InData%BegPitMan,1), UBOUND(InData%BegPitMan,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%BegPitMan(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%BlPitchI) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3589,8 +3469,10 @@ SUBROUTINE SrvD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlPitchI,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BlPitchI)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlPitchI))-1 ) = PACK(InData%BlPitchI,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlPitchI) + DO i1 = LBOUND(InData%BlPitchI,1), UBOUND(InData%BlPitchI,1) + ReKiBuf(Re_Xferred) = InData%BlPitchI(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TPitManE) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3602,15 +3484,17 @@ SUBROUTINE SrvD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TPitManE,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TPitManE)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%TPitManE))-1 ) = PACK(InData%TPitManE,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%TPitManE) + DO i1 = LBOUND(InData%TPitManE,1), UBOUND(InData%TPitManE,1) + DbKiBuf(Db_Xferred) = InData%TPitManE(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%BegYawMan , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NacYawI - Re_Xferred = Re_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TYawManE - Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%BegYawMan, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NacYawI + Re_Xferred = Re_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%TYawManE + Db_Xferred = Db_Xferred + 1 IF ( .NOT. ALLOCATED(InData%BegTpBr) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -3621,8 +3505,10 @@ SUBROUTINE SrvD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BegTpBr,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BegTpBr)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%BegTpBr)-1 ) = TRANSFER(PACK( InData%BegTpBr ,.TRUE.), IntKiBuf(1), SIZE(InData%BegTpBr)) - Int_Xferred = Int_Xferred + SIZE(InData%BegTpBr) + DO i1 = LBOUND(InData%BegTpBr,1), UBOUND(InData%BegTpBr,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%BegTpBr(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TTpBrDp) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3634,8 +3520,10 @@ SUBROUTINE SrvD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TTpBrDp,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TTpBrDp)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%TTpBrDp))-1 ) = PACK(InData%TTpBrDp,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%TTpBrDp) + DO i1 = LBOUND(InData%TTpBrDp,1), UBOUND(InData%TTpBrDp,1) + DbKiBuf(Db_Xferred) = InData%TTpBrDp(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TTpBrFl) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3647,13 +3535,15 @@ SUBROUTINE SrvD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TTpBrFl,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TTpBrFl)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%TTpBrFl))-1 ) = PACK(InData%TTpBrFl,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%TTpBrFl) + DO i1 = LBOUND(InData%TTpBrFl,1), UBOUND(InData%TTpBrFl,1) + DbKiBuf(Db_Xferred) = InData%TTpBrFl(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Off4Good , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%GenOnLine , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%Off4Good, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%GenOnLine, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 CALL TMD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%NTMD, ErrStat2, ErrMsg2, OnlySize ) ! NTMD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3725,12 +3615,6 @@ SUBROUTINE SrvD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -3758,15 +3642,10 @@ SUBROUTINE SrvD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BegPitMan.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BegPitMan)>0) OutData%BegPitMan = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%BegPitMan))-1 ), OutData%BegPitMan), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%BegPitMan) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BegPitMan,1), UBOUND(OutData%BegPitMan,1) + OutData%BegPitMan(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%BegPitMan(i1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlPitchI not allocated Int_Xferred = Int_Xferred + 1 @@ -3781,15 +3660,10 @@ SUBROUTINE SrvD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitchI.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BlPitchI)>0) OutData%BlPitchI = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlPitchI))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlPitchI) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BlPitchI,1), UBOUND(OutData%BlPitchI,1) + OutData%BlPitchI(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TPitManE not allocated Int_Xferred = Int_Xferred + 1 @@ -3804,22 +3678,17 @@ SUBROUTINE SrvD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TPitManE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TPitManE)>0) OutData%TPitManE = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%TPitManE))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%TPitManE) - DEALLOCATE(mask1) - END IF - OutData%BegYawMan = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NacYawI = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TYawManE = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(OutData%TPitManE,1), UBOUND(OutData%TPitManE,1) + OutData%TPitManE(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + OutData%BegYawMan = TRANSFER(IntKiBuf(Int_Xferred), OutData%BegYawMan) + Int_Xferred = Int_Xferred + 1 + OutData%NacYawI = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TYawManE = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BegTpBr not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3833,15 +3702,10 @@ SUBROUTINE SrvD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BegTpBr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BegTpBr)>0) OutData%BegTpBr = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%BegTpBr))-1 ), OutData%BegTpBr), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%BegTpBr) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BegTpBr,1), UBOUND(OutData%BegTpBr,1) + OutData%BegTpBr(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%BegTpBr(i1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TTpBrDp not allocated Int_Xferred = Int_Xferred + 1 @@ -3856,15 +3720,10 @@ SUBROUTINE SrvD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TTpBrDp.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TTpBrDp)>0) OutData%TTpBrDp = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%TTpBrDp))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%TTpBrDp) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TTpBrDp,1), UBOUND(OutData%TTpBrDp,1) + OutData%TTpBrDp(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TTpBrFl not allocated Int_Xferred = Int_Xferred + 1 @@ -3879,20 +3738,15 @@ SUBROUTINE SrvD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TTpBrFl.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TTpBrFl)>0) OutData%TTpBrFl = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%TTpBrFl))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%TTpBrFl) - DEALLOCATE(mask1) - END IF - OutData%Off4Good = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%GenOnLine = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%TTpBrFl,1), UBOUND(OutData%TTpBrFl,1) + OutData%TTpBrFl(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + OutData%Off4Good = TRANSFER(IntKiBuf(Int_Xferred), OutData%Off4Good) + Int_Xferred = Int_Xferred + 1 + OutData%GenOnLine = TRANSFER(IntKiBuf(Int_Xferred), OutData%GenOnLine) + Int_Xferred = Int_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -4155,8 +4009,8 @@ SUBROUTINE SrvD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%LastTimeCalled - Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%LastTimeCalled + Db_Xferred = Db_Xferred + 1 CALL SrvD_Packbladeddlltype( Re_Buf, Db_Buf, Int_Buf, InData%dll_data, ErrStat2, ErrMsg2, OnlySize ) ! dll_data CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4185,10 +4039,10 @@ SUBROUTINE SrvD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%FirstWarn , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%LastTimeFiltered - Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%FirstWarn, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%LastTimeFiltered + Db_Xferred = Db_Xferred + 1 IF ( .NOT. ALLOCATED(InData%xd_BlPitchFilter) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4199,8 +4053,10 @@ SUBROUTINE SrvD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_BlPitchFilter,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%xd_BlPitchFilter)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%xd_BlPitchFilter))-1 ) = PACK(InData%xd_BlPitchFilter,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%xd_BlPitchFilter) + DO i1 = LBOUND(InData%xd_BlPitchFilter,1), UBOUND(InData%xd_BlPitchFilter,1) + ReKiBuf(Re_Xferred) = InData%xd_BlPitchFilter(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF CALL TMD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%NTMD, ErrStat2, ErrMsg2, OnlySize ) ! NTMD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4273,12 +4129,6 @@ SUBROUTINE SrvD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -4293,8 +4143,8 @@ SUBROUTINE SrvD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%LastTimeCalled = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%LastTimeCalled = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -4335,10 +4185,10 @@ SUBROUTINE SrvD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%FirstWarn = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%LastTimeFiltered = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%FirstWarn = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstWarn) + Int_Xferred = Int_Xferred + 1 + OutData%LastTimeFiltered = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd_BlPitchFilter not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -4352,15 +4202,10 @@ SUBROUTINE SrvD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_BlPitchFilter.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%xd_BlPitchFilter)>0) OutData%xd_BlPitchFilter = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%xd_BlPitchFilter))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%xd_BlPitchFilter) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%xd_BlPitchFilter,1), UBOUND(OutData%xd_BlPitchFilter,1) + OutData%xd_BlPitchFilter(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -4947,54 +4792,54 @@ SUBROUTINE SrvD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%HSSBrDT - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HSSBrFrac - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HSSBrTqF - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SIG_POSl - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SIG_POTq - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SIG_SlPc - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SIG_Slop - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SIG_SySp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TEC_A0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TEC_C0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TEC_C1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TEC_C2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TEC_K2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TEC_MR - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TEC_Re1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TEC_RLR - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TEC_RRes - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TEC_SRes - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TEC_SySp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TEC_V1a - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TEC_VLL - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TEC_Xe1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GenEff - Re_Xferred = Re_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%HSSBrDT + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HSSBrFrac + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HSSBrTqF + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SIG_POSl + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SIG_POTq + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SIG_SlPc + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SIG_Slop + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SIG_SySp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEC_A0 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEC_C0 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEC_C1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEC_C2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEC_K2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEC_MR + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEC_Re1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEC_RLR + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEC_RRes + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEC_SRes + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEC_SySp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEC_V1a + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEC_VLL + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEC_Xe1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GenEff + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%BlPitchInit) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -5005,8 +4850,10 @@ SUBROUTINE SrvD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlPitchInit,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BlPitchInit)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlPitchInit))-1 ) = PACK(InData%BlPitchInit,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlPitchInit) + DO i1 = LBOUND(InData%BlPitchInit,1), UBOUND(InData%BlPitchInit,1) + ReKiBuf(Re_Xferred) = InData%BlPitchInit(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%BlPitchF) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5018,8 +4865,10 @@ SUBROUTINE SrvD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlPitchF,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BlPitchF)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlPitchF))-1 ) = PACK(InData%BlPitchF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlPitchF) + DO i1 = LBOUND(InData%BlPitchF,1), UBOUND(InData%BlPitchF,1) + ReKiBuf(Re_Xferred) = InData%BlPitchF(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%PitManRat) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5031,27 +4880,29 @@ SUBROUTINE SrvD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PitManRat,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PitManRat)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PitManRat))-1 ) = PACK(InData%PitManRat,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PitManRat) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%BlAlpha - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawManRat - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NacYawF - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SpdGenOn - Re_Xferred = Re_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%THSSBrDp - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%THSSBrFl - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TimGenOf - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TimGenOn - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TPCOn - Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(InData%PitManRat,1), UBOUND(InData%PitManRat,1) + ReKiBuf(Re_Xferred) = InData%PitManRat(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%BlAlpha + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawManRat + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NacYawF + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SpdGenOn + Re_Xferred = Re_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%THSSBrDp + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%THSSBrFl + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%TimGenOf + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%TimGenOn + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%TPCOn + Db_Xferred = Db_Xferred + 1 IF ( .NOT. ALLOCATED(InData%TPitManS) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -5062,53 +4913,55 @@ SUBROUTINE SrvD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TPitManS,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TPitManS)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%TPitManS))-1 ) = PACK(InData%TPitManS,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%TPitManS) - END IF - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TYawManS - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TYCOn - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%VS_RtGnSp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%VS_RtTq - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%VS_Slope - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%VS_SlPc - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%VS_SySp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%VS_TrGnSp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawPosCom - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawRateCom - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%GenModel - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%HSSBrMode - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%PCMode - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%VSContrl - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%YCMode - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%GenTiStp , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%GenTiStr , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%VS_Rgn2K - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawNeut - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawDamp - Re_Xferred = Re_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TpBrDT - Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(InData%TPitManS,1), UBOUND(InData%TPitManS,1) + DbKiBuf(Db_Xferred) = InData%TPitManS(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + DbKiBuf(Db_Xferred) = InData%TYawManS + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%TYCOn + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VS_RtGnSp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VS_RtTq + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VS_Slope + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VS_SlPc + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VS_SySp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VS_TrGnSp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawPosCom + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawRateCom + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%GenModel + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%HSSBrMode + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%PCMode + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%VSContrl + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%YCMode + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%GenTiStp, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%GenTiStr, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VS_Rgn2K + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawNeut + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawSpr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawDamp + Re_Xferred = Re_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%TpBrDT + Db_Xferred = Db_Xferred + 1 IF ( .NOT. ALLOCATED(InData%TBDepISp) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -5119,25 +4972,27 @@ SUBROUTINE SrvD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TBDepISp,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TBDepISp)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TBDepISp))-1 ) = PACK(InData%TBDepISp,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TBDepISp) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TBDrConN - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TBDrConD - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumBl - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%CompNTMD , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%CompTTMD , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO i1 = LBOUND(InData%TBDepISp,1), UBOUND(InData%TBDepISp,1) + ReKiBuf(Re_Xferred) = InData%TBDepISp(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%TBDrConN + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TBDrConD + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumBl + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%CompNTMD, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%CompTTMD, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -5179,30 +5034,30 @@ SUBROUTINE SrvD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, ENDIF END DO END IF - DO I = 1, LEN(InData%Delim) - IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%UseBladedInterface , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%DLL_Ramp , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DLL_DT - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DLL_NumTrq - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Ptch_Cntrl - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Gain_OM - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GenPwr_Dem - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GenSpd_Dem - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GenSpd_MaxOM - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GenSpd_MinOM - Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(InData%Delim) + IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%UseBladedInterface, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%DLL_Ramp, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DLL_DT + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DLL_NumTrq + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Ptch_Cntrl + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Gain_OM + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GenPwr_Dem + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GenSpd_Dem + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GenSpd_MaxOM + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GenSpd_MinOM + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%GenSpd_TLU) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -5213,11 +5068,13 @@ SUBROUTINE SrvD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GenSpd_TLU,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%GenSpd_TLU)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GenSpd_TLU))-1 ) = PACK(InData%GenSpd_TLU,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GenSpd_TLU) + DO i1 = LBOUND(InData%GenSpd_TLU,1), UBOUND(InData%GenSpd_TLU,1) + ReKiBuf(Re_Xferred) = InData%GenSpd_TLU(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GenTrq_Dem - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GenTrq_Dem + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%GenTrq_TLU) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -5228,25 +5085,27 @@ SUBROUTINE SrvD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GenTrq_TLU,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%GenTrq_TLU)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GenTrq_TLU))-1 ) = PACK(InData%GenTrq_TLU,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GenTrq_TLU) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Ptch_Max - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Ptch_Min - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Ptch_SetPnt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtchRate_Max - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtchRate_Min - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NacYaw_North - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%DLL_InFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_InFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO i1 = LBOUND(InData%GenTrq_TLU,1), UBOUND(InData%GenTrq_TLU,1) + ReKiBuf(Re_Xferred) = InData%GenTrq_TLU(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%Ptch_Max + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Ptch_Min + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Ptch_SetPnt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtchRate_Max + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtchRate_Min + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NacYaw_North + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(InData%DLL_InFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_InFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I CALL DLLTypePack( InData%DLL_Trgt, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! DLL_Trgt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -5331,10 +5190,10 @@ SUBROUTINE SrvD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AvgWindSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AirDens - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AvgWindSpeed + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AirDens + Re_Xferred = Re_Xferred + 1 END SUBROUTINE SrvD_PackParam SUBROUTINE SrvD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -5350,12 +5209,6 @@ SUBROUTINE SrvD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -5370,54 +5223,54 @@ SUBROUTINE SrvD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%HSSBrDT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%HSSBrFrac = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HSSBrTqF = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SIG_POSl = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SIG_POTq = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SIG_SlPc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SIG_Slop = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SIG_SySp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_A0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_C0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_C1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_C2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_K2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_MR = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_Re1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_RLR = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_RRes = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_SRes = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_SySp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_V1a = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_VLL = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_Xe1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GenEff = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%HSSBrDT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%HSSBrFrac = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HSSBrTqF = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SIG_POSl = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SIG_POTq = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SIG_SlPc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SIG_Slop = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SIG_SySp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEC_A0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEC_C0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEC_C1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEC_C2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEC_K2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEC_MR = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEC_Re1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEC_RLR = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEC_RRes = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEC_SRes = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEC_SySp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEC_V1a = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEC_VLL = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEC_Xe1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GenEff = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlPitchInit not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5431,15 +5284,10 @@ SUBROUTINE SrvD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitchInit.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BlPitchInit)>0) OutData%BlPitchInit = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlPitchInit))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlPitchInit) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BlPitchInit,1), UBOUND(OutData%BlPitchInit,1) + OutData%BlPitchInit(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlPitchF not allocated Int_Xferred = Int_Xferred + 1 @@ -5454,15 +5302,10 @@ SUBROUTINE SrvD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitchF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BlPitchF)>0) OutData%BlPitchF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlPitchF))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlPitchF) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BlPitchF,1), UBOUND(OutData%BlPitchF,1) + OutData%BlPitchF(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PitManRat not allocated Int_Xferred = Int_Xferred + 1 @@ -5477,34 +5320,29 @@ SUBROUTINE SrvD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PitManRat.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%PitManRat)>0) OutData%PitManRat = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PitManRat))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PitManRat) - DEALLOCATE(mask1) - END IF - OutData%BlAlpha = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawManRat = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NacYawF = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SpdGenOn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%THSSBrDp = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%THSSBrFl = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%TimGenOf = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%TimGenOn = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%TPCOn = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(OutData%PitManRat,1), UBOUND(OutData%PitManRat,1) + OutData%PitManRat(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%BlAlpha = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawManRat = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NacYawF = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SpdGenOn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%THSSBrDp = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%THSSBrFl = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%TimGenOf = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%TimGenOn = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%TPCOn = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TPitManS not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5518,60 +5356,55 @@ SUBROUTINE SrvD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TPitManS.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TPitManS)>0) OutData%TPitManS = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%TPitManS))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%TPitManS) - DEALLOCATE(mask1) - END IF - OutData%TYawManS = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%TYCOn = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%VS_RtGnSp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%VS_RtTq = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%VS_Slope = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%VS_SlPc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%VS_SySp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%VS_TrGnSp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawPosCom = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawRateCom = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GenModel = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%HSSBrMode = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%PCMode = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%VSContrl = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%YCMode = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%GenTiStp = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%GenTiStr = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%VS_Rgn2K = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawNeut = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawSpr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawDamp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TpBrDT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(OutData%TPitManS,1), UBOUND(OutData%TPitManS,1) + OutData%TPitManS(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + OutData%TYawManS = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%TYCOn = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%VS_RtGnSp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%VS_RtTq = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%VS_Slope = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%VS_SlPc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%VS_SySp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%VS_TrGnSp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawPosCom = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawRateCom = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GenModel = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%HSSBrMode = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%PCMode = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%VSContrl = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%YCMode = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%GenTiStp = TRANSFER(IntKiBuf(Int_Xferred), OutData%GenTiStp) + Int_Xferred = Int_Xferred + 1 + OutData%GenTiStr = TRANSFER(IntKiBuf(Int_Xferred), OutData%GenTiStr) + Int_Xferred = Int_Xferred + 1 + OutData%VS_Rgn2K = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawNeut = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawSpr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawDamp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TpBrDT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TBDepISp not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5585,32 +5418,27 @@ SUBROUTINE SrvD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TBDepISp.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TBDepISp)>0) OutData%TBDepISp = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TBDepISp))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TBDepISp) - DEALLOCATE(mask1) - END IF - OutData%TBDrConN = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TBDrConD = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NumBl = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%CompNTMD = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%CompTTMD = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO i1 = LBOUND(OutData%TBDepISp,1), UBOUND(OutData%TBDepISp,1) + OutData%TBDepISp(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%TBDrConN = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TBDrConD = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NumBl = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%CompNTMD = TRANSFER(IntKiBuf(Int_Xferred), OutData%CompNTMD) + Int_Xferred = Int_Xferred + 1 + OutData%CompTTMD = TRANSFER(IntKiBuf(Int_Xferred), OutData%CompTTMD) + Int_Xferred = Int_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5667,30 +5495,30 @@ SUBROUTINE SrvD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%UseBladedInterface = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%DLL_Ramp = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%DLL_DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%DLL_NumTrq = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%Ptch_Cntrl = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%Gain_OM = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GenPwr_Dem = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GenSpd_Dem = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GenSpd_MaxOM = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GenSpd_MinOM = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(OutData%Delim) + OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%UseBladedInterface = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseBladedInterface) + Int_Xferred = Int_Xferred + 1 + OutData%DLL_Ramp = TRANSFER(IntKiBuf(Int_Xferred), OutData%DLL_Ramp) + Int_Xferred = Int_Xferred + 1 + OutData%DLL_DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%DLL_NumTrq = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Ptch_Cntrl = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Gain_OM = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GenPwr_Dem = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GenSpd_Dem = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GenSpd_MaxOM = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GenSpd_MinOM = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GenSpd_TLU not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5704,18 +5532,13 @@ SUBROUTINE SrvD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GenSpd_TLU.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%GenSpd_TLU)>0) OutData%GenSpd_TLU = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GenSpd_TLU))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GenSpd_TLU) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%GenSpd_TLU,1), UBOUND(OutData%GenSpd_TLU,1) + OutData%GenSpd_TLU(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%GenTrq_Dem = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%GenTrq_Dem = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GenTrq_TLU not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5729,32 +5552,27 @@ SUBROUTINE SrvD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GenTrq_TLU.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%GenTrq_TLU)>0) OutData%GenTrq_TLU = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GenTrq_TLU))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GenTrq_TLU) - DEALLOCATE(mask1) - END IF - OutData%Ptch_Max = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Ptch_Min = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Ptch_SetPnt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtchRate_Max = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtchRate_Min = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NacYaw_North = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%DLL_InFile) - OutData%DLL_InFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO i1 = LBOUND(OutData%GenTrq_TLU,1), UBOUND(OutData%GenTrq_TLU,1) + OutData%GenTrq_TLU(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%Ptch_Max = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Ptch_Min = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Ptch_SetPnt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtchRate_Max = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtchRate_Min = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NacYaw_North = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(OutData%DLL_InFile) + OutData%DLL_InFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -5875,10 +5693,10 @@ SUBROUTINE SrvD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%AvgWindSpeed = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%AirDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%AvgWindSpeed = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AirDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE SrvD_UnPackParam SUBROUTINE SrvD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -6150,23 +5968,25 @@ SUBROUTINE SrvD_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlPitch,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BlPitch)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlPitch))-1 ) = PACK(InData%BlPitch,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlPitch) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Yaw - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawRate - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%LSS_Spd - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HSS_Spd - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RotSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ExternalYawPosCom - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ExternalYawRateCom - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%BlPitch,1), UBOUND(InData%BlPitch,1) + ReKiBuf(Re_Xferred) = InData%BlPitch(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%Yaw + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawRate + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%LSS_Spd + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HSS_Spd + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RotSpeed + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ExternalYawPosCom + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ExternalYawRateCom + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%ExternalBlPitchCom) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -6177,61 +5997,67 @@ SUBROUTINE SrvD_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ExternalBlPitchCom,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ExternalBlPitchCom)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%ExternalBlPitchCom))-1 ) = PACK(InData%ExternalBlPitchCom,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%ExternalBlPitchCom) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ExternalGenTrq - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ExternalElecPwr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ExternalHSSBrFrac - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TwrAccel - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawErr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WindDir - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RootMyc))-1 ) = PACK(InData%RootMyc,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RootMyc) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawBrTAxp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawBrTAyp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%LSSTipPxa - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RootMxc))-1 ) = PACK(InData%RootMxc,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RootMxc) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%LSSTipMxa - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%LSSTipMya - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%LSSTipMza - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%LSSTipMys - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%LSSTipMzs - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawBrMyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawBrMzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NcIMURAxs - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NcIMURAys - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NcIMURAzs - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RotPwr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HorWindV - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawAngle - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ElecPwr_prev - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GenTrq_prev - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%ExternalBlPitchCom,1), UBOUND(InData%ExternalBlPitchCom,1) + ReKiBuf(Re_Xferred) = InData%ExternalBlPitchCom(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%ExternalGenTrq + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ExternalElecPwr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ExternalHSSBrFrac + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TwrAccel + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawErr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WindDir + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%RootMyc,1), UBOUND(InData%RootMyc,1) + ReKiBuf(Re_Xferred) = InData%RootMyc(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%YawBrTAxp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawBrTAyp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%LSSTipPxa + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%RootMxc,1), UBOUND(InData%RootMxc,1) + ReKiBuf(Re_Xferred) = InData%RootMxc(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%LSSTipMxa + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%LSSTipMya + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%LSSTipMza + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%LSSTipMys + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%LSSTipMzs + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawBrMyn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawBrMzn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NcIMURAxs + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NcIMURAys + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NcIMURAzs + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RotPwr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HorWindV + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawAngle + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ElecPwr_prev + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GenTrq_prev + Re_Xferred = Re_Xferred + 1 CALL TMD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%NTMD, ErrStat2, ErrMsg2, OnlySize ) ! NTMD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6298,8 +6124,10 @@ SUBROUTINE SrvD_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SuperController,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%SuperController)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SuperController))-1 ) = PACK(InData%SuperController,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SuperController) + DO i1 = LBOUND(InData%SuperController,1), UBOUND(InData%SuperController,1) + ReKiBuf(Re_Xferred) = InData%SuperController(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE SrvD_PackInput @@ -6316,12 +6144,6 @@ SUBROUTINE SrvD_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -6349,30 +6171,25 @@ SUBROUTINE SrvD_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitch.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BlPitch)>0) OutData%BlPitch = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlPitch))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlPitch) - DEALLOCATE(mask1) - END IF - OutData%Yaw = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawRate = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%LSS_Spd = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HSS_Spd = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RotSpeed = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%ExternalYawPosCom = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%ExternalYawRateCom = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%BlPitch,1), UBOUND(OutData%BlPitch,1) + OutData%BlPitch(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%Yaw = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawRate = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LSS_Spd = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HSS_Spd = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RotSpeed = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%ExternalYawPosCom = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%ExternalYawRateCom = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ExternalBlPitchCom not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -6386,86 +6203,71 @@ SUBROUTINE SrvD_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ExternalBlPitchCom.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%ExternalBlPitchCom)>0) OutData%ExternalBlPitchCom = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%ExternalBlPitchCom))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%ExternalBlPitchCom) - DEALLOCATE(mask1) - END IF - OutData%ExternalGenTrq = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%ExternalElecPwr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%ExternalHSSBrFrac = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TwrAccel = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawErr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WindDir = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%ExternalBlPitchCom,1), UBOUND(OutData%ExternalBlPitchCom,1) + OutData%ExternalBlPitchCom(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%ExternalGenTrq = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%ExternalElecPwr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%ExternalHSSBrFrac = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TwrAccel = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawErr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WindDir = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%RootMyc,1) i1_u = UBOUND(OutData%RootMyc,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%RootMyc = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RootMyc))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RootMyc) - DEALLOCATE(mask1) - OutData%YawBrTAxp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawBrTAyp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipPxa = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%RootMyc,1), UBOUND(OutData%RootMyc,1) + OutData%RootMyc(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%YawBrTAxp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawBrTAyp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LSSTipPxa = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%RootMxc,1) i1_u = UBOUND(OutData%RootMxc,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%RootMxc = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RootMxc))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RootMxc) - DEALLOCATE(mask1) - OutData%LSSTipMxa = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipMya = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipMza = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipMys = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipMzs = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawBrMyn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawBrMzn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NcIMURAxs = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NcIMURAys = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NcIMURAzs = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RotPwr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HorWindV = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawAngle = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%ElecPwr_prev = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GenTrq_prev = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%RootMxc,1), UBOUND(OutData%RootMxc,1) + OutData%RootMxc(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%LSSTipMxa = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LSSTipMya = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LSSTipMza = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LSSTipMys = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LSSTipMzs = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawBrMyn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawBrMzn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NcIMURAxs = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NcIMURAys = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NcIMURAzs = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RotPwr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HorWindV = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawAngle = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%ElecPwr_prev = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GenTrq_prev = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -6559,15 +6361,10 @@ SUBROUTINE SrvD_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SuperController.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%SuperController)>0) OutData%SuperController = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SuperController))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%SuperController) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%SuperController,1), UBOUND(OutData%SuperController,1) + OutData%SuperController(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE SrvD_UnPackInput @@ -6802,8 +6599,10 @@ SUBROUTINE SrvD_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WriteOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%BlPitchCom) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6815,17 +6614,19 @@ SUBROUTINE SrvD_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlPitchCom,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BlPitchCom)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlPitchCom))-1 ) = PACK(InData%BlPitchCom,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlPitchCom) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawMom - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GenTrq - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HSSBrTrqC - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ElecPwr - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%BlPitchCom,1), UBOUND(InData%BlPitchCom,1) + ReKiBuf(Re_Xferred) = InData%BlPitchCom(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%YawMom + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GenTrq + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HSSBrTrqC + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ElecPwr + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%TBDrCon) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -6836,8 +6637,10 @@ SUBROUTINE SrvD_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TBDrCon,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TBDrCon)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TBDrCon))-1 ) = PACK(InData%TBDrCon,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TBDrCon) + DO i1 = LBOUND(InData%TBDrCon,1), UBOUND(InData%TBDrCon,1) + ReKiBuf(Re_Xferred) = InData%TBDrCon(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF CALL TMD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%NTMD, ErrStat2, ErrMsg2, OnlySize ) ! NTMD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6905,8 +6708,10 @@ SUBROUTINE SrvD_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SuperController,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%SuperController)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SuperController))-1 ) = PACK(InData%SuperController,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SuperController) + DO i1 = LBOUND(InData%SuperController,1), UBOUND(InData%SuperController,1) + ReKiBuf(Re_Xferred) = InData%SuperController(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE SrvD_PackOutput @@ -6923,12 +6728,6 @@ SUBROUTINE SrvD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -6956,15 +6755,10 @@ SUBROUTINE SrvD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WriteOutput)>0) OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlPitchCom not allocated Int_Xferred = Int_Xferred + 1 @@ -6979,24 +6773,19 @@ SUBROUTINE SrvD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitchCom.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BlPitchCom)>0) OutData%BlPitchCom = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlPitchCom))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlPitchCom) - DEALLOCATE(mask1) - END IF - OutData%YawMom = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GenTrq = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HSSBrTrqC = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%ElecPwr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%BlPitchCom,1), UBOUND(OutData%BlPitchCom,1) + OutData%BlPitchCom(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%YawMom = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GenTrq = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HSSBrTrqC = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%ElecPwr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TBDrCon not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -7010,15 +6799,10 @@ SUBROUTINE SrvD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TBDrCon.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TBDrCon)>0) OutData%TBDrCon = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TBDrCon))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TBDrCon) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TBDrCon,1), UBOUND(OutData%TBDrCon,1) + OutData%TBDrCon(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -7113,15 +6897,10 @@ SUBROUTINE SrvD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SuperController.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%SuperController)>0) OutData%SuperController = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SuperController))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%SuperController) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%SuperController,1), UBOUND(OutData%SuperController,1) + OutData%SuperController(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE SrvD_UnPackOutput @@ -7200,12 +6979,12 @@ SUBROUTINE SrvD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! 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 :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -7218,107 +6997,99 @@ SUBROUTINE SrvD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ALLOCATED(u_out%BlPitch) .AND. ALLOCATED(u1%BlPitch)) THEN - ALLOCATE(b1(SIZE(u_out%BlPitch,1))) - ALLOCATE(c1(SIZE(u_out%BlPitch,1))) - b1 = -(u1%BlPitch - u2%BlPitch)/t(2) - u_out%BlPitch = u1%BlPitch + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%BlPitch,1),UBOUND(u_out%BlPitch,1) + b = -(u1%BlPitch(i1) - u2%BlPitch(i1)) + u_out%BlPitch(i1) = u1%BlPitch(i1) + b * ScaleFactor + END DO END IF ! check if allocated - b0 = -(u1%Yaw - u2%Yaw)/t(2) - u_out%Yaw = u1%Yaw + b0 * t_out - b0 = -(u1%YawRate - u2%YawRate)/t(2) - u_out%YawRate = u1%YawRate + b0 * t_out - b0 = -(u1%LSS_Spd - u2%LSS_Spd)/t(2) - u_out%LSS_Spd = u1%LSS_Spd + b0 * t_out - b0 = -(u1%HSS_Spd - u2%HSS_Spd)/t(2) - u_out%HSS_Spd = u1%HSS_Spd + b0 * t_out - b0 = -(u1%RotSpeed - u2%RotSpeed)/t(2) - u_out%RotSpeed = u1%RotSpeed + b0 * t_out - b0 = -(u1%ExternalYawPosCom - u2%ExternalYawPosCom)/t(2) - u_out%ExternalYawPosCom = u1%ExternalYawPosCom + b0 * t_out - b0 = -(u1%ExternalYawRateCom - u2%ExternalYawRateCom)/t(2) - u_out%ExternalYawRateCom = u1%ExternalYawRateCom + b0 * t_out + b = -(u1%Yaw - u2%Yaw) + u_out%Yaw = u1%Yaw + b * ScaleFactor + b = -(u1%YawRate - u2%YawRate) + u_out%YawRate = u1%YawRate + b * ScaleFactor + b = -(u1%LSS_Spd - u2%LSS_Spd) + u_out%LSS_Spd = u1%LSS_Spd + b * ScaleFactor + b = -(u1%HSS_Spd - u2%HSS_Spd) + u_out%HSS_Spd = u1%HSS_Spd + b * ScaleFactor + b = -(u1%RotSpeed - u2%RotSpeed) + u_out%RotSpeed = u1%RotSpeed + b * ScaleFactor + b = -(u1%ExternalYawPosCom - u2%ExternalYawPosCom) + u_out%ExternalYawPosCom = u1%ExternalYawPosCom + b * ScaleFactor + b = -(u1%ExternalYawRateCom - u2%ExternalYawRateCom) + u_out%ExternalYawRateCom = u1%ExternalYawRateCom + b * ScaleFactor IF (ALLOCATED(u_out%ExternalBlPitchCom) .AND. ALLOCATED(u1%ExternalBlPitchCom)) THEN - ALLOCATE(b1(SIZE(u_out%ExternalBlPitchCom,1))) - ALLOCATE(c1(SIZE(u_out%ExternalBlPitchCom,1))) - b1 = -(u1%ExternalBlPitchCom - u2%ExternalBlPitchCom)/t(2) - u_out%ExternalBlPitchCom = u1%ExternalBlPitchCom + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%ExternalBlPitchCom,1),UBOUND(u_out%ExternalBlPitchCom,1) + b = -(u1%ExternalBlPitchCom(i1) - u2%ExternalBlPitchCom(i1)) + u_out%ExternalBlPitchCom(i1) = u1%ExternalBlPitchCom(i1) + b * ScaleFactor + END DO END IF ! check if allocated - b0 = -(u1%ExternalGenTrq - u2%ExternalGenTrq)/t(2) - u_out%ExternalGenTrq = u1%ExternalGenTrq + b0 * t_out - b0 = -(u1%ExternalElecPwr - u2%ExternalElecPwr)/t(2) - u_out%ExternalElecPwr = u1%ExternalElecPwr + b0 * t_out - b0 = -(u1%ExternalHSSBrFrac - u2%ExternalHSSBrFrac)/t(2) - u_out%ExternalHSSBrFrac = u1%ExternalHSSBrFrac + b0 * t_out - b0 = -(u1%TwrAccel - u2%TwrAccel)/t(2) - u_out%TwrAccel = u1%TwrAccel + b0 * t_out - b0 = -(u1%YawErr - u2%YawErr)/t(2) - u_out%YawErr = u1%YawErr + b0 * t_out - b0 = -(u1%WindDir - u2%WindDir)/t(2) - u_out%WindDir = u1%WindDir + b0 * t_out - ALLOCATE(b1(SIZE(u_out%RootMyc,1))) - ALLOCATE(c1(SIZE(u_out%RootMyc,1))) - b1 = -(u1%RootMyc - u2%RootMyc)/t(2) - u_out%RootMyc = u1%RootMyc + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - b0 = -(u1%YawBrTAxp - u2%YawBrTAxp)/t(2) - u_out%YawBrTAxp = u1%YawBrTAxp + b0 * t_out - b0 = -(u1%YawBrTAyp - u2%YawBrTAyp)/t(2) - u_out%YawBrTAyp = u1%YawBrTAyp + b0 * t_out - b0 = -(u1%LSSTipPxa - u2%LSSTipPxa)/t(2) - u_out%LSSTipPxa = u1%LSSTipPxa + b0 * t_out - ALLOCATE(b1(SIZE(u_out%RootMxc,1))) - ALLOCATE(c1(SIZE(u_out%RootMxc,1))) - b1 = -(u1%RootMxc - u2%RootMxc)/t(2) - u_out%RootMxc = u1%RootMxc + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - b0 = -(u1%LSSTipMxa - u2%LSSTipMxa)/t(2) - u_out%LSSTipMxa = u1%LSSTipMxa + b0 * t_out - b0 = -(u1%LSSTipMya - u2%LSSTipMya)/t(2) - u_out%LSSTipMya = u1%LSSTipMya + b0 * t_out - b0 = -(u1%LSSTipMza - u2%LSSTipMza)/t(2) - u_out%LSSTipMza = u1%LSSTipMza + b0 * t_out - b0 = -(u1%LSSTipMys - u2%LSSTipMys)/t(2) - u_out%LSSTipMys = u1%LSSTipMys + b0 * t_out - b0 = -(u1%LSSTipMzs - u2%LSSTipMzs)/t(2) - u_out%LSSTipMzs = u1%LSSTipMzs + b0 * t_out - b0 = -(u1%YawBrMyn - u2%YawBrMyn)/t(2) - u_out%YawBrMyn = u1%YawBrMyn + b0 * t_out - b0 = -(u1%YawBrMzn - u2%YawBrMzn)/t(2) - u_out%YawBrMzn = u1%YawBrMzn + b0 * t_out - b0 = -(u1%NcIMURAxs - u2%NcIMURAxs)/t(2) - u_out%NcIMURAxs = u1%NcIMURAxs + b0 * t_out - b0 = -(u1%NcIMURAys - u2%NcIMURAys)/t(2) - u_out%NcIMURAys = u1%NcIMURAys + b0 * t_out - b0 = -(u1%NcIMURAzs - u2%NcIMURAzs)/t(2) - u_out%NcIMURAzs = u1%NcIMURAzs + b0 * t_out - b0 = -(u1%RotPwr - u2%RotPwr)/t(2) - u_out%RotPwr = u1%RotPwr + b0 * t_out - b0 = -(u1%HorWindV - u2%HorWindV)/t(2) - u_out%HorWindV = u1%HorWindV + b0 * t_out - b0 = -(u1%YawAngle - u2%YawAngle)/t(2) - u_out%YawAngle = u1%YawAngle + b0 * t_out - b0 = -(u1%ElecPwr_prev - u2%ElecPwr_prev)/t(2) - u_out%ElecPwr_prev = u1%ElecPwr_prev + b0 * t_out - b0 = -(u1%GenTrq_prev - u2%GenTrq_prev)/t(2) - u_out%GenTrq_prev = u1%GenTrq_prev + b0 * t_out + b = -(u1%ExternalGenTrq - u2%ExternalGenTrq) + u_out%ExternalGenTrq = u1%ExternalGenTrq + b * ScaleFactor + b = -(u1%ExternalElecPwr - u2%ExternalElecPwr) + u_out%ExternalElecPwr = u1%ExternalElecPwr + b * ScaleFactor + b = -(u1%ExternalHSSBrFrac - u2%ExternalHSSBrFrac) + u_out%ExternalHSSBrFrac = u1%ExternalHSSBrFrac + b * ScaleFactor + b = -(u1%TwrAccel - u2%TwrAccel) + u_out%TwrAccel = u1%TwrAccel + b * ScaleFactor + b = -(u1%YawErr - u2%YawErr) + u_out%YawErr = u1%YawErr + b * ScaleFactor + b = -(u1%WindDir - u2%WindDir) + u_out%WindDir = u1%WindDir + b * ScaleFactor + DO i1 = LBOUND(u_out%RootMyc,1),UBOUND(u_out%RootMyc,1) + b = -(u1%RootMyc(i1) - u2%RootMyc(i1)) + u_out%RootMyc(i1) = u1%RootMyc(i1) + b * ScaleFactor + END DO + b = -(u1%YawBrTAxp - u2%YawBrTAxp) + u_out%YawBrTAxp = u1%YawBrTAxp + b * ScaleFactor + b = -(u1%YawBrTAyp - u2%YawBrTAyp) + u_out%YawBrTAyp = u1%YawBrTAyp + b * ScaleFactor + b = -(u1%LSSTipPxa - u2%LSSTipPxa) + u_out%LSSTipPxa = u1%LSSTipPxa + b * ScaleFactor + DO i1 = LBOUND(u_out%RootMxc,1),UBOUND(u_out%RootMxc,1) + b = -(u1%RootMxc(i1) - u2%RootMxc(i1)) + u_out%RootMxc(i1) = u1%RootMxc(i1) + b * ScaleFactor + END DO + b = -(u1%LSSTipMxa - u2%LSSTipMxa) + u_out%LSSTipMxa = u1%LSSTipMxa + b * ScaleFactor + b = -(u1%LSSTipMya - u2%LSSTipMya) + u_out%LSSTipMya = u1%LSSTipMya + b * ScaleFactor + b = -(u1%LSSTipMza - u2%LSSTipMza) + u_out%LSSTipMza = u1%LSSTipMza + b * ScaleFactor + b = -(u1%LSSTipMys - u2%LSSTipMys) + u_out%LSSTipMys = u1%LSSTipMys + b * ScaleFactor + b = -(u1%LSSTipMzs - u2%LSSTipMzs) + u_out%LSSTipMzs = u1%LSSTipMzs + b * ScaleFactor + b = -(u1%YawBrMyn - u2%YawBrMyn) + u_out%YawBrMyn = u1%YawBrMyn + b * ScaleFactor + b = -(u1%YawBrMzn - u2%YawBrMzn) + u_out%YawBrMzn = u1%YawBrMzn + b * ScaleFactor + b = -(u1%NcIMURAxs - u2%NcIMURAxs) + u_out%NcIMURAxs = u1%NcIMURAxs + b * ScaleFactor + b = -(u1%NcIMURAys - u2%NcIMURAys) + u_out%NcIMURAys = u1%NcIMURAys + b * ScaleFactor + b = -(u1%NcIMURAzs - u2%NcIMURAzs) + u_out%NcIMURAzs = u1%NcIMURAzs + b * ScaleFactor + b = -(u1%RotPwr - u2%RotPwr) + u_out%RotPwr = u1%RotPwr + b * ScaleFactor + b = -(u1%HorWindV - u2%HorWindV) + u_out%HorWindV = u1%HorWindV + b * ScaleFactor + b = -(u1%YawAngle - u2%YawAngle) + u_out%YawAngle = u1%YawAngle + b * ScaleFactor + b = -(u1%ElecPwr_prev - u2%ElecPwr_prev) + u_out%ElecPwr_prev = u1%ElecPwr_prev + b * ScaleFactor + b = -(u1%GenTrq_prev - u2%GenTrq_prev) + u_out%GenTrq_prev = u1%GenTrq_prev + b * ScaleFactor CALL TMD_Input_ExtrapInterp1( u1%NTMD, u2%NTMD, tin, u_out%NTMD, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL TMD_Input_ExtrapInterp1( u1%TTMD, u2%TTMD, tin, u_out%TTMD, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(u_out%SuperController) .AND. ALLOCATED(u1%SuperController)) THEN - ALLOCATE(b1(SIZE(u_out%SuperController,1))) - ALLOCATE(c1(SIZE(u_out%SuperController,1))) - b1 = -(u1%SuperController - u2%SuperController)/t(2) - u_out%SuperController = u1%SuperController + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%SuperController,1),UBOUND(u_out%SuperController,1) + b = -(u1%SuperController(i1) - u2%SuperController(i1)) + u_out%SuperController(i1) = u1%SuperController(i1) + b * ScaleFactor + END DO END IF ! check if allocated END SUBROUTINE SrvD_Input_ExtrapInterp1 @@ -7349,13 +7120,14 @@ SUBROUTINE SrvD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -7374,143 +7146,135 @@ SUBROUTINE SrvD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ALLOCATED(u_out%BlPitch) .AND. ALLOCATED(u1%BlPitch)) THEN - ALLOCATE(b1(SIZE(u_out%BlPitch,1))) - ALLOCATE(c1(SIZE(u_out%BlPitch,1))) - b1 = (t(3)**2*(u1%BlPitch - u2%BlPitch) + t(2)**2*(-u1%BlPitch + u3%BlPitch))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%BlPitch + t(3)*u2%BlPitch - t(2)*u3%BlPitch ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%BlPitch = u1%BlPitch + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%BlPitch,1),UBOUND(u_out%BlPitch,1) + b = (t(3)**2*(u1%BlPitch(i1) - u2%BlPitch(i1)) + t(2)**2*(-u1%BlPitch(i1) + u3%BlPitch(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%BlPitch(i1) + t(3)*u2%BlPitch(i1) - t(2)*u3%BlPitch(i1) ) * scaleFactor + u_out%BlPitch(i1) = u1%BlPitch(i1) + b + c * t_out + END DO END IF ! check if allocated - b0 = (t(3)**2*(u1%Yaw - u2%Yaw) + t(2)**2*(-u1%Yaw + u3%Yaw))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%Yaw + t(3)*u2%Yaw - t(2)*u3%Yaw ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Yaw = u1%Yaw + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%YawRate - u2%YawRate) + t(2)**2*(-u1%YawRate + u3%YawRate))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%YawRate + t(3)*u2%YawRate - t(2)*u3%YawRate ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%YawRate = u1%YawRate + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%LSS_Spd - u2%LSS_Spd) + t(2)**2*(-u1%LSS_Spd + u3%LSS_Spd))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%LSS_Spd + t(3)*u2%LSS_Spd - t(2)*u3%LSS_Spd ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%LSS_Spd = u1%LSS_Spd + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%HSS_Spd - u2%HSS_Spd) + t(2)**2*(-u1%HSS_Spd + u3%HSS_Spd))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%HSS_Spd + t(3)*u2%HSS_Spd - t(2)*u3%HSS_Spd ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%HSS_Spd = u1%HSS_Spd + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%RotSpeed - u2%RotSpeed) + t(2)**2*(-u1%RotSpeed + u3%RotSpeed))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%RotSpeed + t(3)*u2%RotSpeed - t(2)*u3%RotSpeed ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%RotSpeed = u1%RotSpeed + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%ExternalYawPosCom - u2%ExternalYawPosCom) + t(2)**2*(-u1%ExternalYawPosCom + u3%ExternalYawPosCom))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%ExternalYawPosCom + t(3)*u2%ExternalYawPosCom - t(2)*u3%ExternalYawPosCom ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%ExternalYawPosCom = u1%ExternalYawPosCom + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%ExternalYawRateCom - u2%ExternalYawRateCom) + t(2)**2*(-u1%ExternalYawRateCom + u3%ExternalYawRateCom))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%ExternalYawRateCom + t(3)*u2%ExternalYawRateCom - t(2)*u3%ExternalYawRateCom ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%ExternalYawRateCom = u1%ExternalYawRateCom + b0 * t_out + c0 * t_out**2 + b = (t(3)**2*(u1%Yaw - u2%Yaw) + t(2)**2*(-u1%Yaw + u3%Yaw))* scaleFactor + c = ( (t(2)-t(3))*u1%Yaw + t(3)*u2%Yaw - t(2)*u3%Yaw ) * scaleFactor + u_out%Yaw = u1%Yaw + b + c * t_out + b = (t(3)**2*(u1%YawRate - u2%YawRate) + t(2)**2*(-u1%YawRate + u3%YawRate))* scaleFactor + c = ( (t(2)-t(3))*u1%YawRate + t(3)*u2%YawRate - t(2)*u3%YawRate ) * scaleFactor + u_out%YawRate = u1%YawRate + b + c * t_out + b = (t(3)**2*(u1%LSS_Spd - u2%LSS_Spd) + t(2)**2*(-u1%LSS_Spd + u3%LSS_Spd))* scaleFactor + c = ( (t(2)-t(3))*u1%LSS_Spd + t(3)*u2%LSS_Spd - t(2)*u3%LSS_Spd ) * scaleFactor + u_out%LSS_Spd = u1%LSS_Spd + b + c * t_out + b = (t(3)**2*(u1%HSS_Spd - u2%HSS_Spd) + t(2)**2*(-u1%HSS_Spd + u3%HSS_Spd))* scaleFactor + c = ( (t(2)-t(3))*u1%HSS_Spd + t(3)*u2%HSS_Spd - t(2)*u3%HSS_Spd ) * scaleFactor + u_out%HSS_Spd = u1%HSS_Spd + b + c * t_out + b = (t(3)**2*(u1%RotSpeed - u2%RotSpeed) + t(2)**2*(-u1%RotSpeed + u3%RotSpeed))* scaleFactor + c = ( (t(2)-t(3))*u1%RotSpeed + t(3)*u2%RotSpeed - t(2)*u3%RotSpeed ) * scaleFactor + u_out%RotSpeed = u1%RotSpeed + b + c * t_out + b = (t(3)**2*(u1%ExternalYawPosCom - u2%ExternalYawPosCom) + t(2)**2*(-u1%ExternalYawPosCom + u3%ExternalYawPosCom))* scaleFactor + c = ( (t(2)-t(3))*u1%ExternalYawPosCom + t(3)*u2%ExternalYawPosCom - t(2)*u3%ExternalYawPosCom ) * scaleFactor + u_out%ExternalYawPosCom = u1%ExternalYawPosCom + b + c * t_out + b = (t(3)**2*(u1%ExternalYawRateCom - u2%ExternalYawRateCom) + t(2)**2*(-u1%ExternalYawRateCom + u3%ExternalYawRateCom))* scaleFactor + c = ( (t(2)-t(3))*u1%ExternalYawRateCom + t(3)*u2%ExternalYawRateCom - t(2)*u3%ExternalYawRateCom ) * scaleFactor + u_out%ExternalYawRateCom = u1%ExternalYawRateCom + b + c * t_out IF (ALLOCATED(u_out%ExternalBlPitchCom) .AND. ALLOCATED(u1%ExternalBlPitchCom)) THEN - ALLOCATE(b1(SIZE(u_out%ExternalBlPitchCom,1))) - ALLOCATE(c1(SIZE(u_out%ExternalBlPitchCom,1))) - b1 = (t(3)**2*(u1%ExternalBlPitchCom - u2%ExternalBlPitchCom) + t(2)**2*(-u1%ExternalBlPitchCom + u3%ExternalBlPitchCom))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%ExternalBlPitchCom + t(3)*u2%ExternalBlPitchCom - t(2)*u3%ExternalBlPitchCom ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%ExternalBlPitchCom = u1%ExternalBlPitchCom + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%ExternalBlPitchCom,1),UBOUND(u_out%ExternalBlPitchCom,1) + b = (t(3)**2*(u1%ExternalBlPitchCom(i1) - u2%ExternalBlPitchCom(i1)) + t(2)**2*(-u1%ExternalBlPitchCom(i1) + u3%ExternalBlPitchCom(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%ExternalBlPitchCom(i1) + t(3)*u2%ExternalBlPitchCom(i1) - t(2)*u3%ExternalBlPitchCom(i1) ) * scaleFactor + u_out%ExternalBlPitchCom(i1) = u1%ExternalBlPitchCom(i1) + b + c * t_out + END DO END IF ! check if allocated - b0 = (t(3)**2*(u1%ExternalGenTrq - u2%ExternalGenTrq) + t(2)**2*(-u1%ExternalGenTrq + u3%ExternalGenTrq))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%ExternalGenTrq + t(3)*u2%ExternalGenTrq - t(2)*u3%ExternalGenTrq ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%ExternalGenTrq = u1%ExternalGenTrq + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%ExternalElecPwr - u2%ExternalElecPwr) + t(2)**2*(-u1%ExternalElecPwr + u3%ExternalElecPwr))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%ExternalElecPwr + t(3)*u2%ExternalElecPwr - t(2)*u3%ExternalElecPwr ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%ExternalElecPwr = u1%ExternalElecPwr + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%ExternalHSSBrFrac - u2%ExternalHSSBrFrac) + t(2)**2*(-u1%ExternalHSSBrFrac + u3%ExternalHSSBrFrac))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%ExternalHSSBrFrac + t(3)*u2%ExternalHSSBrFrac - t(2)*u3%ExternalHSSBrFrac ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%ExternalHSSBrFrac = u1%ExternalHSSBrFrac + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%TwrAccel - u2%TwrAccel) + t(2)**2*(-u1%TwrAccel + u3%TwrAccel))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%TwrAccel + t(3)*u2%TwrAccel - t(2)*u3%TwrAccel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TwrAccel = u1%TwrAccel + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%YawErr - u2%YawErr) + t(2)**2*(-u1%YawErr + u3%YawErr))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%YawErr + t(3)*u2%YawErr - t(2)*u3%YawErr ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%YawErr = u1%YawErr + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%WindDir - u2%WindDir) + t(2)**2*(-u1%WindDir + u3%WindDir))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%WindDir + t(3)*u2%WindDir - t(2)*u3%WindDir ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%WindDir = u1%WindDir + b0 * t_out + c0 * t_out**2 - ALLOCATE(b1(SIZE(u_out%RootMyc,1))) - ALLOCATE(c1(SIZE(u_out%RootMyc,1))) - b1 = (t(3)**2*(u1%RootMyc - u2%RootMyc) + t(2)**2*(-u1%RootMyc + u3%RootMyc))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%RootMyc + t(3)*u2%RootMyc - t(2)*u3%RootMyc ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%RootMyc = u1%RootMyc + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - b0 = (t(3)**2*(u1%YawBrTAxp - u2%YawBrTAxp) + t(2)**2*(-u1%YawBrTAxp + u3%YawBrTAxp))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%YawBrTAxp + t(3)*u2%YawBrTAxp - t(2)*u3%YawBrTAxp ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%YawBrTAxp = u1%YawBrTAxp + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%YawBrTAyp - u2%YawBrTAyp) + t(2)**2*(-u1%YawBrTAyp + u3%YawBrTAyp))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%YawBrTAyp + t(3)*u2%YawBrTAyp - t(2)*u3%YawBrTAyp ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%YawBrTAyp = u1%YawBrTAyp + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%LSSTipPxa - u2%LSSTipPxa) + t(2)**2*(-u1%LSSTipPxa + u3%LSSTipPxa))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%LSSTipPxa + t(3)*u2%LSSTipPxa - t(2)*u3%LSSTipPxa ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%LSSTipPxa = u1%LSSTipPxa + b0 * t_out + c0 * t_out**2 - ALLOCATE(b1(SIZE(u_out%RootMxc,1))) - ALLOCATE(c1(SIZE(u_out%RootMxc,1))) - b1 = (t(3)**2*(u1%RootMxc - u2%RootMxc) + t(2)**2*(-u1%RootMxc + u3%RootMxc))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%RootMxc + t(3)*u2%RootMxc - t(2)*u3%RootMxc ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%RootMxc = u1%RootMxc + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - b0 = (t(3)**2*(u1%LSSTipMxa - u2%LSSTipMxa) + t(2)**2*(-u1%LSSTipMxa + u3%LSSTipMxa))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%LSSTipMxa + t(3)*u2%LSSTipMxa - t(2)*u3%LSSTipMxa ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%LSSTipMxa = u1%LSSTipMxa + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%LSSTipMya - u2%LSSTipMya) + t(2)**2*(-u1%LSSTipMya + u3%LSSTipMya))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%LSSTipMya + t(3)*u2%LSSTipMya - t(2)*u3%LSSTipMya ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%LSSTipMya = u1%LSSTipMya + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%LSSTipMza - u2%LSSTipMza) + t(2)**2*(-u1%LSSTipMza + u3%LSSTipMza))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%LSSTipMza + t(3)*u2%LSSTipMza - t(2)*u3%LSSTipMza ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%LSSTipMza = u1%LSSTipMza + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%LSSTipMys - u2%LSSTipMys) + t(2)**2*(-u1%LSSTipMys + u3%LSSTipMys))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%LSSTipMys + t(3)*u2%LSSTipMys - t(2)*u3%LSSTipMys ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%LSSTipMys = u1%LSSTipMys + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%LSSTipMzs - u2%LSSTipMzs) + t(2)**2*(-u1%LSSTipMzs + u3%LSSTipMzs))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%LSSTipMzs + t(3)*u2%LSSTipMzs - t(2)*u3%LSSTipMzs ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%LSSTipMzs = u1%LSSTipMzs + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%YawBrMyn - u2%YawBrMyn) + t(2)**2*(-u1%YawBrMyn + u3%YawBrMyn))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%YawBrMyn + t(3)*u2%YawBrMyn - t(2)*u3%YawBrMyn ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%YawBrMyn = u1%YawBrMyn + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%YawBrMzn - u2%YawBrMzn) + t(2)**2*(-u1%YawBrMzn + u3%YawBrMzn))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%YawBrMzn + t(3)*u2%YawBrMzn - t(2)*u3%YawBrMzn ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%YawBrMzn = u1%YawBrMzn + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%NcIMURAxs - u2%NcIMURAxs) + t(2)**2*(-u1%NcIMURAxs + u3%NcIMURAxs))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%NcIMURAxs + t(3)*u2%NcIMURAxs - t(2)*u3%NcIMURAxs ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%NcIMURAxs = u1%NcIMURAxs + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%NcIMURAys - u2%NcIMURAys) + t(2)**2*(-u1%NcIMURAys + u3%NcIMURAys))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%NcIMURAys + t(3)*u2%NcIMURAys - t(2)*u3%NcIMURAys ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%NcIMURAys = u1%NcIMURAys + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%NcIMURAzs - u2%NcIMURAzs) + t(2)**2*(-u1%NcIMURAzs + u3%NcIMURAzs))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%NcIMURAzs + t(3)*u2%NcIMURAzs - t(2)*u3%NcIMURAzs ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%NcIMURAzs = u1%NcIMURAzs + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%RotPwr - u2%RotPwr) + t(2)**2*(-u1%RotPwr + u3%RotPwr))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%RotPwr + t(3)*u2%RotPwr - t(2)*u3%RotPwr ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%RotPwr = u1%RotPwr + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%HorWindV - u2%HorWindV) + t(2)**2*(-u1%HorWindV + u3%HorWindV))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%HorWindV + t(3)*u2%HorWindV - t(2)*u3%HorWindV ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%HorWindV = u1%HorWindV + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%YawAngle - u2%YawAngle) + t(2)**2*(-u1%YawAngle + u3%YawAngle))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%YawAngle + t(3)*u2%YawAngle - t(2)*u3%YawAngle ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%YawAngle = u1%YawAngle + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%ElecPwr_prev - u2%ElecPwr_prev) + t(2)**2*(-u1%ElecPwr_prev + u3%ElecPwr_prev))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%ElecPwr_prev + t(3)*u2%ElecPwr_prev - t(2)*u3%ElecPwr_prev ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%ElecPwr_prev = u1%ElecPwr_prev + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%GenTrq_prev - u2%GenTrq_prev) + t(2)**2*(-u1%GenTrq_prev + u3%GenTrq_prev))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%GenTrq_prev + t(3)*u2%GenTrq_prev - t(2)*u3%GenTrq_prev ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%GenTrq_prev = u1%GenTrq_prev + b0 * t_out + c0 * t_out**2 + b = (t(3)**2*(u1%ExternalGenTrq - u2%ExternalGenTrq) + t(2)**2*(-u1%ExternalGenTrq + u3%ExternalGenTrq))* scaleFactor + c = ( (t(2)-t(3))*u1%ExternalGenTrq + t(3)*u2%ExternalGenTrq - t(2)*u3%ExternalGenTrq ) * scaleFactor + u_out%ExternalGenTrq = u1%ExternalGenTrq + b + c * t_out + b = (t(3)**2*(u1%ExternalElecPwr - u2%ExternalElecPwr) + t(2)**2*(-u1%ExternalElecPwr + u3%ExternalElecPwr))* scaleFactor + c = ( (t(2)-t(3))*u1%ExternalElecPwr + t(3)*u2%ExternalElecPwr - t(2)*u3%ExternalElecPwr ) * scaleFactor + u_out%ExternalElecPwr = u1%ExternalElecPwr + b + c * t_out + b = (t(3)**2*(u1%ExternalHSSBrFrac - u2%ExternalHSSBrFrac) + t(2)**2*(-u1%ExternalHSSBrFrac + u3%ExternalHSSBrFrac))* scaleFactor + c = ( (t(2)-t(3))*u1%ExternalHSSBrFrac + t(3)*u2%ExternalHSSBrFrac - t(2)*u3%ExternalHSSBrFrac ) * scaleFactor + u_out%ExternalHSSBrFrac = u1%ExternalHSSBrFrac + b + c * t_out + b = (t(3)**2*(u1%TwrAccel - u2%TwrAccel) + t(2)**2*(-u1%TwrAccel + u3%TwrAccel))* scaleFactor + c = ( (t(2)-t(3))*u1%TwrAccel + t(3)*u2%TwrAccel - t(2)*u3%TwrAccel ) * scaleFactor + u_out%TwrAccel = u1%TwrAccel + b + c * t_out + b = (t(3)**2*(u1%YawErr - u2%YawErr) + t(2)**2*(-u1%YawErr + u3%YawErr))* scaleFactor + c = ( (t(2)-t(3))*u1%YawErr + t(3)*u2%YawErr - t(2)*u3%YawErr ) * scaleFactor + u_out%YawErr = u1%YawErr + b + c * t_out + b = (t(3)**2*(u1%WindDir - u2%WindDir) + t(2)**2*(-u1%WindDir + u3%WindDir))* scaleFactor + c = ( (t(2)-t(3))*u1%WindDir + t(3)*u2%WindDir - t(2)*u3%WindDir ) * scaleFactor + u_out%WindDir = u1%WindDir + b + c * t_out + DO i1 = LBOUND(u_out%RootMyc,1),UBOUND(u_out%RootMyc,1) + b = (t(3)**2*(u1%RootMyc(i1) - u2%RootMyc(i1)) + t(2)**2*(-u1%RootMyc(i1) + u3%RootMyc(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%RootMyc(i1) + t(3)*u2%RootMyc(i1) - t(2)*u3%RootMyc(i1) ) * scaleFactor + u_out%RootMyc(i1) = u1%RootMyc(i1) + b + c * t_out + END DO + b = (t(3)**2*(u1%YawBrTAxp - u2%YawBrTAxp) + t(2)**2*(-u1%YawBrTAxp + u3%YawBrTAxp))* scaleFactor + c = ( (t(2)-t(3))*u1%YawBrTAxp + t(3)*u2%YawBrTAxp - t(2)*u3%YawBrTAxp ) * scaleFactor + u_out%YawBrTAxp = u1%YawBrTAxp + b + c * t_out + b = (t(3)**2*(u1%YawBrTAyp - u2%YawBrTAyp) + t(2)**2*(-u1%YawBrTAyp + u3%YawBrTAyp))* scaleFactor + c = ( (t(2)-t(3))*u1%YawBrTAyp + t(3)*u2%YawBrTAyp - t(2)*u3%YawBrTAyp ) * scaleFactor + u_out%YawBrTAyp = u1%YawBrTAyp + b + c * t_out + b = (t(3)**2*(u1%LSSTipPxa - u2%LSSTipPxa) + t(2)**2*(-u1%LSSTipPxa + u3%LSSTipPxa))* scaleFactor + c = ( (t(2)-t(3))*u1%LSSTipPxa + t(3)*u2%LSSTipPxa - t(2)*u3%LSSTipPxa ) * scaleFactor + u_out%LSSTipPxa = u1%LSSTipPxa + b + c * t_out + DO i1 = LBOUND(u_out%RootMxc,1),UBOUND(u_out%RootMxc,1) + b = (t(3)**2*(u1%RootMxc(i1) - u2%RootMxc(i1)) + t(2)**2*(-u1%RootMxc(i1) + u3%RootMxc(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%RootMxc(i1) + t(3)*u2%RootMxc(i1) - t(2)*u3%RootMxc(i1) ) * scaleFactor + u_out%RootMxc(i1) = u1%RootMxc(i1) + b + c * t_out + END DO + b = (t(3)**2*(u1%LSSTipMxa - u2%LSSTipMxa) + t(2)**2*(-u1%LSSTipMxa + u3%LSSTipMxa))* scaleFactor + c = ( (t(2)-t(3))*u1%LSSTipMxa + t(3)*u2%LSSTipMxa - t(2)*u3%LSSTipMxa ) * scaleFactor + u_out%LSSTipMxa = u1%LSSTipMxa + b + c * t_out + b = (t(3)**2*(u1%LSSTipMya - u2%LSSTipMya) + t(2)**2*(-u1%LSSTipMya + u3%LSSTipMya))* scaleFactor + c = ( (t(2)-t(3))*u1%LSSTipMya + t(3)*u2%LSSTipMya - t(2)*u3%LSSTipMya ) * scaleFactor + u_out%LSSTipMya = u1%LSSTipMya + b + c * t_out + b = (t(3)**2*(u1%LSSTipMza - u2%LSSTipMza) + t(2)**2*(-u1%LSSTipMza + u3%LSSTipMza))* scaleFactor + c = ( (t(2)-t(3))*u1%LSSTipMza + t(3)*u2%LSSTipMza - t(2)*u3%LSSTipMza ) * scaleFactor + u_out%LSSTipMza = u1%LSSTipMza + b + c * t_out + b = (t(3)**2*(u1%LSSTipMys - u2%LSSTipMys) + t(2)**2*(-u1%LSSTipMys + u3%LSSTipMys))* scaleFactor + c = ( (t(2)-t(3))*u1%LSSTipMys + t(3)*u2%LSSTipMys - t(2)*u3%LSSTipMys ) * scaleFactor + u_out%LSSTipMys = u1%LSSTipMys + b + c * t_out + b = (t(3)**2*(u1%LSSTipMzs - u2%LSSTipMzs) + t(2)**2*(-u1%LSSTipMzs + u3%LSSTipMzs))* scaleFactor + c = ( (t(2)-t(3))*u1%LSSTipMzs + t(3)*u2%LSSTipMzs - t(2)*u3%LSSTipMzs ) * scaleFactor + u_out%LSSTipMzs = u1%LSSTipMzs + b + c * t_out + b = (t(3)**2*(u1%YawBrMyn - u2%YawBrMyn) + t(2)**2*(-u1%YawBrMyn + u3%YawBrMyn))* scaleFactor + c = ( (t(2)-t(3))*u1%YawBrMyn + t(3)*u2%YawBrMyn - t(2)*u3%YawBrMyn ) * scaleFactor + u_out%YawBrMyn = u1%YawBrMyn + b + c * t_out + b = (t(3)**2*(u1%YawBrMzn - u2%YawBrMzn) + t(2)**2*(-u1%YawBrMzn + u3%YawBrMzn))* scaleFactor + c = ( (t(2)-t(3))*u1%YawBrMzn + t(3)*u2%YawBrMzn - t(2)*u3%YawBrMzn ) * scaleFactor + u_out%YawBrMzn = u1%YawBrMzn + b + c * t_out + b = (t(3)**2*(u1%NcIMURAxs - u2%NcIMURAxs) + t(2)**2*(-u1%NcIMURAxs + u3%NcIMURAxs))* scaleFactor + c = ( (t(2)-t(3))*u1%NcIMURAxs + t(3)*u2%NcIMURAxs - t(2)*u3%NcIMURAxs ) * scaleFactor + u_out%NcIMURAxs = u1%NcIMURAxs + b + c * t_out + b = (t(3)**2*(u1%NcIMURAys - u2%NcIMURAys) + t(2)**2*(-u1%NcIMURAys + u3%NcIMURAys))* scaleFactor + c = ( (t(2)-t(3))*u1%NcIMURAys + t(3)*u2%NcIMURAys - t(2)*u3%NcIMURAys ) * scaleFactor + u_out%NcIMURAys = u1%NcIMURAys + b + c * t_out + b = (t(3)**2*(u1%NcIMURAzs - u2%NcIMURAzs) + t(2)**2*(-u1%NcIMURAzs + u3%NcIMURAzs))* scaleFactor + c = ( (t(2)-t(3))*u1%NcIMURAzs + t(3)*u2%NcIMURAzs - t(2)*u3%NcIMURAzs ) * scaleFactor + u_out%NcIMURAzs = u1%NcIMURAzs + b + c * t_out + b = (t(3)**2*(u1%RotPwr - u2%RotPwr) + t(2)**2*(-u1%RotPwr + u3%RotPwr))* scaleFactor + c = ( (t(2)-t(3))*u1%RotPwr + t(3)*u2%RotPwr - t(2)*u3%RotPwr ) * scaleFactor + u_out%RotPwr = u1%RotPwr + b + c * t_out + b = (t(3)**2*(u1%HorWindV - u2%HorWindV) + t(2)**2*(-u1%HorWindV + u3%HorWindV))* scaleFactor + c = ( (t(2)-t(3))*u1%HorWindV + t(3)*u2%HorWindV - t(2)*u3%HorWindV ) * scaleFactor + u_out%HorWindV = u1%HorWindV + b + c * t_out + b = (t(3)**2*(u1%YawAngle - u2%YawAngle) + t(2)**2*(-u1%YawAngle + u3%YawAngle))* scaleFactor + c = ( (t(2)-t(3))*u1%YawAngle + t(3)*u2%YawAngle - t(2)*u3%YawAngle ) * scaleFactor + u_out%YawAngle = u1%YawAngle + b + c * t_out + b = (t(3)**2*(u1%ElecPwr_prev - u2%ElecPwr_prev) + t(2)**2*(-u1%ElecPwr_prev + u3%ElecPwr_prev))* scaleFactor + c = ( (t(2)-t(3))*u1%ElecPwr_prev + t(3)*u2%ElecPwr_prev - t(2)*u3%ElecPwr_prev ) * scaleFactor + u_out%ElecPwr_prev = u1%ElecPwr_prev + b + c * t_out + b = (t(3)**2*(u1%GenTrq_prev - u2%GenTrq_prev) + t(2)**2*(-u1%GenTrq_prev + u3%GenTrq_prev))* scaleFactor + c = ( (t(2)-t(3))*u1%GenTrq_prev + t(3)*u2%GenTrq_prev - t(2)*u3%GenTrq_prev ) * scaleFactor + u_out%GenTrq_prev = u1%GenTrq_prev + b + c * t_out CALL TMD_Input_ExtrapInterp2( u1%NTMD, u2%NTMD, u3%NTMD, tin, u_out%NTMD, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL TMD_Input_ExtrapInterp2( u1%TTMD, u2%TTMD, u3%TTMD, tin, u_out%TTMD, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(u_out%SuperController) .AND. ALLOCATED(u1%SuperController)) THEN - ALLOCATE(b1(SIZE(u_out%SuperController,1))) - ALLOCATE(c1(SIZE(u_out%SuperController,1))) - b1 = (t(3)**2*(u1%SuperController - u2%SuperController) + t(2)**2*(-u1%SuperController + u3%SuperController))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%SuperController + t(3)*u2%SuperController - t(2)*u3%SuperController ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%SuperController = u1%SuperController + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%SuperController,1),UBOUND(u_out%SuperController,1) + b = (t(3)**2*(u1%SuperController(i1) - u2%SuperController(i1)) + t(2)**2*(-u1%SuperController(i1) + u3%SuperController(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%SuperController(i1) + t(3)*u2%SuperController(i1) - t(2)*u3%SuperController(i1) ) * scaleFactor + u_out%SuperController(i1) = u1%SuperController(i1) + b + c * t_out + END DO END IF ! check if allocated END SUBROUTINE SrvD_Input_ExtrapInterp2 @@ -7589,12 +7353,12 @@ SUBROUTINE SrvD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! 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 :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -7607,49 +7371,43 @@ SUBROUTINE SrvD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ALLOCATED(y_out%BlPitchCom) .AND. ALLOCATED(y1%BlPitchCom)) THEN - ALLOCATE(b1(SIZE(y_out%BlPitchCom,1))) - ALLOCATE(c1(SIZE(y_out%BlPitchCom,1))) - b1 = -(y1%BlPitchCom - y2%BlPitchCom)/t(2) - y_out%BlPitchCom = y1%BlPitchCom + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%BlPitchCom,1),UBOUND(y_out%BlPitchCom,1) + b = -(y1%BlPitchCom(i1) - y2%BlPitchCom(i1)) + y_out%BlPitchCom(i1) = y1%BlPitchCom(i1) + b * ScaleFactor + END DO END IF ! check if allocated - b0 = -(y1%YawMom - y2%YawMom)/t(2) - y_out%YawMom = y1%YawMom + b0 * t_out - b0 = -(y1%GenTrq - y2%GenTrq)/t(2) - y_out%GenTrq = y1%GenTrq + b0 * t_out - b0 = -(y1%HSSBrTrqC - y2%HSSBrTrqC)/t(2) - y_out%HSSBrTrqC = y1%HSSBrTrqC + b0 * t_out - b0 = -(y1%ElecPwr - y2%ElecPwr)/t(2) - y_out%ElecPwr = y1%ElecPwr + b0 * t_out + b = -(y1%YawMom - y2%YawMom) + y_out%YawMom = y1%YawMom + b * ScaleFactor + b = -(y1%GenTrq - y2%GenTrq) + y_out%GenTrq = y1%GenTrq + b * ScaleFactor + b = -(y1%HSSBrTrqC - y2%HSSBrTrqC) + y_out%HSSBrTrqC = y1%HSSBrTrqC + b * ScaleFactor + b = -(y1%ElecPwr - y2%ElecPwr) + y_out%ElecPwr = y1%ElecPwr + b * ScaleFactor IF (ALLOCATED(y_out%TBDrCon) .AND. ALLOCATED(y1%TBDrCon)) THEN - ALLOCATE(b1(SIZE(y_out%TBDrCon,1))) - ALLOCATE(c1(SIZE(y_out%TBDrCon,1))) - b1 = -(y1%TBDrCon - y2%TBDrCon)/t(2) - y_out%TBDrCon = y1%TBDrCon + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%TBDrCon,1),UBOUND(y_out%TBDrCon,1) + b = -(y1%TBDrCon(i1) - y2%TBDrCon(i1)) + y_out%TBDrCon(i1) = y1%TBDrCon(i1) + b * ScaleFactor + END DO END IF ! check if allocated CALL TMD_Output_ExtrapInterp1( y1%NTMD, y2%NTMD, tin, y_out%NTMD, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL TMD_Output_ExtrapInterp1( y1%TTMD, y2%TTMD, tin, y_out%TTMD, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%SuperController) .AND. ALLOCATED(y1%SuperController)) THEN - ALLOCATE(b1(SIZE(y_out%SuperController,1))) - ALLOCATE(c1(SIZE(y_out%SuperController,1))) - b1 = -(y1%SuperController - y2%SuperController)/t(2) - y_out%SuperController = y1%SuperController + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%SuperController,1),UBOUND(y_out%SuperController,1) + b = -(y1%SuperController(i1) - y2%SuperController(i1)) + y_out%SuperController(i1) = y1%SuperController(i1) + b * ScaleFactor + END DO END IF ! check if allocated END SUBROUTINE SrvD_Output_ExtrapInterp1 @@ -7680,13 +7438,14 @@ SUBROUTINE SrvD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -7705,57 +7464,51 @@ SUBROUTINE SrvD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ALLOCATED(y_out%BlPitchCom) .AND. ALLOCATED(y1%BlPitchCom)) THEN - ALLOCATE(b1(SIZE(y_out%BlPitchCom,1))) - ALLOCATE(c1(SIZE(y_out%BlPitchCom,1))) - b1 = (t(3)**2*(y1%BlPitchCom - y2%BlPitchCom) + t(2)**2*(-y1%BlPitchCom + y3%BlPitchCom))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%BlPitchCom + t(3)*y2%BlPitchCom - t(2)*y3%BlPitchCom ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%BlPitchCom = y1%BlPitchCom + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%BlPitchCom,1),UBOUND(y_out%BlPitchCom,1) + b = (t(3)**2*(y1%BlPitchCom(i1) - y2%BlPitchCom(i1)) + t(2)**2*(-y1%BlPitchCom(i1) + y3%BlPitchCom(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%BlPitchCom(i1) + t(3)*y2%BlPitchCom(i1) - t(2)*y3%BlPitchCom(i1) ) * scaleFactor + y_out%BlPitchCom(i1) = y1%BlPitchCom(i1) + b + c * t_out + END DO END IF ! check if allocated - b0 = (t(3)**2*(y1%YawMom - y2%YawMom) + t(2)**2*(-y1%YawMom + y3%YawMom))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%YawMom + t(3)*y2%YawMom - t(2)*y3%YawMom ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%YawMom = y1%YawMom + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%GenTrq - y2%GenTrq) + t(2)**2*(-y1%GenTrq + y3%GenTrq))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%GenTrq + t(3)*y2%GenTrq - t(2)*y3%GenTrq ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%GenTrq = y1%GenTrq + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%HSSBrTrqC - y2%HSSBrTrqC) + t(2)**2*(-y1%HSSBrTrqC + y3%HSSBrTrqC))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%HSSBrTrqC + t(3)*y2%HSSBrTrqC - t(2)*y3%HSSBrTrqC ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%HSSBrTrqC = y1%HSSBrTrqC + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%ElecPwr - y2%ElecPwr) + t(2)**2*(-y1%ElecPwr + y3%ElecPwr))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%ElecPwr + t(3)*y2%ElecPwr - t(2)*y3%ElecPwr ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%ElecPwr = y1%ElecPwr + b0 * t_out + c0 * t_out**2 + b = (t(3)**2*(y1%YawMom - y2%YawMom) + t(2)**2*(-y1%YawMom + y3%YawMom))* scaleFactor + c = ( (t(2)-t(3))*y1%YawMom + t(3)*y2%YawMom - t(2)*y3%YawMom ) * scaleFactor + y_out%YawMom = y1%YawMom + b + c * t_out + b = (t(3)**2*(y1%GenTrq - y2%GenTrq) + t(2)**2*(-y1%GenTrq + y3%GenTrq))* scaleFactor + c = ( (t(2)-t(3))*y1%GenTrq + t(3)*y2%GenTrq - t(2)*y3%GenTrq ) * scaleFactor + y_out%GenTrq = y1%GenTrq + b + c * t_out + b = (t(3)**2*(y1%HSSBrTrqC - y2%HSSBrTrqC) + t(2)**2*(-y1%HSSBrTrqC + y3%HSSBrTrqC))* scaleFactor + c = ( (t(2)-t(3))*y1%HSSBrTrqC + t(3)*y2%HSSBrTrqC - t(2)*y3%HSSBrTrqC ) * scaleFactor + y_out%HSSBrTrqC = y1%HSSBrTrqC + b + c * t_out + b = (t(3)**2*(y1%ElecPwr - y2%ElecPwr) + t(2)**2*(-y1%ElecPwr + y3%ElecPwr))* scaleFactor + c = ( (t(2)-t(3))*y1%ElecPwr + t(3)*y2%ElecPwr - t(2)*y3%ElecPwr ) * scaleFactor + y_out%ElecPwr = y1%ElecPwr + b + c * t_out IF (ALLOCATED(y_out%TBDrCon) .AND. ALLOCATED(y1%TBDrCon)) THEN - ALLOCATE(b1(SIZE(y_out%TBDrCon,1))) - ALLOCATE(c1(SIZE(y_out%TBDrCon,1))) - b1 = (t(3)**2*(y1%TBDrCon - y2%TBDrCon) + t(2)**2*(-y1%TBDrCon + y3%TBDrCon))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%TBDrCon + t(3)*y2%TBDrCon - t(2)*y3%TBDrCon ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%TBDrCon = y1%TBDrCon + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%TBDrCon,1),UBOUND(y_out%TBDrCon,1) + b = (t(3)**2*(y1%TBDrCon(i1) - y2%TBDrCon(i1)) + t(2)**2*(-y1%TBDrCon(i1) + y3%TBDrCon(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%TBDrCon(i1) + t(3)*y2%TBDrCon(i1) - t(2)*y3%TBDrCon(i1) ) * scaleFactor + y_out%TBDrCon(i1) = y1%TBDrCon(i1) + b + c * t_out + END DO END IF ! check if allocated CALL TMD_Output_ExtrapInterp2( y1%NTMD, y2%NTMD, y3%NTMD, tin, y_out%NTMD, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL TMD_Output_ExtrapInterp2( y1%TTMD, y2%TTMD, y3%TTMD, tin, y_out%TTMD, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%SuperController) .AND. ALLOCATED(y1%SuperController)) THEN - ALLOCATE(b1(SIZE(y_out%SuperController,1))) - ALLOCATE(c1(SIZE(y_out%SuperController,1))) - b1 = (t(3)**2*(y1%SuperController - y2%SuperController) + t(2)**2*(-y1%SuperController + y3%SuperController))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%SuperController + t(3)*y2%SuperController - t(2)*y3%SuperController ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%SuperController = y1%SuperController + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%SuperController,1),UBOUND(y_out%SuperController,1) + b = (t(3)**2*(y1%SuperController(i1) - y2%SuperController(i1)) + t(2)**2*(-y1%SuperController(i1) + y3%SuperController(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%SuperController(i1) + t(3)*y2%SuperController(i1) - t(2)*y3%SuperController(i1) ) * scaleFactor + y_out%SuperController(i1) = y1%SuperController(i1) + b + c * t_out + END DO END IF ! check if allocated END SUBROUTINE SrvD_Output_ExtrapInterp2 diff --git a/modules/servodyn/src/TMD_Types.f90 b/modules/servodyn/src/TMD_Types.f90 index a76b12542c..c0ba34ab4c 100644 --- a/modules/servodyn/src/TMD_Types.f90 +++ b/modules/servodyn/src/TMD_Types.f90 @@ -344,78 +344,78 @@ SUBROUTINE TMD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%TMDFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%TMDFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TMD_CMODE - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TMD_SA_MODE - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TMD_DOF_MODE - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TMD_X_DOF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TMD_Y_DOF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_X_DSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_Y_DSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_X_M - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_Y_M - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_XY_M - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_X_K - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_Y_K - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_X_C - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_Y_C - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_X_DWSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_X_UWSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_X_KS - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_X_CS - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_Y_PLSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_Y_NLSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_Y_KS - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_Y_CS - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_P_X - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_P_Y - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_P_Z - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_X_C_HIGH - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_X_C_LOW - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_Y_C_HIGH - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_Y_C_LOW - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_X_C_BRAKE - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_Y_C_BRAKE - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%USE_F_TBL , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%TMD_F_TBL_FILE) - IntKiBuf(Int_Xferred) = ICHAR(InData%TMD_F_TBL_FILE(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(InData%TMDFileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%TMDFileName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%TMD_CMODE + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TMD_SA_MODE + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TMD_DOF_MODE + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TMD_X_DOF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TMD_Y_DOF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_X_DSP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_Y_DSP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_X_M + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_Y_M + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_XY_M + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_X_K + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_Y_K + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_X_C + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_Y_C + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_X_DWSP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_X_UWSP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_X_KS + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_X_CS + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_Y_PLSP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_Y_NLSP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_Y_KS + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_Y_CS + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_P_X + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_P_Y + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_P_Z + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_X_C_HIGH + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_X_C_LOW + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_Y_C_HIGH + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_Y_C_LOW + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_X_C_BRAKE + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_Y_C_BRAKE + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%USE_F_TBL, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%TMD_F_TBL_FILE) + IntKiBuf(Int_Xferred) = ICHAR(InData%TMD_F_TBL_FILE(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( .NOT. ALLOCATED(InData%F_TBL) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -429,8 +429,12 @@ SUBROUTINE TMD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_TBL,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%F_TBL)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_TBL))-1 ) = PACK(InData%F_TBL,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_TBL) + DO i2 = LBOUND(InData%F_TBL,2), UBOUND(InData%F_TBL,2) + DO i1 = LBOUND(InData%F_TBL,1), UBOUND(InData%F_TBL,1) + ReKiBuf(Re_Xferred) = InData%F_TBL(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE TMD_PackInputFile @@ -447,12 +451,6 @@ SUBROUTINE TMD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -468,78 +466,78 @@ SUBROUTINE TMD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%TMDFileName) - OutData%TMDFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%TMD_CMODE = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TMD_SA_MODE = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TMD_DOF_MODE = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TMD_X_DOF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%TMD_Y_DOF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%TMD_X_DSP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_Y_DSP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_X_M = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_Y_M = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_XY_M = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_X_K = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_Y_K = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_X_C = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_Y_C = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_X_DWSP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_X_UWSP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_X_KS = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_X_CS = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_Y_PLSP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_Y_NLSP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_Y_KS = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_Y_CS = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_P_X = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_P_Y = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_P_Z = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_X_C_HIGH = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_X_C_LOW = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_Y_C_HIGH = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_Y_C_LOW = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_X_C_BRAKE = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_Y_C_BRAKE = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%USE_F_TBL = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%TMD_F_TBL_FILE) - OutData%TMD_F_TBL_FILE(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%TMDFileName) + OutData%TMDFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%TMD_CMODE = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TMD_SA_MODE = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TMD_DOF_MODE = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TMD_X_DOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%TMD_X_DOF) + Int_Xferred = Int_Xferred + 1 + OutData%TMD_Y_DOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%TMD_Y_DOF) + Int_Xferred = Int_Xferred + 1 + OutData%TMD_X_DSP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_Y_DSP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_X_M = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_Y_M = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_XY_M = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_X_K = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_Y_K = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_X_C = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_Y_C = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_X_DWSP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_X_UWSP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_X_KS = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_X_CS = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_Y_PLSP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_Y_NLSP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_Y_KS = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_Y_CS = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_P_X = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_P_Y = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_P_Z = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_X_C_HIGH = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_X_C_LOW = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_Y_C_HIGH = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_Y_C_LOW = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_X_C_BRAKE = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_Y_C_BRAKE = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%USE_F_TBL = TRANSFER(IntKiBuf(Int_Xferred), OutData%USE_F_TBL) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%TMD_F_TBL_FILE) + OutData%TMD_F_TBL_FILE(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_TBL not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -556,15 +554,12 @@ SUBROUTINE TMD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_TBL.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%F_TBL)>0) OutData%F_TBL = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_TBL))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_TBL) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%F_TBL,2), UBOUND(OutData%F_TBL,2) + DO i1 = LBOUND(OutData%F_TBL,1), UBOUND(OutData%F_TBL,1) + OutData%F_TBL(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE TMD_UnPackInputFile @@ -666,18 +661,20 @@ SUBROUTINE TMD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%r_N_O_G))-1 ) = PACK(InData%r_N_O_G,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%r_N_O_G) + DO I = 1, LEN(InData%InputFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + ReKiBuf(Re_Xferred) = InData%Gravity + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%r_N_O_G,1), UBOUND(InData%r_N_O_G,1) + ReKiBuf(Re_Xferred) = InData%r_N_O_G(i1) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE TMD_PackInitInput SUBROUTINE TMD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -693,12 +690,6 @@ SUBROUTINE TMD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -713,27 +704,22 @@ SUBROUTINE TMD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%Gravity = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(OutData%InputFile) + OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%Gravity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%r_N_O_G,1) i1_u = UBOUND(OutData%r_N_O_G,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%r_N_O_G = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%r_N_O_G))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%r_N_O_G) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%r_N_O_G,1), UBOUND(OutData%r_N_O_G,1) + OutData%r_N_O_G(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE TMD_UnPackInitInput SUBROUTINE TMD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -827,8 +813,8 @@ SUBROUTINE TMD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyInitOut - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyInitOut + Re_Xferred = Re_Xferred + 1 END SUBROUTINE TMD_PackInitOutput SUBROUTINE TMD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -844,12 +830,6 @@ SUBROUTINE TMD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'TMD_UnPackInitOutput' @@ -863,8 +843,8 @@ SUBROUTINE TMD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyInitOut = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyInitOut = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE TMD_UnPackInitOutput SUBROUTINE TMD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) @@ -961,10 +941,12 @@ SUBROUTINE TMD_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyContState - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%tmd_x))-1 ) = PACK(InData%tmd_x,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%tmd_x) + ReKiBuf(Re_Xferred) = InData%DummyContState + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%tmd_x,1), UBOUND(InData%tmd_x,1) + ReKiBuf(Re_Xferred) = InData%tmd_x(i1) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE TMD_PackContState SUBROUTINE TMD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -980,12 +962,6 @@ SUBROUTINE TMD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1000,19 +976,14 @@ SUBROUTINE TMD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyContState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyContState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%tmd_x,1) i1_u = UBOUND(OutData%tmd_x,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%tmd_x = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%tmd_x))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%tmd_x) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%tmd_x,1), UBOUND(OutData%tmd_x,1) + OutData%tmd_x(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE TMD_UnPackContState SUBROUTINE TMD_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) @@ -1106,8 +1077,8 @@ SUBROUTINE TMD_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyDiscState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE TMD_PackDiscState SUBROUTINE TMD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1123,12 +1094,6 @@ SUBROUTINE TMD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'TMD_UnPackDiscState' @@ -1142,8 +1107,8 @@ SUBROUTINE TMD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyDiscState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyDiscState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE TMD_UnPackDiscState SUBROUTINE TMD_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -1237,8 +1202,8 @@ SUBROUTINE TMD_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyConstrState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE TMD_PackConstrState SUBROUTINE TMD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1254,12 +1219,6 @@ SUBROUTINE TMD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'TMD_UnPackConstrState' @@ -1273,8 +1232,8 @@ SUBROUTINE TMD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyConstrState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyConstrState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE TMD_UnPackConstrState SUBROUTINE TMD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -1368,8 +1327,8 @@ SUBROUTINE TMD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyOtherState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyOtherState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE TMD_PackOtherState SUBROUTINE TMD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1385,12 +1344,6 @@ SUBROUTINE TMD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'TMD_UnPackOtherState' @@ -1404,8 +1357,8 @@ SUBROUTINE TMD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyOtherState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyOtherState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE TMD_UnPackOtherState SUBROUTINE TMD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -1514,22 +1467,34 @@ SUBROUTINE TMD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_stop))-1 ) = PACK(InData%F_stop,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_stop) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_ext))-1 ) = PACK(InData%F_ext,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_ext) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_fr))-1 ) = PACK(InData%F_fr,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_fr) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%C_ctrl))-1 ) = PACK(InData%C_ctrl,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%C_ctrl) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%C_Brake))-1 ) = PACK(InData%C_Brake,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%C_Brake) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_table))-1 ) = PACK(InData%F_table,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_table) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%F_k_x - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%F_k_y - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%F_stop,1), UBOUND(InData%F_stop,1) + ReKiBuf(Re_Xferred) = InData%F_stop(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%F_ext,1), UBOUND(InData%F_ext,1) + ReKiBuf(Re_Xferred) = InData%F_ext(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%F_fr,1), UBOUND(InData%F_fr,1) + ReKiBuf(Re_Xferred) = InData%F_fr(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%C_ctrl,1), UBOUND(InData%C_ctrl,1) + ReKiBuf(Re_Xferred) = InData%C_ctrl(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%C_Brake,1), UBOUND(InData%C_Brake,1) + ReKiBuf(Re_Xferred) = InData%C_Brake(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%F_table,1), UBOUND(InData%F_table,1) + ReKiBuf(Re_Xferred) = InData%F_table(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%F_k_x + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%F_k_y + Re_Xferred = Re_Xferred + 1 END SUBROUTINE TMD_PackMisc SUBROUTINE TMD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1545,12 +1510,6 @@ SUBROUTINE TMD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1567,74 +1526,44 @@ SUBROUTINE TMD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Xferred = 1 i1_l = LBOUND(OutData%F_stop,1) i1_u = UBOUND(OutData%F_stop,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%F_stop = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_stop))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_stop) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%F_stop,1), UBOUND(OutData%F_stop,1) + OutData%F_stop(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%F_ext,1) i1_u = UBOUND(OutData%F_ext,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%F_ext = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_ext))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_ext) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%F_ext,1), UBOUND(OutData%F_ext,1) + OutData%F_ext(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%F_fr,1) i1_u = UBOUND(OutData%F_fr,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%F_fr = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_fr))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_fr) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%F_fr,1), UBOUND(OutData%F_fr,1) + OutData%F_fr(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%C_ctrl,1) i1_u = UBOUND(OutData%C_ctrl,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%C_ctrl = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%C_ctrl))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%C_ctrl) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%C_ctrl,1), UBOUND(OutData%C_ctrl,1) + OutData%C_ctrl(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%C_Brake,1) i1_u = UBOUND(OutData%C_Brake,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%C_Brake = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%C_Brake))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%C_Brake) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%C_Brake,1), UBOUND(OutData%C_Brake,1) + OutData%C_Brake(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%F_table,1) i1_u = UBOUND(OutData%F_table,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%F_table = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_table))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_table) - DEALLOCATE(mask1) - OutData%F_k_x = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%F_k_y = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%F_table,1), UBOUND(OutData%F_table,1) + OutData%F_table(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%F_k_x = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%F_k_y = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE TMD_UnPackMisc SUBROUTINE TMD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -1808,66 +1737,76 @@ SUBROUTINE TMD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TMD_DOF_MODE - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TMD_X_DOF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TMD_Y_DOF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%X_DSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Y_DSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%M_X - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%M_Y - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%M_XY - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%K_X - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%K_Y - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%C_X - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%C_Y - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%K_S))-1 ) = PACK(InData%K_S,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%K_S) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%C_S))-1 ) = PACK(InData%C_S,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%C_S) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%P_SP))-1 ) = PACK(InData%P_SP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%P_SP) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%N_SP))-1 ) = PACK(InData%N_SP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%N_SP) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_ext))-1 ) = PACK(InData%F_ext,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_ext) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TMD_CMODE - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TMD_SA_MODE - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_X_C_HIGH - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_X_C_LOW - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_Y_C_HIGH - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_Y_C_LOW - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_X_C_BRAKE - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_Y_C_BRAKE - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Use_F_TBL , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%TMD_DOF_MODE + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TMD_X_DOF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TMD_Y_DOF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%X_DSP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Y_DSP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%M_X + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%M_Y + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%M_XY + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%K_X + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%K_Y + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%C_X + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%C_Y + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%K_S,1), UBOUND(InData%K_S,1) + ReKiBuf(Re_Xferred) = InData%K_S(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%C_S,1), UBOUND(InData%C_S,1) + ReKiBuf(Re_Xferred) = InData%C_S(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%P_SP,1), UBOUND(InData%P_SP,1) + ReKiBuf(Re_Xferred) = InData%P_SP(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%N_SP,1), UBOUND(InData%N_SP,1) + ReKiBuf(Re_Xferred) = InData%N_SP(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%F_ext,1), UBOUND(InData%F_ext,1) + ReKiBuf(Re_Xferred) = InData%F_ext(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%Gravity + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TMD_CMODE + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TMD_SA_MODE + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_X_C_HIGH + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_X_C_LOW + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_Y_C_HIGH + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_Y_C_LOW + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_X_C_BRAKE + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_Y_C_BRAKE + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%Use_F_TBL, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%F_TBL) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1881,8 +1820,12 @@ SUBROUTINE TMD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_TBL,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%F_TBL)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_TBL))-1 ) = PACK(InData%F_TBL,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_TBL) + DO i2 = LBOUND(InData%F_TBL,2), UBOUND(InData%F_TBL,2) + DO i1 = LBOUND(InData%F_TBL,1), UBOUND(InData%F_TBL,1) + ReKiBuf(Re_Xferred) = InData%F_TBL(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE TMD_PackParam @@ -1899,12 +1842,6 @@ SUBROUTINE TMD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -1920,111 +1857,86 @@ SUBROUTINE TMD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%TMD_DOF_MODE = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TMD_X_DOF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%TMD_Y_DOF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%X_DSP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Y_DSP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%M_X = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%M_Y = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%M_XY = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%K_X = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%K_Y = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%C_X = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%C_Y = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%TMD_DOF_MODE = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TMD_X_DOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%TMD_X_DOF) + Int_Xferred = Int_Xferred + 1 + OutData%TMD_Y_DOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%TMD_Y_DOF) + Int_Xferred = Int_Xferred + 1 + OutData%X_DSP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Y_DSP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%M_X = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%M_Y = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%M_XY = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%K_X = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%K_Y = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%C_X = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%C_Y = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%K_S,1) i1_u = UBOUND(OutData%K_S,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%K_S = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%K_S))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%K_S) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%K_S,1), UBOUND(OutData%K_S,1) + OutData%K_S(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%C_S,1) i1_u = UBOUND(OutData%C_S,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%C_S = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%C_S))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%C_S) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%C_S,1), UBOUND(OutData%C_S,1) + OutData%C_S(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%P_SP,1) i1_u = UBOUND(OutData%P_SP,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%P_SP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%P_SP))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%P_SP) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%P_SP,1), UBOUND(OutData%P_SP,1) + OutData%P_SP(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%N_SP,1) i1_u = UBOUND(OutData%N_SP,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%N_SP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%N_SP))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%N_SP) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%N_SP,1), UBOUND(OutData%N_SP,1) + OutData%N_SP(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%F_ext,1) i1_u = UBOUND(OutData%F_ext,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%F_ext = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_ext))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_ext) - DEALLOCATE(mask1) - OutData%Gravity = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_CMODE = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TMD_SA_MODE = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TMD_X_C_HIGH = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_X_C_LOW = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_Y_C_HIGH = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_Y_C_LOW = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_X_C_BRAKE = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_Y_C_BRAKE = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Use_F_TBL = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%F_ext,1), UBOUND(OutData%F_ext,1) + OutData%F_ext(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%Gravity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_CMODE = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TMD_SA_MODE = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TMD_X_C_HIGH = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_X_C_LOW = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_Y_C_HIGH = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_Y_C_LOW = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_X_C_BRAKE = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_Y_C_BRAKE = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Use_F_TBL = TRANSFER(IntKiBuf(Int_Xferred), OutData%Use_F_TBL) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_TBL not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2041,15 +1953,12 @@ SUBROUTINE TMD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_TBL.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%F_TBL)>0) OutData%F_TBL = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_TBL))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_TBL) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%F_TBL,2), UBOUND(OutData%F_TBL,2) + DO i1 = LBOUND(OutData%F_TBL,1), UBOUND(OutData%F_TBL,1) + OutData%F_TBL(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE TMD_UnPackParam @@ -2207,12 +2116,6 @@ SUBROUTINE TMD_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'TMD_UnPackInput' @@ -2422,12 +2325,6 @@ SUBROUTINE TMD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'TMD_UnPackOutput' @@ -2558,8 +2455,8 @@ SUBROUTINE TMD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'TMD_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -2574,6 +2471,8 @@ SUBROUTINE TMD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(u1%Mesh, u2%Mesh, tin, u_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE TMD_Input_ExtrapInterp1 @@ -2605,8 +2504,9 @@ SUBROUTINE TMD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Err REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'TMD_Input_ExtrapInterp2' @@ -2628,6 +2528,8 @@ SUBROUTINE TMD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(u1%Mesh, u2%Mesh, u3%Mesh, tin, u_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE TMD_Input_ExtrapInterp2 @@ -2707,8 +2609,8 @@ SUBROUTINE TMD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'TMD_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -2723,6 +2625,8 @@ SUBROUTINE TMD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(y1%Mesh, y2%Mesh, tin, y_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE TMD_Output_ExtrapInterp1 @@ -2754,8 +2658,9 @@ SUBROUTINE TMD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'TMD_Output_ExtrapInterp2' @@ -2777,6 +2682,8 @@ SUBROUTINE TMD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(y1%Mesh, y2%Mesh, y3%Mesh, tin, y_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE TMD_Output_ExtrapInterp2 diff --git a/modules/subdyn/src/SubDyn_Types.f90 b/modules/subdyn/src/SubDyn_Types.f90 index d7ce80aaee..bcdd051039 100644 --- a/modules/subdyn/src/SubDyn_Types.f90 +++ b/modules/subdyn/src/SubDyn_Types.f90 @@ -377,22 +377,24 @@ SUBROUTINE SD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%SDInputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%SDInputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%g - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TP_RefPoint))-1 ) = PACK(InData%TP_RefPoint,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TP_RefPoint) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SubRotateZ - Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(InData%SDInputFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%SDInputFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + ReKiBuf(Re_Xferred) = InData%g + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDpth + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%TP_RefPoint,1), UBOUND(InData%TP_RefPoint,1) + ReKiBuf(Re_Xferred) = InData%TP_RefPoint(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%SubRotateZ + Re_Xferred = Re_Xferred + 1 END SUBROUTINE SD_PackInitInput SUBROUTINE SD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -408,12 +410,6 @@ SUBROUTINE SD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -431,31 +427,26 @@ SUBROUTINE SD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%SDInputFile) - OutData%SDInputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%g = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDpth = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(OutData%SDInputFile) + OutData%SDInputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%g = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WtrDpth = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%TP_RefPoint,1) i1_u = UBOUND(OutData%TP_RefPoint,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%TP_RefPoint = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TP_RefPoint))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TP_RefPoint) - DEALLOCATE(mask1) - OutData%SubRotateZ = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%TP_RefPoint,1), UBOUND(OutData%TP_RefPoint,1) + OutData%TP_RefPoint(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%SubRotateZ = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE SD_UnPackInitInput SUBROUTINE SD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -620,12 +611,12 @@ SUBROUTINE SD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) + DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) DO I = 1, LEN(InData%WriteOutputHdr) IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdr(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -637,12 +628,12 @@ SUBROUTINE SD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) + DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) DO I = 1, LEN(InData%WriteOutputUnt) IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUnt(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -687,12 +678,6 @@ SUBROUTINE SD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -720,19 +705,12 @@ SUBROUTINE SD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) DO I = 1, LEN(OutData%WriteOutputHdr) OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated Int_Xferred = Int_Xferred + 1 @@ -747,19 +725,12 @@ SUBROUTINE SD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) DO I = 1, LEN(OutData%WriteOutputUnt) OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -1070,10 +1041,10 @@ SUBROUTINE SD_PackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MemberID - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NOutCnt - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MemberID + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NOutCnt + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%NodeCnt) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1084,8 +1055,10 @@ SUBROUTINE SD_PackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodeCnt,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%NodeCnt)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%NodeCnt))-1 ) = PACK(InData%NodeCnt,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%NodeCnt) + DO i1 = LBOUND(InData%NodeCnt,1), UBOUND(InData%NodeCnt,1) + IntKiBuf(Int_Xferred) = InData%NodeCnt(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%NodeIDs) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1097,8 +1070,10 @@ SUBROUTINE SD_PackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodeIDs,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%NodeIDs)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%NodeIDs))-1 ) = PACK(InData%NodeIDs,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%NodeIDs) + DO i1 = LBOUND(InData%NodeIDs,1), UBOUND(InData%NodeIDs,1) + IntKiBuf(Int_Xferred) = InData%NodeIDs(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%ElmIDs) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1113,8 +1088,12 @@ SUBROUTINE SD_PackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElmIDs,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ElmIDs)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%ElmIDs))-1 ) = PACK(InData%ElmIDs,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%ElmIDs) + DO i2 = LBOUND(InData%ElmIDs,2), UBOUND(InData%ElmIDs,2) + DO i1 = LBOUND(InData%ElmIDs,1), UBOUND(InData%ElmIDs,1) + IntKiBuf(Int_Xferred) = InData%ElmIDs(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%ElmNds) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1129,13 +1108,21 @@ SUBROUTINE SD_PackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElmNds,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ElmNds)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%ElmNds))-1 ) = PACK(InData%ElmNds,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%ElmNds) + DO i2 = LBOUND(InData%ElmNds,2), UBOUND(InData%ElmNds,2) + DO i1 = LBOUND(InData%ElmNds,1), UBOUND(InData%ElmNds,1) + IntKiBuf(Int_Xferred) = InData%ElmNds(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%ElmID2s))-1 ) = PACK(InData%ElmID2s,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%ElmID2s) - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%ElmNd2s))-1 ) = PACK(InData%ElmNd2s,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%ElmNd2s) + DO i1 = LBOUND(InData%ElmID2s,1), UBOUND(InData%ElmID2s,1) + IntKiBuf(Int_Xferred) = InData%ElmID2s(i1) + Int_Xferred = Int_Xferred + 1 + END DO + DO i1 = LBOUND(InData%ElmNd2s,1), UBOUND(InData%ElmNd2s,1) + IntKiBuf(Int_Xferred) = InData%ElmNd2s(i1) + Int_Xferred = Int_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%Me) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1155,8 +1142,16 @@ SUBROUTINE SD_PackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Me,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Me)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Me))-1 ) = PACK(InData%Me,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Me) + DO i4 = LBOUND(InData%Me,4), UBOUND(InData%Me,4) + DO i3 = LBOUND(InData%Me,3), UBOUND(InData%Me,3) + DO i2 = LBOUND(InData%Me,2), UBOUND(InData%Me,2) + DO i1 = LBOUND(InData%Me,1), UBOUND(InData%Me,1) + ReKiBuf(Re_Xferred) = InData%Me(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Ke) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1177,8 +1172,16 @@ SUBROUTINE SD_PackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ke,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Ke)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Ke))-1 ) = PACK(InData%Ke,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Ke) + DO i4 = LBOUND(InData%Ke,4), UBOUND(InData%Ke,4) + DO i3 = LBOUND(InData%Ke,3), UBOUND(InData%Ke,3) + DO i2 = LBOUND(InData%Ke,2), UBOUND(InData%Ke,2) + DO i1 = LBOUND(InData%Ke,1), UBOUND(InData%Ke,1) + ReKiBuf(Re_Xferred) = InData%Ke(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Fg) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1196,15 +1199,37 @@ SUBROUTINE SD_PackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fg,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Fg)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Fg))-1 ) = PACK(InData%Fg,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Fg) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Me2))-1 ) = PACK(InData%Me2,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Me2) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Ke2))-1 ) = PACK(InData%Ke2,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Ke2) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Fg2))-1 ) = PACK(InData%Fg2,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Fg2) + DO i3 = LBOUND(InData%Fg,3), UBOUND(InData%Fg,3) + DO i2 = LBOUND(InData%Fg,2), UBOUND(InData%Fg,2) + DO i1 = LBOUND(InData%Fg,1), UBOUND(InData%Fg,1) + ReKiBuf(Re_Xferred) = InData%Fg(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + DO i3 = LBOUND(InData%Me2,3), UBOUND(InData%Me2,3) + DO i2 = LBOUND(InData%Me2,2), UBOUND(InData%Me2,2) + DO i1 = LBOUND(InData%Me2,1), UBOUND(InData%Me2,1) + ReKiBuf(Re_Xferred) = InData%Me2(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + DO i3 = LBOUND(InData%Ke2,3), UBOUND(InData%Ke2,3) + DO i2 = LBOUND(InData%Ke2,2), UBOUND(InData%Ke2,2) + DO i1 = LBOUND(InData%Ke2,1), UBOUND(InData%Ke2,1) + ReKiBuf(Re_Xferred) = InData%Ke2(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + DO i2 = LBOUND(InData%Fg2,2), UBOUND(InData%Fg2,2) + DO i1 = LBOUND(InData%Fg2,1), UBOUND(InData%Fg2,1) + ReKiBuf(Re_Xferred) = InData%Fg2(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END SUBROUTINE SD_PackMeshAuxDataType SUBROUTINE SD_UnPackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1220,12 +1245,6 @@ SUBROUTINE SD_UnPackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -1243,10 +1262,10 @@ SUBROUTINE SD_UnPackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%MemberID = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NOutCnt = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%MemberID = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NOutCnt = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NodeCnt not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1260,15 +1279,10 @@ SUBROUTINE SD_UnPackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodeCnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%NodeCnt)>0) OutData%NodeCnt = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%NodeCnt))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%NodeCnt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%NodeCnt,1), UBOUND(OutData%NodeCnt,1) + OutData%NodeCnt(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NodeIDs not allocated Int_Xferred = Int_Xferred + 1 @@ -1283,15 +1297,10 @@ SUBROUTINE SD_UnPackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodeIDs.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%NodeIDs)>0) OutData%NodeIDs = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%NodeIDs))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%NodeIDs) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%NodeIDs,1), UBOUND(OutData%NodeIDs,1) + OutData%NodeIDs(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ElmIDs not allocated Int_Xferred = Int_Xferred + 1 @@ -1309,15 +1318,12 @@ SUBROUTINE SD_UnPackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElmIDs.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%ElmIDs)>0) OutData%ElmIDs = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%ElmIDs))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%ElmIDs) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%ElmIDs,2), UBOUND(OutData%ElmIDs,2) + DO i1 = LBOUND(OutData%ElmIDs,1), UBOUND(OutData%ElmIDs,1) + OutData%ElmIDs(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ElmNds not allocated Int_Xferred = Int_Xferred + 1 @@ -1335,38 +1341,25 @@ SUBROUTINE SD_UnPackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElmNds.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%ElmNds)>0) OutData%ElmNds = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%ElmNds))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%ElmNds) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%ElmNds,2), UBOUND(OutData%ElmNds,2) + DO i1 = LBOUND(OutData%ElmNds,1), UBOUND(OutData%ElmNds,1) + OutData%ElmNds(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF i1_l = LBOUND(OutData%ElmID2s,1) i1_u = UBOUND(OutData%ElmID2s,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%ElmID2s = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%ElmID2s))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%ElmID2s) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%ElmID2s,1), UBOUND(OutData%ElmID2s,1) + OutData%ElmID2s(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO i1_l = LBOUND(OutData%ElmNd2s,1) i1_u = UBOUND(OutData%ElmNd2s,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%ElmNd2s = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%ElmNd2s))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%ElmNd2s) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%ElmNd2s,1), UBOUND(OutData%ElmNd2s,1) + OutData%ElmNd2s(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Me not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1389,15 +1382,16 @@ SUBROUTINE SD_UnPackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Me.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%Me)>0) OutData%Me = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Me))-1 ), mask4, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Me) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%Me,4), UBOUND(OutData%Me,4) + DO i3 = LBOUND(OutData%Me,3), UBOUND(OutData%Me,3) + DO i2 = LBOUND(OutData%Me,2), UBOUND(OutData%Me,2) + DO i1 = LBOUND(OutData%Me,1), UBOUND(OutData%Me,1) + OutData%Me(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Ke not allocated Int_Xferred = Int_Xferred + 1 @@ -1421,15 +1415,16 @@ SUBROUTINE SD_UnPackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ke.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%Ke)>0) OutData%Ke = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Ke))-1 ), mask4, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Ke) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%Ke,4), UBOUND(OutData%Ke,4) + DO i3 = LBOUND(OutData%Ke,3), UBOUND(OutData%Ke,3) + DO i2 = LBOUND(OutData%Ke,2), UBOUND(OutData%Ke,2) + DO i1 = LBOUND(OutData%Ke,1), UBOUND(OutData%Ke,1) + OutData%Ke(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fg not allocated Int_Xferred = Int_Xferred + 1 @@ -1450,15 +1445,14 @@ SUBROUTINE SD_UnPackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fg.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%Fg)>0) OutData%Fg = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Fg))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Fg) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%Fg,3), UBOUND(OutData%Fg,3) + DO i2 = LBOUND(OutData%Fg,2), UBOUND(OutData%Fg,2) + DO i1 = LBOUND(OutData%Fg,1), UBOUND(OutData%Fg,1) + OutData%Fg(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF i1_l = LBOUND(OutData%Me2,1) i1_u = UBOUND(OutData%Me2,1) @@ -1466,43 +1460,38 @@ SUBROUTINE SD_UnPackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta i2_u = UBOUND(OutData%Me2,2) i3_l = LBOUND(OutData%Me2,3) i3_u = UBOUND(OutData%Me2,3) - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - OutData%Me2 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Me2))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Me2) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%Me2,3), UBOUND(OutData%Me2,3) + DO i2 = LBOUND(OutData%Me2,2), UBOUND(OutData%Me2,2) + DO i1 = LBOUND(OutData%Me2,1), UBOUND(OutData%Me2,1) + OutData%Me2(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO i1_l = LBOUND(OutData%Ke2,1) i1_u = UBOUND(OutData%Ke2,1) i2_l = LBOUND(OutData%Ke2,2) i2_u = UBOUND(OutData%Ke2,2) i3_l = LBOUND(OutData%Ke2,3) i3_u = UBOUND(OutData%Ke2,3) - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - OutData%Ke2 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Ke2))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Ke2) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%Ke2,3), UBOUND(OutData%Ke2,3) + DO i2 = LBOUND(OutData%Ke2,2), UBOUND(OutData%Ke2,2) + DO i1 = LBOUND(OutData%Ke2,1), UBOUND(OutData%Ke2,1) + OutData%Ke2(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO i1_l = LBOUND(OutData%Fg2,1) i1_u = UBOUND(OutData%Fg2,1) i2_l = LBOUND(OutData%Fg2,2) i2_u = UBOUND(OutData%Fg2,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%Fg2 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Fg2))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Fg2) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Fg2,2), UBOUND(OutData%Fg2,2) + DO i1 = LBOUND(OutData%Fg2,1), UBOUND(OutData%Fg2,1) + OutData%Fg2(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END SUBROUTINE SD_UnPackMeshAuxDataType SUBROUTINE SD_CopyCB_MatArrays( SrcCB_MatArraysData, DstCB_MatArraysData, CtrlCode, ErrStat, ErrMsg ) @@ -1750,8 +1739,8 @@ SUBROUTINE SD_PackCB_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DOFM - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DOFM + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%TI2) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1765,8 +1754,12 @@ SUBROUTINE SD_PackCB_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TI2,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TI2)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TI2))-1 ) = PACK(InData%TI2,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TI2) + DO i2 = LBOUND(InData%TI2,2), UBOUND(InData%TI2,2) + DO i1 = LBOUND(InData%TI2,1), UBOUND(InData%TI2,1) + ReKiBuf(Re_Xferred) = InData%TI2(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%MBB) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1781,8 +1774,12 @@ SUBROUTINE SD_PackCB_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBB,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%MBB)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MBB))-1 ) = PACK(InData%MBB,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MBB) + DO i2 = LBOUND(InData%MBB,2), UBOUND(InData%MBB,2) + DO i1 = LBOUND(InData%MBB,1), UBOUND(InData%MBB,1) + ReKiBuf(Re_Xferred) = InData%MBB(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%MBM) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1797,8 +1794,12 @@ SUBROUTINE SD_PackCB_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBM,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%MBM)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MBM))-1 ) = PACK(InData%MBM,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MBM) + DO i2 = LBOUND(InData%MBM,2), UBOUND(InData%MBM,2) + DO i1 = LBOUND(InData%MBM,1), UBOUND(InData%MBM,1) + ReKiBuf(Re_Xferred) = InData%MBM(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%KBB) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1813,8 +1814,12 @@ SUBROUTINE SD_PackCB_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KBB,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%KBB)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%KBB))-1 ) = PACK(InData%KBB,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%KBB) + DO i2 = LBOUND(InData%KBB,2), UBOUND(InData%KBB,2) + DO i1 = LBOUND(InData%KBB,1), UBOUND(InData%KBB,1) + ReKiBuf(Re_Xferred) = InData%KBB(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PhiL) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1829,8 +1834,12 @@ SUBROUTINE SD_PackCB_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiL,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PhiL)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PhiL))-1 ) = PACK(InData%PhiL,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PhiL) + DO i2 = LBOUND(InData%PhiL,2), UBOUND(InData%PhiL,2) + DO i1 = LBOUND(InData%PhiL,1), UBOUND(InData%PhiL,1) + ReKiBuf(Re_Xferred) = InData%PhiL(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PhiR) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1845,8 +1854,12 @@ SUBROUTINE SD_PackCB_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiR,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PhiR)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PhiR))-1 ) = PACK(InData%PhiR,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PhiR) + DO i2 = LBOUND(InData%PhiR,2), UBOUND(InData%PhiR,2) + DO i1 = LBOUND(InData%PhiR,1), UBOUND(InData%PhiR,1) + ReKiBuf(Re_Xferred) = InData%PhiR(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%OmegaL) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1858,8 +1871,10 @@ SUBROUTINE SD_PackCB_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OmegaL,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%OmegaL)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%OmegaL))-1 ) = PACK(InData%OmegaL,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%OmegaL) + DO i1 = LBOUND(InData%OmegaL,1), UBOUND(InData%OmegaL,1) + ReKiBuf(Re_Xferred) = InData%OmegaL(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE SD_PackCB_MatArrays @@ -1876,12 +1891,6 @@ SUBROUTINE SD_UnPackCB_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -1897,8 +1906,8 @@ SUBROUTINE SD_UnPackCB_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DOFM = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%DOFM = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TI2 not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1915,15 +1924,12 @@ SUBROUTINE SD_UnPackCB_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TI2.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%TI2)>0) OutData%TI2 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TI2))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TI2) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%TI2,2), UBOUND(OutData%TI2,2) + DO i1 = LBOUND(OutData%TI2,1), UBOUND(OutData%TI2,1) + OutData%TI2(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MBB not allocated Int_Xferred = Int_Xferred + 1 @@ -1941,15 +1947,12 @@ SUBROUTINE SD_UnPackCB_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MBB.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%MBB)>0) OutData%MBB = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MBB))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MBB) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%MBB,2), UBOUND(OutData%MBB,2) + DO i1 = LBOUND(OutData%MBB,1), UBOUND(OutData%MBB,1) + OutData%MBB(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MBM not allocated Int_Xferred = Int_Xferred + 1 @@ -1967,15 +1970,12 @@ SUBROUTINE SD_UnPackCB_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MBM.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%MBM)>0) OutData%MBM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MBM))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MBM) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%MBM,2), UBOUND(OutData%MBM,2) + DO i1 = LBOUND(OutData%MBM,1), UBOUND(OutData%MBM,1) + OutData%MBM(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! KBB not allocated Int_Xferred = Int_Xferred + 1 @@ -1993,15 +1993,12 @@ SUBROUTINE SD_UnPackCB_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%KBB.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%KBB)>0) OutData%KBB = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%KBB))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%KBB) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%KBB,2), UBOUND(OutData%KBB,2) + DO i1 = LBOUND(OutData%KBB,1), UBOUND(OutData%KBB,1) + OutData%KBB(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PhiL not allocated Int_Xferred = Int_Xferred + 1 @@ -2019,15 +2016,12 @@ SUBROUTINE SD_UnPackCB_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiL.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PhiL)>0) OutData%PhiL = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PhiL))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PhiL) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PhiL,2), UBOUND(OutData%PhiL,2) + DO i1 = LBOUND(OutData%PhiL,1), UBOUND(OutData%PhiL,1) + OutData%PhiL(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PhiR not allocated Int_Xferred = Int_Xferred + 1 @@ -2045,15 +2039,12 @@ SUBROUTINE SD_UnPackCB_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiR.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PhiR)>0) OutData%PhiR = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PhiR))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PhiR) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PhiR,2), UBOUND(OutData%PhiR,2) + DO i1 = LBOUND(OutData%PhiR,1), UBOUND(OutData%PhiR,1) + OutData%PhiR(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OmegaL not allocated Int_Xferred = Int_Xferred + 1 @@ -2068,15 +2059,10 @@ SUBROUTINE SD_UnPackCB_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OmegaL.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%OmegaL)>0) OutData%OmegaL = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%OmegaL))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%OmegaL) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%OmegaL,1), UBOUND(OutData%OmegaL,1) + OutData%OmegaL(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE SD_UnPackCB_MatArrays @@ -2225,11 +2211,13 @@ SUBROUTINE SD_PackFEM_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Omega,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Omega)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Omega))-1 ) = PACK(InData%Omega,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Omega) + DO i1 = LBOUND(InData%Omega,1), UBOUND(InData%Omega,1) + ReKiBuf(Re_Xferred) = InData%Omega(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NOmega - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NOmega + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%Modes) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2243,8 +2231,12 @@ SUBROUTINE SD_PackFEM_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Modes,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Modes)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Modes))-1 ) = PACK(InData%Modes,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Modes) + DO i2 = LBOUND(InData%Modes,2), UBOUND(InData%Modes,2) + DO i1 = LBOUND(InData%Modes,1), UBOUND(InData%Modes,1) + ReKiBuf(Re_Xferred) = InData%Modes(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE SD_PackFEM_MatArrays @@ -2261,12 +2253,6 @@ SUBROUTINE SD_UnPackFEM_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -2295,18 +2281,13 @@ SUBROUTINE SD_UnPackFEM_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Omega.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Omega)>0) OutData%Omega = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Omega))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Omega) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Omega,1), UBOUND(OutData%Omega,1) + OutData%Omega(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%NOmega = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NOmega = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Modes not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2323,15 +2304,12 @@ SUBROUTINE SD_UnPackFEM_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Modes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Modes)>0) OutData%Modes = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Modes))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Modes) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Modes,2), UBOUND(OutData%Modes,2) + DO i1 = LBOUND(OutData%Modes,1), UBOUND(OutData%Modes,1) + OutData%Modes(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE SD_UnPackFEM_MatArrays @@ -2448,28 +2426,32 @@ SUBROUTINE SD_PackElemPropType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Area - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Length - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Ixx - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Iyy - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Jzz - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Shear , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Kappa - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YoungE - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ShearG - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Rho - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DirCos))-1 ) = PACK(InData%DirCos,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DirCos) + ReKiBuf(Re_Xferred) = InData%Area + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Length + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Ixx + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Iyy + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Jzz + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%Shear, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Kappa + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YoungE + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ShearG + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Rho + Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(InData%DirCos,2), UBOUND(InData%DirCos,2) + DO i1 = LBOUND(InData%DirCos,1), UBOUND(InData%DirCos,1) + ReKiBuf(Re_Xferred) = InData%DirCos(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END SUBROUTINE SD_PackElemPropType SUBROUTINE SD_UnPackElemPropType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2485,12 +2467,6 @@ SUBROUTINE SD_UnPackElemPropType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -2506,39 +2482,36 @@ SUBROUTINE SD_UnPackElemPropType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%Area = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Length = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Ixx = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Iyy = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Jzz = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Shear = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%Kappa = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YoungE = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%ShearG = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Rho = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%Area = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Length = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Ixx = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Iyy = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Jzz = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Shear = TRANSFER(IntKiBuf(Int_Xferred), OutData%Shear) + Int_Xferred = Int_Xferred + 1 + OutData%Kappa = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YoungE = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%ShearG = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Rho = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%DirCos,1) i1_u = UBOUND(OutData%DirCos,1) i2_l = LBOUND(OutData%DirCos,2) i2_u = UBOUND(OutData%DirCos,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%DirCos = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DirCos))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DirCos) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%DirCos,2), UBOUND(OutData%DirCos,2) + DO i1 = LBOUND(OutData%DirCos,1), UBOUND(OutData%DirCos,1) + OutData%DirCos(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END SUBROUTINE SD_UnPackElemPropType SUBROUTINE SD_CopyInitType( SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, ErrMsg ) @@ -3128,36 +3101,38 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TP_RefPoint))-1 ) = PACK(InData%TP_RefPoint,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TP_RefPoint) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SubRotateZ - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%g - Re_Xferred = Re_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NJoints - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NPropSets - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NXPropSets - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NInterf - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NCMass - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NCOSMs - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%FEMMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NDiv - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%CBMod , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO i1 = LBOUND(InData%TP_RefPoint,1), UBOUND(InData%TP_RefPoint,1) + ReKiBuf(Re_Xferred) = InData%TP_RefPoint(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%SubRotateZ + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%g + Re_Xferred = Re_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NJoints + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NPropSets + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NXPropSets + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NInterf + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NCMass + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NCOSMs + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%FEMMod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NDiv + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%CBMod, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%Joints) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -3171,8 +3146,12 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Joints,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Joints)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Joints))-1 ) = PACK(InData%Joints,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Joints) + DO i2 = LBOUND(InData%Joints,2), UBOUND(InData%Joints,2) + DO i1 = LBOUND(InData%Joints,1), UBOUND(InData%Joints,1) + ReKiBuf(Re_Xferred) = InData%Joints(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PropSets) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3187,8 +3166,12 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropSets,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PropSets)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PropSets))-1 ) = PACK(InData%PropSets,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PropSets) + DO i2 = LBOUND(InData%PropSets,2), UBOUND(InData%PropSets,2) + DO i1 = LBOUND(InData%PropSets,1), UBOUND(InData%PropSets,1) + ReKiBuf(Re_Xferred) = InData%PropSets(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%XPropSets) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3203,8 +3186,12 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%XPropSets,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%XPropSets)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%XPropSets))-1 ) = PACK(InData%XPropSets,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%XPropSets) + DO i2 = LBOUND(InData%XPropSets,2), UBOUND(InData%XPropSets,2) + DO i1 = LBOUND(InData%XPropSets,1), UBOUND(InData%XPropSets,1) + ReKiBuf(Re_Xferred) = InData%XPropSets(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%COSMs) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3219,8 +3206,12 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%COSMs,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%COSMs)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%COSMs))-1 ) = PACK(InData%COSMs,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%COSMs) + DO i2 = LBOUND(InData%COSMs,2), UBOUND(InData%COSMs,2) + DO i1 = LBOUND(InData%COSMs,1), UBOUND(InData%COSMs,1) + ReKiBuf(Re_Xferred) = InData%COSMs(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%CMass) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3235,8 +3226,12 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CMass,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CMass)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CMass))-1 ) = PACK(InData%CMass,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CMass) + DO i2 = LBOUND(InData%CMass,2), UBOUND(InData%CMass,2) + DO i1 = LBOUND(InData%CMass,1), UBOUND(InData%CMass,1) + ReKiBuf(Re_Xferred) = InData%CMass(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%JDampings) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3248,8 +3243,10 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%JDampings,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%JDampings)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%JDampings))-1 ) = PACK(InData%JDampings,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%JDampings) + DO i1 = LBOUND(InData%JDampings,1), UBOUND(InData%JDampings,1) + ReKiBuf(Re_Xferred) = InData%JDampings(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%Members) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3264,8 +3261,12 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Members,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Members)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%Members))-1 ) = PACK(InData%Members,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%Members) + DO i2 = LBOUND(InData%Members,2), UBOUND(InData%Members,2) + DO i1 = LBOUND(InData%Members,1), UBOUND(InData%Members,1) + IntKiBuf(Int_Xferred) = InData%Members(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Interf) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3280,8 +3281,12 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Interf,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Interf)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%Interf))-1 ) = PACK(InData%Interf,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%Interf) + DO i2 = LBOUND(InData%Interf,2), UBOUND(InData%Interf,2) + DO i1 = LBOUND(InData%Interf,1), UBOUND(InData%Interf,1) + IntKiBuf(Int_Xferred) = InData%Interf(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%SSOutList) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3293,25 +3298,25 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SSOutList,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%SSOutList,1), UBOUND(InData%SSOutList,1) + DO i1 = LBOUND(InData%SSOutList,1), UBOUND(InData%SSOutList,1) DO I = 1, LEN(InData%SSOutList) IntKiBuf(Int_Xferred) = ICHAR(InData%SSOutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%OutCOSM , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TabDelim , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NNode - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NElem - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NProp - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TDOF - Int_Xferred = Int_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = TRANSFER(InData%OutCOSM, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TabDelim, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NNode + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NElem + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NProp + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TDOF + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%Nodes) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -3325,8 +3330,12 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nodes,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Nodes)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Nodes))-1 ) = PACK(InData%Nodes,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Nodes) + DO i2 = LBOUND(InData%Nodes,2), UBOUND(InData%Nodes,2) + DO i1 = LBOUND(InData%Nodes,1), UBOUND(InData%Nodes,1) + ReKiBuf(Re_Xferred) = InData%Nodes(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Props) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3341,8 +3350,12 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Props,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Props)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Props))-1 ) = PACK(InData%Props,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Props) + DO i2 = LBOUND(InData%Props,2), UBOUND(InData%Props,2) + DO i1 = LBOUND(InData%Props,1), UBOUND(InData%Props,1) + ReKiBuf(Re_Xferred) = InData%Props(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%K) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3357,8 +3370,12 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%K,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%K)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%K))-1 ) = PACK(InData%K,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%K) + DO i2 = LBOUND(InData%K,2), UBOUND(InData%K,2) + DO i1 = LBOUND(InData%K,1), UBOUND(InData%K,1) + ReKiBuf(Re_Xferred) = InData%K(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%M) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3373,8 +3390,12 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%M)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%M))-1 ) = PACK(InData%M,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%M) + DO i2 = LBOUND(InData%M,2), UBOUND(InData%M,2) + DO i1 = LBOUND(InData%M,1), UBOUND(InData%M,1) + ReKiBuf(Re_Xferred) = InData%M(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%F) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3386,8 +3407,10 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%F)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F))-1 ) = PACK(InData%F,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F) + DO i1 = LBOUND(InData%F,1), UBOUND(InData%F,1) + ReKiBuf(Re_Xferred) = InData%F(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%FG) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3399,8 +3422,10 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FG,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FG)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FG))-1 ) = PACK(InData%FG,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FG) + DO i1 = LBOUND(InData%FG,1), UBOUND(InData%FG,1) + ReKiBuf(Re_Xferred) = InData%FG(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%ElemProps) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3415,8 +3440,12 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElemProps,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ElemProps)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%ElemProps))-1 ) = PACK(InData%ElemProps,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%ElemProps) + DO i2 = LBOUND(InData%ElemProps,2), UBOUND(InData%ElemProps,2) + DO i1 = LBOUND(InData%ElemProps,1), UBOUND(InData%ElemProps,1) + ReKiBuf(Re_Xferred) = InData%ElemProps(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%BCs) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3431,8 +3460,12 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BCs,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BCs)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%BCs))-1 ) = PACK(InData%BCs,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%BCs) + DO i2 = LBOUND(InData%BCs,2), UBOUND(InData%BCs,2) + DO i1 = LBOUND(InData%BCs,1), UBOUND(InData%BCs,1) + IntKiBuf(Int_Xferred) = InData%BCs(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%IntFc) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3447,8 +3480,12 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IntFc,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%IntFc)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%IntFc))-1 ) = PACK(InData%IntFc,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%IntFc) + DO i2 = LBOUND(InData%IntFc,2), UBOUND(InData%IntFc,2) + DO i1 = LBOUND(InData%IntFc,1), UBOUND(InData%IntFc,1) + IntKiBuf(Int_Xferred) = InData%IntFc(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%MemberNodes) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3463,8 +3500,12 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MemberNodes,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%MemberNodes)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%MemberNodes))-1 ) = PACK(InData%MemberNodes,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%MemberNodes) + DO i2 = LBOUND(InData%MemberNodes,2), UBOUND(InData%MemberNodes,2) + DO i1 = LBOUND(InData%MemberNodes,1), UBOUND(InData%MemberNodes,1) + IntKiBuf(Int_Xferred) = InData%MemberNodes(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%NodesConnN) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3479,8 +3520,12 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodesConnN,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%NodesConnN)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%NodesConnN))-1 ) = PACK(InData%NodesConnN,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%NodesConnN) + DO i2 = LBOUND(InData%NodesConnN,2), UBOUND(InData%NodesConnN,2) + DO i1 = LBOUND(InData%NodesConnN,1), UBOUND(InData%NodesConnN,1) + IntKiBuf(Int_Xferred) = InData%NodesConnN(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%NodesConnE) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3495,11 +3540,15 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodesConnE,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%NodesConnE)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%NodesConnE))-1 ) = PACK(InData%NodesConnE,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%NodesConnE) + DO i2 = LBOUND(InData%NodesConnE,2), UBOUND(InData%NodesConnE,2) + DO i1 = LBOUND(InData%NodesConnE,1), UBOUND(InData%NodesConnE,1) + IntKiBuf(Int_Xferred) = InData%NodesConnE(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%SSSum , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%SSSum, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE SD_PackInitType SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -3515,12 +3564,6 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -3536,45 +3579,40 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I i1_l = LBOUND(OutData%TP_RefPoint,1) i1_u = UBOUND(OutData%TP_RefPoint,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%TP_RefPoint = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TP_RefPoint))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TP_RefPoint) - DEALLOCATE(mask1) - OutData%SubRotateZ = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%g = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%NJoints = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NPropSets = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NXPropSets = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NInterf = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NCMass = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NCOSMs = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%FEMMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NDiv = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%CBMod = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%TP_RefPoint,1), UBOUND(OutData%TP_RefPoint,1) + OutData%TP_RefPoint(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%SubRotateZ = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%g = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%NJoints = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NPropSets = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NXPropSets = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NInterf = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NCMass = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NCOSMs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%FEMMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NDiv = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%CBMod = TRANSFER(IntKiBuf(Int_Xferred), OutData%CBMod) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Joints not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3591,15 +3629,12 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Joints.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Joints)>0) OutData%Joints = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Joints))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Joints) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Joints,2), UBOUND(OutData%Joints,2) + DO i1 = LBOUND(OutData%Joints,1), UBOUND(OutData%Joints,1) + OutData%Joints(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PropSets not allocated Int_Xferred = Int_Xferred + 1 @@ -3617,15 +3652,12 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropSets.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PropSets)>0) OutData%PropSets = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PropSets))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PropSets) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PropSets,2), UBOUND(OutData%PropSets,2) + DO i1 = LBOUND(OutData%PropSets,1), UBOUND(OutData%PropSets,1) + OutData%PropSets(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! XPropSets not allocated Int_Xferred = Int_Xferred + 1 @@ -3643,15 +3675,12 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%XPropSets.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%XPropSets)>0) OutData%XPropSets = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%XPropSets))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%XPropSets) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%XPropSets,2), UBOUND(OutData%XPropSets,2) + DO i1 = LBOUND(OutData%XPropSets,1), UBOUND(OutData%XPropSets,1) + OutData%XPropSets(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! COSMs not allocated Int_Xferred = Int_Xferred + 1 @@ -3669,15 +3698,12 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%COSMs.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%COSMs)>0) OutData%COSMs = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%COSMs))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%COSMs) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%COSMs,2), UBOUND(OutData%COSMs,2) + DO i1 = LBOUND(OutData%COSMs,1), UBOUND(OutData%COSMs,1) + OutData%COSMs(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CMass not allocated Int_Xferred = Int_Xferred + 1 @@ -3695,15 +3721,12 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CMass.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%CMass)>0) OutData%CMass = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CMass))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CMass) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%CMass,2), UBOUND(OutData%CMass,2) + DO i1 = LBOUND(OutData%CMass,1), UBOUND(OutData%CMass,1) + OutData%CMass(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! JDampings not allocated Int_Xferred = Int_Xferred + 1 @@ -3718,15 +3741,10 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%JDampings.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%JDampings)>0) OutData%JDampings = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%JDampings))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%JDampings) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%JDampings,1), UBOUND(OutData%JDampings,1) + OutData%JDampings(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Members not allocated Int_Xferred = Int_Xferred + 1 @@ -3744,15 +3762,12 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Members.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Members)>0) OutData%Members = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%Members))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%Members) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Members,2), UBOUND(OutData%Members,2) + DO i1 = LBOUND(OutData%Members,1), UBOUND(OutData%Members,1) + OutData%Members(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Interf not allocated Int_Xferred = Int_Xferred + 1 @@ -3770,15 +3785,12 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Interf.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Interf)>0) OutData%Interf = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%Interf))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%Interf) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Interf,2), UBOUND(OutData%Interf,2) + DO i1 = LBOUND(OutData%Interf,1), UBOUND(OutData%Interf,1) + OutData%Interf(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SSOutList not allocated Int_Xferred = Int_Xferred + 1 @@ -3793,32 +3805,25 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SSOutList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%SSOutList,1), UBOUND(OutData%SSOutList,1) + DO i1 = LBOUND(OutData%SSOutList,1), UBOUND(OutData%SSOutList,1) DO I = 1, LEN(OutData%SSOutList) OutData%SSOutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) - END IF - OutData%OutCOSM = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%TabDelim = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NNode = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NElem = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NProp = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TDOF = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + END DO + END IF + OutData%OutCOSM = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutCOSM) + Int_Xferred = Int_Xferred + 1 + OutData%TabDelim = TRANSFER(IntKiBuf(Int_Xferred), OutData%TabDelim) + Int_Xferred = Int_Xferred + 1 + OutData%NNode = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NElem = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NProp = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TDOF = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Nodes not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3835,15 +3840,12 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nodes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Nodes)>0) OutData%Nodes = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Nodes))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Nodes) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Nodes,2), UBOUND(OutData%Nodes,2) + DO i1 = LBOUND(OutData%Nodes,1), UBOUND(OutData%Nodes,1) + OutData%Nodes(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Props not allocated Int_Xferred = Int_Xferred + 1 @@ -3861,15 +3863,12 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Props.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Props)>0) OutData%Props = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Props))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Props) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Props,2), UBOUND(OutData%Props,2) + DO i1 = LBOUND(OutData%Props,1), UBOUND(OutData%Props,1) + OutData%Props(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! K not allocated Int_Xferred = Int_Xferred + 1 @@ -3887,15 +3886,12 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%K.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%K)>0) OutData%K = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%K))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%K) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%K,2), UBOUND(OutData%K,2) + DO i1 = LBOUND(OutData%K,1), UBOUND(OutData%K,1) + OutData%K(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! M not allocated Int_Xferred = Int_Xferred + 1 @@ -3913,15 +3909,12 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%M.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%M)>0) OutData%M = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%M))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%M) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%M,2), UBOUND(OutData%M,2) + DO i1 = LBOUND(OutData%M,1), UBOUND(OutData%M,1) + OutData%M(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F not allocated Int_Xferred = Int_Xferred + 1 @@ -3936,15 +3929,10 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%F)>0) OutData%F = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%F,1), UBOUND(OutData%F,1) + OutData%F(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FG not allocated Int_Xferred = Int_Xferred + 1 @@ -3959,15 +3947,10 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FG.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%FG)>0) OutData%FG = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FG))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FG) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FG,1), UBOUND(OutData%FG,1) + OutData%FG(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ElemProps not allocated Int_Xferred = Int_Xferred + 1 @@ -3985,15 +3968,12 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElemProps.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%ElemProps)>0) OutData%ElemProps = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%ElemProps))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%ElemProps) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%ElemProps,2), UBOUND(OutData%ElemProps,2) + DO i1 = LBOUND(OutData%ElemProps,1), UBOUND(OutData%ElemProps,1) + OutData%ElemProps(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BCs not allocated Int_Xferred = Int_Xferred + 1 @@ -4011,15 +3991,12 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BCs.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%BCs)>0) OutData%BCs = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%BCs))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%BCs) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%BCs,2), UBOUND(OutData%BCs,2) + DO i1 = LBOUND(OutData%BCs,1), UBOUND(OutData%BCs,1) + OutData%BCs(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IntFc not allocated Int_Xferred = Int_Xferred + 1 @@ -4037,15 +4014,12 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IntFc.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%IntFc)>0) OutData%IntFc = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%IntFc))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%IntFc) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%IntFc,2), UBOUND(OutData%IntFc,2) + DO i1 = LBOUND(OutData%IntFc,1), UBOUND(OutData%IntFc,1) + OutData%IntFc(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MemberNodes not allocated Int_Xferred = Int_Xferred + 1 @@ -4063,15 +4037,12 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MemberNodes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%MemberNodes)>0) OutData%MemberNodes = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%MemberNodes))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%MemberNodes) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%MemberNodes,2), UBOUND(OutData%MemberNodes,2) + DO i1 = LBOUND(OutData%MemberNodes,1), UBOUND(OutData%MemberNodes,1) + OutData%MemberNodes(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NodesConnN not allocated Int_Xferred = Int_Xferred + 1 @@ -4089,15 +4060,12 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodesConnN.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%NodesConnN)>0) OutData%NodesConnN = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%NodesConnN))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%NodesConnN) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%NodesConnN,2), UBOUND(OutData%NodesConnN,2) + DO i1 = LBOUND(OutData%NodesConnN,1), UBOUND(OutData%NodesConnN,1) + OutData%NodesConnN(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NodesConnE not allocated Int_Xferred = Int_Xferred + 1 @@ -4115,18 +4083,15 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodesConnE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%NodesConnE)>0) OutData%NodesConnE = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%NodesConnE))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%NodesConnE) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%NodesConnE,2), UBOUND(OutData%NodesConnE,2) + DO i1 = LBOUND(OutData%NodesConnE,1), UBOUND(OutData%NodesConnE,1) + OutData%NodesConnE(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF - OutData%SSSum = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%SSSum = TRANSFER(IntKiBuf(Int_Xferred), OutData%SSSum) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE SD_UnPackInitType SUBROUTINE SD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) @@ -4269,8 +4234,10 @@ SUBROUTINE SD_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%qm,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%qm)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%qm))-1 ) = PACK(InData%qm,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%qm) + DO i1 = LBOUND(InData%qm,1), UBOUND(InData%qm,1) + ReKiBuf(Re_Xferred) = InData%qm(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%qmdot) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4282,8 +4249,10 @@ SUBROUTINE SD_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%qmdot,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%qmdot)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%qmdot))-1 ) = PACK(InData%qmdot,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%qmdot) + DO i1 = LBOUND(InData%qmdot,1), UBOUND(InData%qmdot,1) + ReKiBuf(Re_Xferred) = InData%qmdot(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE SD_PackContState @@ -4300,12 +4269,6 @@ SUBROUTINE SD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -4333,15 +4296,10 @@ SUBROUTINE SD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%qm.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%qm)>0) OutData%qm = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%qm))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%qm) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%qm,1), UBOUND(OutData%qm,1) + OutData%qm(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! qmdot not allocated Int_Xferred = Int_Xferred + 1 @@ -4356,15 +4314,10 @@ SUBROUTINE SD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%qmdot.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%qmdot)>0) OutData%qmdot = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%qmdot))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%qmdot) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%qmdot,1), UBOUND(OutData%qmdot,1) + OutData%qmdot(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE SD_UnPackContState @@ -4459,8 +4412,8 @@ SUBROUTINE SD_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyDiscState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE SD_PackDiscState SUBROUTINE SD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -4476,12 +4429,6 @@ SUBROUTINE SD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackDiscState' @@ -4495,8 +4442,8 @@ SUBROUTINE SD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyDiscState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyDiscState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE SD_UnPackDiscState SUBROUTINE SD_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -4590,8 +4537,8 @@ SUBROUTINE SD_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyConstrState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE SD_PackConstrState SUBROUTINE SD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -4607,12 +4554,6 @@ SUBROUTINE SD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackConstrState' @@ -4626,8 +4567,8 @@ SUBROUTINE SD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyConstrState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyConstrState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE SD_UnPackConstrState SUBROUTINE SD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -4809,8 +4750,8 @@ SUBROUTINE SD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%n - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%n + Int_Xferred = Int_Xferred + 1 END SUBROUTINE SD_PackOtherState SUBROUTINE SD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -4826,12 +4767,6 @@ SUBROUTINE SD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -4902,8 +4837,8 @@ SUBROUTINE SD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%n = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%n = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE SD_UnPackOtherState SUBROUTINE SD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -5196,15 +5131,23 @@ SUBROUTINE SD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%qmdotdot,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%qmdotdot)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%qmdotdot))-1 ) = PACK(InData%qmdotdot,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%qmdotdot) + DO i1 = LBOUND(InData%qmdotdot,1), UBOUND(InData%qmdotdot,1) + ReKiBuf(Re_Xferred) = InData%qmdotdot(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%u_TP))-1 ) = PACK(InData%u_TP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%u_TP) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%udot_TP))-1 ) = PACK(InData%udot_TP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%udot_TP) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%udotdot_TP))-1 ) = PACK(InData%udotdot_TP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%udotdot_TP) + DO i1 = LBOUND(InData%u_TP,1), UBOUND(InData%u_TP,1) + ReKiBuf(Re_Xferred) = InData%u_TP(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%udot_TP,1), UBOUND(InData%udot_TP,1) + ReKiBuf(Re_Xferred) = InData%udot_TP(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%udotdot_TP,1), UBOUND(InData%udotdot_TP,1) + ReKiBuf(Re_Xferred) = InData%udotdot_TP(i1) + Re_Xferred = Re_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%UFL) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -5215,8 +5158,10 @@ SUBROUTINE SD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UFL,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%UFL)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%UFL))-1 ) = PACK(InData%UFL,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%UFL) + DO i1 = LBOUND(InData%UFL,1), UBOUND(InData%UFL,1) + ReKiBuf(Re_Xferred) = InData%UFL(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%UR_bar) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5228,8 +5173,10 @@ SUBROUTINE SD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UR_bar,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%UR_bar)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%UR_bar))-1 ) = PACK(InData%UR_bar,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%UR_bar) + DO i1 = LBOUND(InData%UR_bar,1), UBOUND(InData%UR_bar,1) + ReKiBuf(Re_Xferred) = InData%UR_bar(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%UR_bar_dot) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5241,8 +5188,10 @@ SUBROUTINE SD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UR_bar_dot,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%UR_bar_dot)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%UR_bar_dot))-1 ) = PACK(InData%UR_bar_dot,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%UR_bar_dot) + DO i1 = LBOUND(InData%UR_bar_dot,1), UBOUND(InData%UR_bar_dot,1) + ReKiBuf(Re_Xferred) = InData%UR_bar_dot(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%UR_bar_dotdot) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5254,8 +5203,10 @@ SUBROUTINE SD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UR_bar_dotdot,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%UR_bar_dotdot)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%UR_bar_dotdot))-1 ) = PACK(InData%UR_bar_dotdot,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%UR_bar_dotdot) + DO i1 = LBOUND(InData%UR_bar_dotdot,1), UBOUND(InData%UR_bar_dotdot,1) + ReKiBuf(Re_Xferred) = InData%UR_bar_dotdot(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%UL) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5267,8 +5218,10 @@ SUBROUTINE SD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UL,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%UL)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%UL))-1 ) = PACK(InData%UL,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%UL) + DO i1 = LBOUND(InData%UL,1), UBOUND(InData%UL,1) + ReKiBuf(Re_Xferred) = InData%UL(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%UL_dot) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5280,8 +5233,10 @@ SUBROUTINE SD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UL_dot,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%UL_dot)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%UL_dot))-1 ) = PACK(InData%UL_dot,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%UL_dot) + DO i1 = LBOUND(InData%UL_dot,1), UBOUND(InData%UL_dot,1) + ReKiBuf(Re_Xferred) = InData%UL_dot(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%UL_dotdot) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5293,8 +5248,10 @@ SUBROUTINE SD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UL_dotdot,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%UL_dotdot)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%UL_dotdot))-1 ) = PACK(InData%UL_dotdot,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%UL_dotdot) + DO i1 = LBOUND(InData%UL_dotdot,1), UBOUND(InData%UL_dotdot,1) + ReKiBuf(Re_Xferred) = InData%UL_dotdot(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%SDWrOutput) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5306,13 +5263,15 @@ SUBROUTINE SD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SDWrOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%SDWrOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SDWrOutput))-1 ) = PACK(InData%SDWrOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SDWrOutput) + DO i1 = LBOUND(InData%SDWrOutput,1), UBOUND(InData%SDWrOutput,1) + ReKiBuf(Re_Xferred) = InData%SDWrOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%LastOutTime - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Decimat - Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%LastOutTime + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Decimat + Int_Xferred = Int_Xferred + 1 END SUBROUTINE SD_PackMisc SUBROUTINE SD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -5328,12 +5287,6 @@ SUBROUTINE SD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -5361,49 +5314,29 @@ SUBROUTINE SD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%qmdotdot.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%qmdotdot)>0) OutData%qmdotdot = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%qmdotdot))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%qmdotdot) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%qmdotdot,1), UBOUND(OutData%qmdotdot,1) + OutData%qmdotdot(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF i1_l = LBOUND(OutData%u_TP,1) i1_u = UBOUND(OutData%u_TP,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%u_TP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%u_TP))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%u_TP) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%u_TP,1), UBOUND(OutData%u_TP,1) + OutData%u_TP(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%udot_TP,1) i1_u = UBOUND(OutData%udot_TP,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%udot_TP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%udot_TP))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%udot_TP) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%udot_TP,1), UBOUND(OutData%udot_TP,1) + OutData%udot_TP(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%udotdot_TP,1) i1_u = UBOUND(OutData%udotdot_TP,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%udotdot_TP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%udotdot_TP))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%udotdot_TP) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%udotdot_TP,1), UBOUND(OutData%udotdot_TP,1) + OutData%udotdot_TP(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UFL not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5417,15 +5350,10 @@ SUBROUTINE SD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UFL.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%UFL)>0) OutData%UFL = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%UFL))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%UFL) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%UFL,1), UBOUND(OutData%UFL,1) + OutData%UFL(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UR_bar not allocated Int_Xferred = Int_Xferred + 1 @@ -5440,15 +5368,10 @@ SUBROUTINE SD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UR_bar.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%UR_bar)>0) OutData%UR_bar = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%UR_bar))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%UR_bar) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%UR_bar,1), UBOUND(OutData%UR_bar,1) + OutData%UR_bar(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UR_bar_dot not allocated Int_Xferred = Int_Xferred + 1 @@ -5463,15 +5386,10 @@ SUBROUTINE SD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UR_bar_dot.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%UR_bar_dot)>0) OutData%UR_bar_dot = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%UR_bar_dot))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%UR_bar_dot) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%UR_bar_dot,1), UBOUND(OutData%UR_bar_dot,1) + OutData%UR_bar_dot(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UR_bar_dotdot not allocated Int_Xferred = Int_Xferred + 1 @@ -5486,15 +5404,10 @@ SUBROUTINE SD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UR_bar_dotdot.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%UR_bar_dotdot)>0) OutData%UR_bar_dotdot = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%UR_bar_dotdot))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%UR_bar_dotdot) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%UR_bar_dotdot,1), UBOUND(OutData%UR_bar_dotdot,1) + OutData%UR_bar_dotdot(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UL not allocated Int_Xferred = Int_Xferred + 1 @@ -5509,15 +5422,10 @@ SUBROUTINE SD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UL.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%UL)>0) OutData%UL = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%UL))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%UL) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%UL,1), UBOUND(OutData%UL,1) + OutData%UL(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UL_dot not allocated Int_Xferred = Int_Xferred + 1 @@ -5532,15 +5440,10 @@ SUBROUTINE SD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UL_dot.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%UL_dot)>0) OutData%UL_dot = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%UL_dot))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%UL_dot) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%UL_dot,1), UBOUND(OutData%UL_dot,1) + OutData%UL_dot(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UL_dotdot not allocated Int_Xferred = Int_Xferred + 1 @@ -5555,15 +5458,10 @@ SUBROUTINE SD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UL_dotdot.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%UL_dotdot)>0) OutData%UL_dotdot = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%UL_dotdot))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%UL_dotdot) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%UL_dotdot,1), UBOUND(OutData%UL_dotdot,1) + OutData%UL_dotdot(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SDWrOutput not allocated Int_Xferred = Int_Xferred + 1 @@ -5578,20 +5476,15 @@ SUBROUTINE SD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SDWrOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%SDWrOutput)>0) OutData%SDWrOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SDWrOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SDWrOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%SDWrOutput,1), UBOUND(OutData%SDWrOutput,1) + OutData%SDWrOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%LastOutTime = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%Decimat = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%LastOutTime = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%Decimat = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE SD_UnPackMisc SUBROUTINE SD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -6669,10 +6562,10 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%SDDeltaT - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%SttcSolve , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%SDDeltaT + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%SttcSolve, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%NOmegaM2) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -6683,8 +6576,10 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NOmegaM2,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%NOmegaM2)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%NOmegaM2))-1 ) = PACK(InData%NOmegaM2,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%NOmegaM2) + DO i1 = LBOUND(InData%NOmegaM2,1), UBOUND(InData%NOmegaM2,1) + ReKiBuf(Re_Xferred) = InData%NOmegaM2(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%N2OmegaMJDamp) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6696,8 +6591,10 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%N2OmegaMJDamp,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%N2OmegaMJDamp)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%N2OmegaMJDamp))-1 ) = PACK(InData%N2OmegaMJDamp,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%N2OmegaMJDamp) + DO i1 = LBOUND(InData%N2OmegaMJDamp,1), UBOUND(InData%N2OmegaMJDamp,1) + ReKiBuf(Re_Xferred) = InData%N2OmegaMJDamp(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%MMB) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6712,8 +6609,12 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MMB,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%MMB)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MMB))-1 ) = PACK(InData%MMB,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MMB) + DO i2 = LBOUND(InData%MMB,2), UBOUND(InData%MMB,2) + DO i1 = LBOUND(InData%MMB,1), UBOUND(InData%MMB,1) + ReKiBuf(Re_Xferred) = InData%MMB(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FX) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6725,8 +6626,10 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FX,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FX)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FX))-1 ) = PACK(InData%FX,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FX) + DO i1 = LBOUND(InData%FX,1), UBOUND(InData%FX,1) + ReKiBuf(Re_Xferred) = InData%FX(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%C1_11) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6741,8 +6644,12 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C1_11,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%C1_11)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%C1_11))-1 ) = PACK(InData%C1_11,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%C1_11) + DO i2 = LBOUND(InData%C1_11,2), UBOUND(InData%C1_11,2) + DO i1 = LBOUND(InData%C1_11,1), UBOUND(InData%C1_11,1) + ReKiBuf(Re_Xferred) = InData%C1_11(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%C1_12) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6757,8 +6664,12 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C1_12,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%C1_12)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%C1_12))-1 ) = PACK(InData%C1_12,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%C1_12) + DO i2 = LBOUND(InData%C1_12,2), UBOUND(InData%C1_12,2) + DO i1 = LBOUND(InData%C1_12,1), UBOUND(InData%C1_12,1) + ReKiBuf(Re_Xferred) = InData%C1_12(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%D1_13) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6773,8 +6684,12 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D1_13,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D1_13)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D1_13))-1 ) = PACK(InData%D1_13,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D1_13) + DO i2 = LBOUND(InData%D1_13,2), UBOUND(InData%D1_13,2) + DO i1 = LBOUND(InData%D1_13,1), UBOUND(InData%D1_13,1) + ReKiBuf(Re_Xferred) = InData%D1_13(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%D1_14) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6789,8 +6704,12 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D1_14,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D1_14)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D1_14))-1 ) = PACK(InData%D1_14,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D1_14) + DO i2 = LBOUND(InData%D1_14,2), UBOUND(InData%D1_14,2) + DO i1 = LBOUND(InData%D1_14,1), UBOUND(InData%D1_14,1) + ReKiBuf(Re_Xferred) = InData%D1_14(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FY) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6802,8 +6721,10 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FY,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FY)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FY))-1 ) = PACK(InData%FY,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FY) + DO i1 = LBOUND(InData%FY,1), UBOUND(InData%FY,1) + ReKiBuf(Re_Xferred) = InData%FY(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%PhiM) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6818,8 +6739,12 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiM,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PhiM)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PhiM))-1 ) = PACK(InData%PhiM,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PhiM) + DO i2 = LBOUND(InData%PhiM,2), UBOUND(InData%PhiM,2) + DO i1 = LBOUND(InData%PhiM,1), UBOUND(InData%PhiM,1) + ReKiBuf(Re_Xferred) = InData%PhiM(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%C2_61) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6834,8 +6759,12 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C2_61,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%C2_61)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%C2_61))-1 ) = PACK(InData%C2_61,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%C2_61) + DO i2 = LBOUND(InData%C2_61,2), UBOUND(InData%C2_61,2) + DO i1 = LBOUND(InData%C2_61,1), UBOUND(InData%C2_61,1) + ReKiBuf(Re_Xferred) = InData%C2_61(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%C2_62) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6850,8 +6779,12 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C2_62,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%C2_62)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%C2_62))-1 ) = PACK(InData%C2_62,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%C2_62) + DO i2 = LBOUND(InData%C2_62,2), UBOUND(InData%C2_62,2) + DO i1 = LBOUND(InData%C2_62,1), UBOUND(InData%C2_62,1) + ReKiBuf(Re_Xferred) = InData%C2_62(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PhiRb_TI) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6866,8 +6799,12 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiRb_TI,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PhiRb_TI)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PhiRb_TI))-1 ) = PACK(InData%PhiRb_TI,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PhiRb_TI) + DO i2 = LBOUND(InData%PhiRb_TI,2), UBOUND(InData%PhiRb_TI,2) + DO i1 = LBOUND(InData%PhiRb_TI,1), UBOUND(InData%PhiRb_TI,1) + ReKiBuf(Re_Xferred) = InData%PhiRb_TI(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%D2_63) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6882,8 +6819,12 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D2_63,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D2_63)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D2_63))-1 ) = PACK(InData%D2_63,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D2_63) + DO i2 = LBOUND(InData%D2_63,2), UBOUND(InData%D2_63,2) + DO i1 = LBOUND(InData%D2_63,1), UBOUND(InData%D2_63,1) + ReKiBuf(Re_Xferred) = InData%D2_63(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%D2_64) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6898,8 +6839,12 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D2_64,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D2_64)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D2_64))-1 ) = PACK(InData%D2_64,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D2_64) + DO i2 = LBOUND(InData%D2_64,2), UBOUND(InData%D2_64,2) + DO i1 = LBOUND(InData%D2_64,1), UBOUND(InData%D2_64,1) + ReKiBuf(Re_Xferred) = InData%D2_64(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%F2_61) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6911,8 +6856,10 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F2_61,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%F2_61)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F2_61))-1 ) = PACK(InData%F2_61,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F2_61) + DO i1 = LBOUND(InData%F2_61,1), UBOUND(InData%F2_61,1) + ReKiBuf(Re_Xferred) = InData%F2_61(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%MBB) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6927,8 +6874,12 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBB,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%MBB)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MBB))-1 ) = PACK(InData%MBB,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MBB) + DO i2 = LBOUND(InData%MBB,2), UBOUND(InData%MBB,2) + DO i1 = LBOUND(InData%MBB,1), UBOUND(InData%MBB,1) + ReKiBuf(Re_Xferred) = InData%MBB(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%KBB) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6943,8 +6894,12 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KBB,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%KBB)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%KBB))-1 ) = PACK(InData%KBB,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%KBB) + DO i2 = LBOUND(InData%KBB,2), UBOUND(InData%KBB,2) + DO i1 = LBOUND(InData%KBB,1), UBOUND(InData%KBB,1) + ReKiBuf(Re_Xferred) = InData%KBB(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%MBM) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6959,8 +6914,12 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBM,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%MBM)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MBM))-1 ) = PACK(InData%MBM,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MBM) + DO i2 = LBOUND(InData%MBM,2), UBOUND(InData%MBM,2) + DO i1 = LBOUND(InData%MBM,1), UBOUND(InData%MBM,1) + ReKiBuf(Re_Xferred) = InData%MBM(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PhiL_T) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6975,8 +6934,12 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiL_T,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PhiL_T)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PhiL_T))-1 ) = PACK(InData%PhiL_T,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PhiL_T) + DO i2 = LBOUND(InData%PhiL_T,2), UBOUND(InData%PhiL_T,2) + DO i1 = LBOUND(InData%PhiL_T,1), UBOUND(InData%PhiL_T,1) + ReKiBuf(Re_Xferred) = InData%PhiL_T(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PhiLInvOmgL2) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6991,8 +6954,12 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiLInvOmgL2,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PhiLInvOmgL2)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PhiLInvOmgL2))-1 ) = PACK(InData%PhiLInvOmgL2,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PhiLInvOmgL2) + DO i2 = LBOUND(InData%PhiLInvOmgL2,2), UBOUND(InData%PhiLInvOmgL2,2) + DO i1 = LBOUND(InData%PhiLInvOmgL2,1), UBOUND(InData%PhiLInvOmgL2,1) + ReKiBuf(Re_Xferred) = InData%PhiLInvOmgL2(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FGL) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7004,8 +6971,10 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FGL,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FGL)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FGL))-1 ) = PACK(InData%FGL,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FGL) + DO i1 = LBOUND(InData%FGL,1), UBOUND(InData%FGL,1) + ReKiBuf(Re_Xferred) = InData%FGL(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%AM2Jac) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7020,8 +6989,12 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AM2Jac,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AM2Jac)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AM2Jac))-1 ) = PACK(InData%AM2Jac,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AM2Jac) + DO i2 = LBOUND(InData%AM2Jac,2), UBOUND(InData%AM2Jac,2) + DO i1 = LBOUND(InData%AM2Jac,1), UBOUND(InData%AM2Jac,1) + ReKiBuf(Re_Xferred) = InData%AM2Jac(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%AM2JacPiv) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7033,8 +7006,10 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AM2JacPiv,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AM2JacPiv)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%AM2JacPiv))-1 ) = PACK(InData%AM2JacPiv,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%AM2JacPiv) + DO i1 = LBOUND(InData%AM2JacPiv,1), UBOUND(InData%AM2JacPiv,1) + IntKiBuf(Int_Xferred) = InData%AM2JacPiv(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TI) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7049,8 +7024,12 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TI,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TI)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TI))-1 ) = PACK(InData%TI,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TI) + DO i2 = LBOUND(InData%TI,2), UBOUND(InData%TI,2) + DO i1 = LBOUND(InData%TI,1), UBOUND(InData%TI,1) + ReKiBuf(Re_Xferred) = InData%TI(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%TIreact) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7065,11 +7044,15 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TIreact,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TIreact)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TIreact))-1 ) = PACK(InData%TIreact,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TIreact) + DO i2 = LBOUND(InData%TIreact,2), UBOUND(InData%TIreact,2) + DO i1 = LBOUND(InData%TIreact,1), UBOUND(InData%TIreact,1) + ReKiBuf(Re_Xferred) = InData%TIreact(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NModes - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NModes + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%Elems) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -7083,27 +7066,31 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Elems,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Elems)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%Elems))-1 ) = PACK(InData%Elems,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%Elems) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%qmL - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DofL - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NNodes_I - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NNodes_L - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NNodes_RbarL - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DofI - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DofR - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DofC - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NReact - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(InData%Elems,2), UBOUND(InData%Elems,2) + DO i1 = LBOUND(InData%Elems,1), UBOUND(InData%Elems,1) + IntKiBuf(Int_Xferred) = InData%Elems(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + IntKiBuf(Int_Xferred) = InData%qmL + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DofL + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NNodes_I + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NNodes_L + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NNodes_RbarL + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DofI + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DofR + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DofC + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NReact + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%Reacts) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -7117,17 +7104,21 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Reacts,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Reacts)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%Reacts))-1 ) = PACK(InData%Reacts,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%Reacts) + DO i2 = LBOUND(InData%Reacts,2), UBOUND(InData%Reacts,2) + DO i1 = LBOUND(InData%Reacts,1), UBOUND(InData%Reacts,1) + IntKiBuf(Int_Xferred) = InData%Reacts(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Nmembers - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%URbarL - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%IntMethod - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NAvgEls - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Nmembers + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%URbarL + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%IntMethod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NAvgEls + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%IDI) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -7138,8 +7129,10 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IDI,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%IDI)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%IDI))-1 ) = PACK(InData%IDI,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%IDI) + DO i1 = LBOUND(InData%IDI,1), UBOUND(InData%IDI,1) + IntKiBuf(Int_Xferred) = InData%IDI(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%IDR) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7151,8 +7144,10 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IDR,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%IDR)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%IDR))-1 ) = PACK(InData%IDR,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%IDR) + DO i1 = LBOUND(InData%IDR,1), UBOUND(InData%IDR,1) + IntKiBuf(Int_Xferred) = InData%IDR(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%IDL) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7164,8 +7159,10 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IDL,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%IDL)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%IDL))-1 ) = PACK(InData%IDL,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%IDL) + DO i1 = LBOUND(InData%IDL,1), UBOUND(InData%IDL,1) + IntKiBuf(Int_Xferred) = InData%IDL(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%IDC) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7177,8 +7174,10 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IDC,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%IDC)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%IDC))-1 ) = PACK(InData%IDC,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%IDC) + DO i1 = LBOUND(InData%IDC,1), UBOUND(InData%IDC,1) + IntKiBuf(Int_Xferred) = InData%IDC(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%IDY) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7190,29 +7189,31 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IDY,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%IDY)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%IDY))-1 ) = PACK(InData%IDY,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%IDY) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NMOutputs - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%OutSwtch - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UnJckF - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%Delim) - IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutSFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO i1 = LBOUND(InData%IDY,1), UBOUND(InData%IDY,1) + IntKiBuf(Int_Xferred) = InData%IDY(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = InData%NMOutputs + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%OutSwtch + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%UnJckF + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%Delim) + IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%OutFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%OutSFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( .NOT. ALLOCATED(InData%MoutLst) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -7418,16 +7419,16 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%OutAll , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%OutReact , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%OutAllInt - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%OutAllDims - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%OutDec - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%OutAll, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%OutReact, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%OutAllInt + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%OutAllDims + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%OutDec + Int_Xferred = Int_Xferred + 1 END SUBROUTINE SD_PackParam SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -7443,12 +7444,6 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -7464,10 +7459,10 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%SDDeltaT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%SttcSolve = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%SDDeltaT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%SttcSolve = TRANSFER(IntKiBuf(Int_Xferred), OutData%SttcSolve) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NOmegaM2 not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -7481,15 +7476,10 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NOmegaM2.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%NOmegaM2)>0) OutData%NOmegaM2 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%NOmegaM2))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%NOmegaM2) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%NOmegaM2,1), UBOUND(OutData%NOmegaM2,1) + OutData%NOmegaM2(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! N2OmegaMJDamp not allocated Int_Xferred = Int_Xferred + 1 @@ -7504,15 +7494,10 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%N2OmegaMJDamp.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%N2OmegaMJDamp)>0) OutData%N2OmegaMJDamp = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%N2OmegaMJDamp))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%N2OmegaMJDamp) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%N2OmegaMJDamp,1), UBOUND(OutData%N2OmegaMJDamp,1) + OutData%N2OmegaMJDamp(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MMB not allocated Int_Xferred = Int_Xferred + 1 @@ -7530,15 +7515,12 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MMB.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%MMB)>0) OutData%MMB = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MMB))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MMB) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%MMB,2), UBOUND(OutData%MMB,2) + DO i1 = LBOUND(OutData%MMB,1), UBOUND(OutData%MMB,1) + OutData%MMB(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FX not allocated Int_Xferred = Int_Xferred + 1 @@ -7553,15 +7535,10 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FX.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%FX)>0) OutData%FX = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FX))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FX) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FX,1), UBOUND(OutData%FX,1) + OutData%FX(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C1_11 not allocated Int_Xferred = Int_Xferred + 1 @@ -7579,15 +7556,12 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C1_11.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%C1_11)>0) OutData%C1_11 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%C1_11))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%C1_11) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%C1_11,2), UBOUND(OutData%C1_11,2) + DO i1 = LBOUND(OutData%C1_11,1), UBOUND(OutData%C1_11,1) + OutData%C1_11(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C1_12 not allocated Int_Xferred = Int_Xferred + 1 @@ -7605,15 +7579,12 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C1_12.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%C1_12)>0) OutData%C1_12 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%C1_12))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%C1_12) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%C1_12,2), UBOUND(OutData%C1_12,2) + DO i1 = LBOUND(OutData%C1_12,1), UBOUND(OutData%C1_12,1) + OutData%C1_12(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D1_13 not allocated Int_Xferred = Int_Xferred + 1 @@ -7631,15 +7602,12 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D1_13.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%D1_13)>0) OutData%D1_13 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D1_13))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D1_13) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%D1_13,2), UBOUND(OutData%D1_13,2) + DO i1 = LBOUND(OutData%D1_13,1), UBOUND(OutData%D1_13,1) + OutData%D1_13(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D1_14 not allocated Int_Xferred = Int_Xferred + 1 @@ -7657,15 +7625,12 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D1_14.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%D1_14)>0) OutData%D1_14 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D1_14))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D1_14) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%D1_14,2), UBOUND(OutData%D1_14,2) + DO i1 = LBOUND(OutData%D1_14,1), UBOUND(OutData%D1_14,1) + OutData%D1_14(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FY not allocated Int_Xferred = Int_Xferred + 1 @@ -7680,15 +7645,10 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FY.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%FY)>0) OutData%FY = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FY))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FY) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FY,1), UBOUND(OutData%FY,1) + OutData%FY(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PhiM not allocated Int_Xferred = Int_Xferred + 1 @@ -7706,15 +7666,12 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiM.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PhiM)>0) OutData%PhiM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PhiM))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PhiM) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PhiM,2), UBOUND(OutData%PhiM,2) + DO i1 = LBOUND(OutData%PhiM,1), UBOUND(OutData%PhiM,1) + OutData%PhiM(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C2_61 not allocated Int_Xferred = Int_Xferred + 1 @@ -7732,15 +7689,12 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C2_61.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%C2_61)>0) OutData%C2_61 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%C2_61))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%C2_61) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%C2_61,2), UBOUND(OutData%C2_61,2) + DO i1 = LBOUND(OutData%C2_61,1), UBOUND(OutData%C2_61,1) + OutData%C2_61(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C2_62 not allocated Int_Xferred = Int_Xferred + 1 @@ -7758,15 +7712,12 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C2_62.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%C2_62)>0) OutData%C2_62 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%C2_62))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%C2_62) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%C2_62,2), UBOUND(OutData%C2_62,2) + DO i1 = LBOUND(OutData%C2_62,1), UBOUND(OutData%C2_62,1) + OutData%C2_62(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PhiRb_TI not allocated Int_Xferred = Int_Xferred + 1 @@ -7784,15 +7735,12 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiRb_TI.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PhiRb_TI)>0) OutData%PhiRb_TI = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PhiRb_TI))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PhiRb_TI) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PhiRb_TI,2), UBOUND(OutData%PhiRb_TI,2) + DO i1 = LBOUND(OutData%PhiRb_TI,1), UBOUND(OutData%PhiRb_TI,1) + OutData%PhiRb_TI(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D2_63 not allocated Int_Xferred = Int_Xferred + 1 @@ -7810,15 +7758,12 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D2_63.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%D2_63)>0) OutData%D2_63 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D2_63))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D2_63) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%D2_63,2), UBOUND(OutData%D2_63,2) + DO i1 = LBOUND(OutData%D2_63,1), UBOUND(OutData%D2_63,1) + OutData%D2_63(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D2_64 not allocated Int_Xferred = Int_Xferred + 1 @@ -7836,15 +7781,12 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D2_64.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%D2_64)>0) OutData%D2_64 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D2_64))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D2_64) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%D2_64,2), UBOUND(OutData%D2_64,2) + DO i1 = LBOUND(OutData%D2_64,1), UBOUND(OutData%D2_64,1) + OutData%D2_64(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F2_61 not allocated Int_Xferred = Int_Xferred + 1 @@ -7859,15 +7801,10 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F2_61.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%F2_61)>0) OutData%F2_61 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F2_61))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F2_61) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%F2_61,1), UBOUND(OutData%F2_61,1) + OutData%F2_61(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MBB not allocated Int_Xferred = Int_Xferred + 1 @@ -7885,15 +7822,12 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MBB.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%MBB)>0) OutData%MBB = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MBB))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MBB) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%MBB,2), UBOUND(OutData%MBB,2) + DO i1 = LBOUND(OutData%MBB,1), UBOUND(OutData%MBB,1) + OutData%MBB(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! KBB not allocated Int_Xferred = Int_Xferred + 1 @@ -7911,15 +7845,12 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%KBB.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%KBB)>0) OutData%KBB = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%KBB))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%KBB) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%KBB,2), UBOUND(OutData%KBB,2) + DO i1 = LBOUND(OutData%KBB,1), UBOUND(OutData%KBB,1) + OutData%KBB(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MBM not allocated Int_Xferred = Int_Xferred + 1 @@ -7937,15 +7868,12 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MBM.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%MBM)>0) OutData%MBM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MBM))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MBM) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%MBM,2), UBOUND(OutData%MBM,2) + DO i1 = LBOUND(OutData%MBM,1), UBOUND(OutData%MBM,1) + OutData%MBM(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PhiL_T not allocated Int_Xferred = Int_Xferred + 1 @@ -7963,15 +7891,12 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiL_T.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PhiL_T)>0) OutData%PhiL_T = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PhiL_T))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PhiL_T) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PhiL_T,2), UBOUND(OutData%PhiL_T,2) + DO i1 = LBOUND(OutData%PhiL_T,1), UBOUND(OutData%PhiL_T,1) + OutData%PhiL_T(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PhiLInvOmgL2 not allocated Int_Xferred = Int_Xferred + 1 @@ -7989,15 +7914,12 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiLInvOmgL2.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PhiLInvOmgL2)>0) OutData%PhiLInvOmgL2 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PhiLInvOmgL2))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PhiLInvOmgL2) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PhiLInvOmgL2,2), UBOUND(OutData%PhiLInvOmgL2,2) + DO i1 = LBOUND(OutData%PhiLInvOmgL2,1), UBOUND(OutData%PhiLInvOmgL2,1) + OutData%PhiLInvOmgL2(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FGL not allocated Int_Xferred = Int_Xferred + 1 @@ -8012,15 +7934,10 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FGL.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%FGL)>0) OutData%FGL = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FGL))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FGL) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FGL,1), UBOUND(OutData%FGL,1) + OutData%FGL(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AM2Jac not allocated Int_Xferred = Int_Xferred + 1 @@ -8038,15 +7955,12 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AM2Jac.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%AM2Jac)>0) OutData%AM2Jac = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AM2Jac))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AM2Jac) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AM2Jac,2), UBOUND(OutData%AM2Jac,2) + DO i1 = LBOUND(OutData%AM2Jac,1), UBOUND(OutData%AM2Jac,1) + OutData%AM2Jac(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AM2JacPiv not allocated Int_Xferred = Int_Xferred + 1 @@ -8061,15 +7975,10 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AM2JacPiv.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%AM2JacPiv)>0) OutData%AM2JacPiv = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%AM2JacPiv))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%AM2JacPiv) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AM2JacPiv,1), UBOUND(OutData%AM2JacPiv,1) + OutData%AM2JacPiv(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TI not allocated Int_Xferred = Int_Xferred + 1 @@ -8087,15 +7996,12 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TI.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%TI)>0) OutData%TI = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TI))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TI) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%TI,2), UBOUND(OutData%TI,2) + DO i1 = LBOUND(OutData%TI,1), UBOUND(OutData%TI,1) + OutData%TI(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TIreact not allocated Int_Xferred = Int_Xferred + 1 @@ -8113,18 +8019,15 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TIreact.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%TIreact)>0) OutData%TIreact = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TIreact))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TIreact) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%TIreact,2), UBOUND(OutData%TIreact,2) + DO i1 = LBOUND(OutData%TIreact,1), UBOUND(OutData%TIreact,1) + OutData%TIreact(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%NModes = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NModes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Elems not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -8141,34 +8044,31 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Elems.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Elems)>0) OutData%Elems = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%Elems))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%Elems) - DEALLOCATE(mask2) - END IF - OutData%qmL = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%DofL = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NNodes_I = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NNodes_L = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NNodes_RbarL = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%DofI = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%DofR = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%DofC = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NReact = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(OutData%Elems,2), UBOUND(OutData%Elems,2) + DO i1 = LBOUND(OutData%Elems,1), UBOUND(OutData%Elems,1) + OutData%Elems(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + OutData%qmL = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%DofL = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NNodes_I = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NNodes_L = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NNodes_RbarL = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%DofI = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%DofR = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%DofC = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NReact = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Reacts not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -8185,24 +8085,21 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Reacts.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Reacts)>0) OutData%Reacts = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%Reacts))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%Reacts) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Reacts,2), UBOUND(OutData%Reacts,2) + DO i1 = LBOUND(OutData%Reacts,1), UBOUND(OutData%Reacts,1) + OutData%Reacts(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF - OutData%Nmembers = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%URbarL = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%IntMethod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NAvgEls = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%Nmembers = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%URbarL = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%IntMethod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NAvgEls = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IDI not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -8216,15 +8113,10 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDI.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%IDI)>0) OutData%IDI = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%IDI))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%IDI) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%IDI,1), UBOUND(OutData%IDI,1) + OutData%IDI(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IDR not allocated Int_Xferred = Int_Xferred + 1 @@ -8239,15 +8131,10 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDR.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%IDR)>0) OutData%IDR = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%IDR))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%IDR) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%IDR,1), UBOUND(OutData%IDR,1) + OutData%IDR(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IDL not allocated Int_Xferred = Int_Xferred + 1 @@ -8262,15 +8149,10 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDL.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%IDL)>0) OutData%IDL = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%IDL))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%IDL) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%IDL,1), UBOUND(OutData%IDL,1) + OutData%IDL(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IDC not allocated Int_Xferred = Int_Xferred + 1 @@ -8285,15 +8167,10 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDC.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%IDC)>0) OutData%IDC = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%IDC))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%IDC) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%IDC,1), UBOUND(OutData%IDC,1) + OutData%IDC(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IDY not allocated Int_Xferred = Int_Xferred + 1 @@ -8308,36 +8185,31 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDY.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%IDY)>0) OutData%IDY = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%IDY))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%IDY) - DEALLOCATE(mask1) - END IF - OutData%NMOutputs = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%OutSwtch = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%UnJckF = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutSFmt) - OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO i1 = LBOUND(OutData%IDY,1), UBOUND(OutData%IDY,1) + OutData%IDY(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + OutData%NMOutputs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%OutSwtch = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%UnJckF = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%Delim) + OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%OutFmt) + OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%OutSFmt) + OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MoutLst not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -8618,16 +8490,16 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%OutAll = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%OutReact = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%OutAllInt = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%OutAllDims = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%OutDec = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%OutAll = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutAll) + Int_Xferred = Int_Xferred + 1 + OutData%OutReact = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutReact) + Int_Xferred = Int_Xferred + 1 + OutData%OutAllInt = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%OutAllDims = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%OutDec = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE SD_UnPackParam SUBROUTINE SD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -8833,12 +8705,6 @@ SUBROUTINE SD_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackInput' @@ -9153,8 +9019,10 @@ SUBROUTINE SD_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WriteOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE SD_PackOutput @@ -9171,12 +9039,6 @@ SUBROUTINE SD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -9284,15 +9146,10 @@ SUBROUTINE SD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WriteOutput)>0) OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE SD_UnPackOutput @@ -9371,8 +9228,8 @@ SUBROUTINE SD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'SD_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -9387,6 +9244,8 @@ SUBROUTINE SD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(u1%TPMesh, u2%TPMesh, tin, u_out%TPMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL MeshExtrapInterp1(u1%LMesh, u2%LMesh, tin, u_out%LMesh, tin_out, ErrStat2, ErrMsg2 ) @@ -9420,8 +9279,9 @@ SUBROUTINE SD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'SD_Input_ExtrapInterp2' @@ -9443,6 +9303,8 @@ SUBROUTINE SD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(u1%TPMesh, u2%TPMesh, u3%TPMesh, tin, u_out%TPMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL MeshExtrapInterp2(u1%LMesh, u2%LMesh, u3%LMesh, tin, u_out%LMesh, tin_out, ErrStat2, ErrMsg2 ) @@ -9524,12 +9386,12 @@ SUBROUTINE SD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'SD_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! 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 :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -9542,17 +9404,17 @@ SUBROUTINE SD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(y1%Y1Mesh, y2%Y1Mesh, tin, y_out%Y1Mesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL MeshExtrapInterp1(y1%Y2Mesh, y2%Y2Mesh, tin, y_out%Y2Mesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END IF ! check if allocated END SUBROUTINE SD_Output_ExtrapInterp1 @@ -9583,13 +9445,14 @@ SUBROUTINE SD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'SD_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -9608,18 +9471,18 @@ SUBROUTINE SD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(y1%Y1Mesh, y2%Y1Mesh, y3%Y1Mesh, tin, y_out%Y1Mesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL MeshExtrapInterp2(y1%Y2Mesh, y2%Y2Mesh, y3%Y2Mesh, tin, y_out%Y2Mesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END IF ! check if allocated END SUBROUTINE SD_Output_ExtrapInterp2 diff --git a/modules/supercontroller/src/SuperController_Types.f90 b/modules/supercontroller/src/SuperController_Types.f90 index 22edf3d7e7..0f3078661c 100644 --- a/modules/supercontroller/src/SuperController_Types.f90 +++ b/modules/supercontroller/src/SuperController_Types.f90 @@ -186,10 +186,10 @@ SUBROUTINE SC_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumSC2Ctrl - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumCtrl2SC - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumSC2Ctrl + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumCtrl2SC + Int_Xferred = Int_Xferred + 1 END SUBROUTINE SC_PackInitInput SUBROUTINE SC_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -205,12 +205,6 @@ SUBROUTINE SC_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -225,25 +219,52 @@ SUBROUTINE SC_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%NumSC2Ctrl = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NumSC2Ctrl = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 OutData%C_obj%NumSC2Ctrl = OutData%NumSC2Ctrl - OutData%NumCtrl2SC = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NumCtrl2SC = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 OutData%C_obj%NumCtrl2SC = OutData%NumCtrl2SC END SUBROUTINE SC_UnPackInitInput - SUBROUTINE SC_C2Fary_CopyInitInput( InitInputData, ErrStat, ErrMsg ) + SUBROUTINE SC_C2Fary_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers ) TYPE(SC_InitInputType), INTENT(INOUT) :: InitInputData 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 InitInputData%NumSC2Ctrl = InitInputData%C_obj%NumSC2Ctrl InitInputData%NumCtrl2SC = InitInputData%C_obj%NumCtrl2SC END SUBROUTINE SC_C2Fary_CopyInitInput + SUBROUTINE SC_F2C_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(SC_InitInputType), INTENT(INOUT) :: InitInputData + 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 + InitInputData%C_obj%NumSC2Ctrl = InitInputData%NumSC2Ctrl + InitInputData%C_obj%NumCtrl2SC = InitInputData%NumCtrl2SC + END SUBROUTINE SC_F2C_CopyInitInput + SUBROUTINE SC_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(SC_InitOutputType), INTENT(IN) :: SrcInitOutputData TYPE(SC_InitOutputType), INTENT(INOUT) :: DstInitOutputData @@ -400,12 +421,6 @@ SUBROUTINE SC_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SC_UnPackInitOutput' @@ -461,15 +476,40 @@ SUBROUTINE SC_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END SUBROUTINE SC_UnPackInitOutput - SUBROUTINE SC_C2Fary_CopyInitOutput( InitOutputData, ErrStat, ErrMsg ) + SUBROUTINE SC_C2Fary_CopyInitOutput( InitOutputData, ErrStat, ErrMsg, SkipPointers ) TYPE(SC_InitOutputType), INTENT(INOUT) :: InitOutputData 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 SC_C2Fary_CopyInitOutput + SUBROUTINE SC_F2C_CopyInitOutput( InitOutputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(SC_InitOutputType), INTENT(INOUT) :: InitOutputData + 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 SC_F2C_CopyInitOutput + SUBROUTINE SC_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) TYPE(SC_ParameterType), INTENT(IN) :: SrcParamData TYPE(SC_ParameterType), INTENT(INOUT) :: DstParamData @@ -564,8 +604,8 @@ SUBROUTINE SC_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%scOn , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%scOn, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE SC_PackParam SUBROUTINE SC_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -581,12 +621,6 @@ SUBROUTINE SC_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SC_UnPackParam' @@ -600,21 +634,47 @@ SUBROUTINE SC_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%scOn = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%scOn = TRANSFER(IntKiBuf(Int_Xferred), OutData%scOn) + Int_Xferred = Int_Xferred + 1 OutData%C_obj%scOn = OutData%scOn END SUBROUTINE SC_UnPackParam - SUBROUTINE SC_C2Fary_CopyParam( ParamData, ErrStat, ErrMsg ) + SUBROUTINE SC_C2Fary_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) TYPE(SC_ParameterType), INTENT(INOUT) :: ParamData 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 ParamData%scOn = ParamData%C_obj%scOn END SUBROUTINE SC_C2Fary_CopyParam + SUBROUTINE SC_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) + TYPE(SC_ParameterType), INTENT(INOUT) :: ParamData + 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 + ParamData%C_obj%scOn = ParamData%scOn + END SUBROUTINE SC_F2C_CopyParam + SUBROUTINE SC_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) TYPE(SC_InputType), INTENT(IN) :: SrcInputData TYPE(SC_InputType), INTENT(INOUT) :: DstInputData @@ -743,8 +803,10 @@ SUBROUTINE SC_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%toSC,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%toSC)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%toSC))-1 ) = PACK(InData%toSC,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%toSC) + DO i1 = LBOUND(InData%toSC,1), UBOUND(InData%toSC,1) + ReKiBuf(Re_Xferred) = InData%toSC(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE SC_PackInput @@ -761,12 +823,6 @@ SUBROUTINE SC_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -797,34 +853,68 @@ SUBROUTINE SC_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg OutData%c_obj%toSC_Len = SIZE(OutData%toSC) IF (OutData%c_obj%toSC_Len > 0) & OutData%c_obj%toSC = C_LOC( OutData%toSC(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%toSC)>0) OutData%toSC = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%toSC))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%toSC) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%toSC,1), UBOUND(OutData%toSC,1) + OutData%toSC(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE SC_UnPackInput - SUBROUTINE SC_C2Fary_CopyInput( InputData, ErrStat, ErrMsg ) + SUBROUTINE SC_C2Fary_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) TYPE(SC_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" - ! -- toSC Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%toSC ) ) THEN - NULLIFY( InputData%toSC ) + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers ELSE - CALL C_F_POINTER(InputData%C_obj%toSC, InputData%toSC, (/InputData%C_obj%toSC_Len/)) + SkipPointers_local = .false. + END IF + + ! -- toSC Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%toSC ) ) THEN + NULLIFY( InputData%toSC ) + ELSE + CALL C_F_POINTER(InputData%C_obj%toSC, InputData%toSC, (/InputData%C_obj%toSC_Len/)) + END IF END IF END SUBROUTINE SC_C2Fary_CopyInput + SUBROUTINE SC_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(SC_InputType), INTENT(INOUT) :: InputData + 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 + + ! -- toSC Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%toSC)) THEN + InputData%c_obj%toSC_Len = 0 + InputData%c_obj%toSC = C_NULL_PTR + 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) ) ) + END IF + END IF + END SUBROUTINE SC_F2C_CopyInput + SUBROUTINE SC_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(SC_OutputType), INTENT(IN) :: SrcOutputData TYPE(SC_OutputType), INTENT(INOUT) :: DstOutputData @@ -953,8 +1043,10 @@ SUBROUTINE SC_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fromSC,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%fromSC)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%fromSC))-1 ) = PACK(InData%fromSC,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%fromSC) + DO i1 = LBOUND(InData%fromSC,1), UBOUND(InData%fromSC,1) + ReKiBuf(Re_Xferred) = InData%fromSC(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE SC_PackOutput @@ -971,12 +1063,6 @@ SUBROUTINE SC_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1007,34 +1093,68 @@ SUBROUTINE SC_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg OutData%c_obj%fromSC_Len = SIZE(OutData%fromSC) IF (OutData%c_obj%fromSC_Len > 0) & OutData%c_obj%fromSC = C_LOC( OutData%fromSC(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%fromSC)>0) OutData%fromSC = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%fromSC))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%fromSC) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%fromSC,1), UBOUND(OutData%fromSC,1) + OutData%fromSC(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE SC_UnPackOutput - SUBROUTINE SC_C2Fary_CopyOutput( OutputData, ErrStat, ErrMsg ) + SUBROUTINE SC_C2Fary_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) TYPE(SC_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" - ! -- fromSC Output Data fields - IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%fromSC ) ) THEN - NULLIFY( OutputData%fromSC ) + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers ELSE - CALL C_F_POINTER(OutputData%C_obj%fromSC, OutputData%fromSC, (/OutputData%C_obj%fromSC_Len/)) + SkipPointers_local = .false. + END IF + + ! -- fromSC Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%fromSC ) ) THEN + NULLIFY( OutputData%fromSC ) + ELSE + CALL C_F_POINTER(OutputData%C_obj%fromSC, OutputData%fromSC, (/OutputData%C_obj%fromSC_Len/)) + END IF END IF END SUBROUTINE SC_C2Fary_CopyOutput + SUBROUTINE SC_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(SC_OutputType), INTENT(INOUT) :: OutputData + 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 + + ! -- fromSC Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OutputData%fromSC)) THEN + OutputData%c_obj%fromSC_Len = 0 + OutputData%c_obj%fromSC = C_NULL_PTR + 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) ) ) + END IF + END IF + END SUBROUTINE SC_F2C_CopyOutput + SUBROUTINE SC_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) ! @@ -1110,12 +1230,12 @@ SUBROUTINE SC_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'SC_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! 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 :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -1128,13 +1248,13 @@ SUBROUTINE SC_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ASSOCIATED(u_out%toSC) .AND. ASSOCIATED(u1%toSC)) THEN - ALLOCATE(b1(SIZE(u_out%toSC,1))) - ALLOCATE(c1(SIZE(u_out%toSC,1))) - b1 = -(u1%toSC - u2%toSC)/t(2) - u_out%toSC = u1%toSC + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%toSC,1),UBOUND(u_out%toSC,1) + b = -(u1%toSC(i1) - u2%toSC(i1)) + u_out%toSC(i1) = u1%toSC(i1) + b * ScaleFactor + END DO END IF ! check if allocated END SUBROUTINE SC_Input_ExtrapInterp1 @@ -1165,13 +1285,14 @@ SUBROUTINE SC_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'SC_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -1190,14 +1311,14 @@ SUBROUTINE SC_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ASSOCIATED(u_out%toSC) .AND. ASSOCIATED(u1%toSC)) THEN - ALLOCATE(b1(SIZE(u_out%toSC,1))) - ALLOCATE(c1(SIZE(u_out%toSC,1))) - b1 = (t(3)**2*(u1%toSC - u2%toSC) + t(2)**2*(-u1%toSC + u3%toSC))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%toSC + t(3)*u2%toSC - t(2)*u3%toSC ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%toSC = u1%toSC + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%toSC,1),UBOUND(u_out%toSC,1) + b = (t(3)**2*(u1%toSC(i1) - u2%toSC(i1)) + t(2)**2*(-u1%toSC(i1) + u3%toSC(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%toSC(i1) + t(3)*u2%toSC(i1) - t(2)*u3%toSC(i1) ) * scaleFactor + u_out%toSC(i1) = u1%toSC(i1) + b + c * t_out + END DO END IF ! check if allocated END SUBROUTINE SC_Input_ExtrapInterp2 @@ -1276,12 +1397,12 @@ SUBROUTINE SC_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'SC_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! 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 :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -1294,13 +1415,13 @@ SUBROUTINE SC_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ASSOCIATED(y_out%fromSC) .AND. ASSOCIATED(y1%fromSC)) THEN - ALLOCATE(b1(SIZE(y_out%fromSC,1))) - ALLOCATE(c1(SIZE(y_out%fromSC,1))) - b1 = -(y1%fromSC - y2%fromSC)/t(2) - y_out%fromSC = y1%fromSC + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%fromSC,1),UBOUND(y_out%fromSC,1) + b = -(y1%fromSC(i1) - y2%fromSC(i1)) + y_out%fromSC(i1) = y1%fromSC(i1) + b * ScaleFactor + END DO END IF ! check if allocated END SUBROUTINE SC_Output_ExtrapInterp1 @@ -1331,13 +1452,14 @@ SUBROUTINE SC_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'SC_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -1356,14 +1478,14 @@ SUBROUTINE SC_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ASSOCIATED(y_out%fromSC) .AND. ASSOCIATED(y1%fromSC)) THEN - ALLOCATE(b1(SIZE(y_out%fromSC,1))) - ALLOCATE(c1(SIZE(y_out%fromSC,1))) - b1 = (t(3)**2*(y1%fromSC - y2%fromSC) + t(2)**2*(-y1%fromSC + y3%fromSC))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%fromSC + t(3)*y2%fromSC - t(2)*y3%fromSC ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%fromSC = y1%fromSC + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%fromSC,1),UBOUND(y_out%fromSC,1) + b = (t(3)**2*(y1%fromSC(i1) - y2%fromSC(i1)) + t(2)**2*(-y1%fromSC(i1) + y3%fromSC(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%fromSC(i1) + t(3)*y2%fromSC(i1) - t(2)*y3%fromSC(i1) ) * scaleFactor + y_out%fromSC(i1) = y1%fromSC(i1) + b + c * t_out + END DO END IF ! check if allocated END SUBROUTINE SC_Output_ExtrapInterp2 From 8b10bd24bfe537e4a68ef9a1684b8a1e4eedc64c Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Fri, 15 Nov 2019 08:07:31 -0700 Subject: [PATCH 06/72] Sync HydroDyn - continuous states are R8Ki (for VTK mode shapes) - Use ChanLen instead of hard-coded sizes --- modules/hydrodyn/src/HydroDyn.txt | 3 ++- modules/hydrodyn/src/HydroDyn_Output.f90 | 2 +- modules/hydrodyn/src/HydroDyn_Types.f90 | 2 +- modules/hydrodyn/src/Morison.f90 | 4 ++-- modules/hydrodyn/src/Morison.txt | 2 +- modules/hydrodyn/src/Morison_Types.f90 | 2 +- modules/hydrodyn/src/SS_Excitation.f90 | 4 ++-- modules/hydrodyn/src/SS_Excitation.txt | 2 +- modules/hydrodyn/src/SS_Excitation_Types.f90 | 12 ++++++------ modules/hydrodyn/src/WAMIT.txt | 4 ++-- modules/hydrodyn/src/WAMIT2.txt | 2 +- modules/hydrodyn/src/WAMIT2_Types.f90 | 2 +- modules/hydrodyn/src/WAMIT_Types.f90 | 2 +- modules/hydrodyn/src/Waves2.txt | 2 +- modules/hydrodyn/src/Waves2_Types.f90 | 2 +- 15 files changed, 24 insertions(+), 23 deletions(-) diff --git a/modules/hydrodyn/src/HydroDyn.txt b/modules/hydrodyn/src/HydroDyn.txt index cf27a46f56..ca379172d8 100644 --- a/modules/hydrodyn/src/HydroDyn.txt +++ b/modules/hydrodyn/src/HydroDyn.txt @@ -1,4 +1,5 @@ ################################################################################################################################### +################################################################################################################################### # Registry for HydroDyn in the FAST Modularization Framework # This Registry file is used to create MODULE HydroDyn which contains all of the user-defined types needed in HydroDyn. # It also contains copy, destroy, pack, and unpack routines associated with each defined data types. @@ -181,7 +182,7 @@ typedef ^ ^ INTEGER typedef ^ ^ INTEGER OutSwtch - - - "Output requested channels to: [1=Hydrodyn.out 2=GlueCode.out 3=both files]" - typedef ^ ^ CHARACTER(20) OutFmt - - - "Output format for numerical results" - typedef ^ ^ CHARACTER(20) OutSFmt - - - "Output format for header strings" - -typedef ^ ^ CHARACTER(10) Delim - - - "Delimiter string for outputs, defaults to tab-delimiters" - +typedef ^ ^ CHARACTER(ChanLen) Delim - - - "Delimiter string for outputs, defaults to tab-delimiters" - typedef ^ ^ INTEGER UnOutFile - - - "File unit for the HydroDyn outputs" - typedef ^ ^ INTEGER OutDec - - - "Write every OutDec time steps" - typedef ^ ^ Integer Jac_u_indx {:}{:} - - "matrix to help fill/pack the u vector in computing the jacobian" - diff --git a/modules/hydrodyn/src/HydroDyn_Output.f90 b/modules/hydrodyn/src/HydroDyn_Output.f90 index 5d069ba599..ddd9db02fa 100644 --- a/modules/hydrodyn/src/HydroDyn_Output.f90 +++ b/modules/hydrodyn/src/HydroDyn_Output.f90 @@ -294,7 +294,7 @@ SUBROUTINE HDOut_WriteWvKinFiles( Rootname, HD_Prog, NStepWave, NNodes, NWaveEle CHARACTER(5) :: extension(7) INTEGER :: i, j, iFile CHARACTER(64) :: Frmt, Sfrmt - CHARACTER(10) :: Delim + CHARACTER(ChanLen) :: Delim ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" diff --git a/modules/hydrodyn/src/HydroDyn_Types.f90 b/modules/hydrodyn/src/HydroDyn_Types.f90 index 9b8e6687e5..1b6b52b75c 100644 --- a/modules/hydrodyn/src/HydroDyn_Types.f90 +++ b/modules/hydrodyn/src/HydroDyn_Types.f90 @@ -198,7 +198,7 @@ MODULE HydroDyn_Types INTEGER(IntKi) :: OutSwtch !< Output requested channels to: [1=Hydrodyn.out 2=GlueCode.out 3=both files] [-] CHARACTER(20) :: OutFmt !< Output format for numerical results [-] CHARACTER(20) :: OutSFmt !< Output format for header strings [-] - CHARACTER(10) :: Delim !< Delimiter string for outputs, defaults to tab-delimiters [-] + CHARACTER(ChanLen) :: Delim !< Delimiter string for outputs, defaults to tab-delimiters [-] INTEGER(IntKi) :: UnOutFile !< File unit for the HydroDyn outputs [-] INTEGER(IntKi) :: OutDec !< Write every OutDec time steps [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_u_indx !< matrix to help fill/pack the u vector in computing the jacobian [-] diff --git a/modules/hydrodyn/src/Morison.f90 b/modules/hydrodyn/src/Morison.f90 index 5e051600a1..c0fdc4b52e 100644 --- a/modules/hydrodyn/src/Morison.f90 +++ b/modules/hydrodyn/src/Morison.f90 @@ -1020,7 +1020,7 @@ SUBROUTINE WriteSummaryFile( UnSum, MSL2SWL, WtrDpth, numNodes, nodes, numElemen REAL(ReKi) :: l ! length of an element LOGICAL :: filledFlag ! flag indicating if element is filled/flooded CHARACTER(2) :: strFmt - CHARACTER(10) :: strNodeType ! string indicating type of node: End, Interior, Super + CHARACTER(ChanLen) :: strNodeType ! string indicating type of node: End, Interior, Super REAL(ReKi) :: ident(3,3) ! identity matrix REAL(ReKi) :: ExtBuoyancy(6) ! sum of all external buoyancy forces lumped at (0,0,0) REAL(ReKi) :: IntBuoyancy(6) ! sum of all internal buoyancy forces lumped at (0,0,0) @@ -1041,7 +1041,7 @@ SUBROUTINE WriteSummaryFile( UnSum, MSL2SWL, WtrDpth, numNodes, nodes, numElemen REAL(ReKi) :: s ! The linear interpolation factor for the requested location REAL(ReKi) :: outloc(3) ! Position of the requested member output INTEGER :: mbrIndx, nodeIndx - CHARACTER(10) :: tmpName + CHARACTER(ChanLen) :: tmpName REAL(ReKi) :: totalFillMass, mass_fill, fillVol REAL(ReKi) :: totalMGMass, mass_MG TYPE(Morison_NodeType) :: node1, node2 diff --git a/modules/hydrodyn/src/Morison.txt b/modules/hydrodyn/src/Morison.txt index 0549599942..5326fb452c 100644 --- a/modules/hydrodyn/src/Morison.txt +++ b/modules/hydrodyn/src/Morison.txt @@ -339,7 +339,7 @@ typedef ^ ^ INTEGER typedef ^ ^ INTEGER UnOutFile - - - "" - typedef ^ ^ CHARACTER(20) OutFmt - - - "" - typedef ^ ^ CHARACTER(20) OutSFmt - - - "" - -typedef ^ ^ CHARACTER(10) Delim - - - "" - +typedef ^ ^ CHARACTER(ChanLen) Delim - - - "" - # # # ..... Inputs .................................................................................................................... diff --git a/modules/hydrodyn/src/Morison_Types.f90 b/modules/hydrodyn/src/Morison_Types.f90 index c900a11d05..5a0989fc09 100644 --- a/modules/hydrodyn/src/Morison_Types.f90 +++ b/modules/hydrodyn/src/Morison_Types.f90 @@ -396,7 +396,7 @@ MODULE Morison_Types INTEGER(IntKi) :: UnOutFile !< [-] CHARACTER(20) :: OutFmt !< [-] CHARACTER(20) :: OutSFmt !< [-] - CHARACTER(10) :: Delim !< [-] + CHARACTER(ChanLen) :: Delim !< [-] END TYPE Morison_ParameterType ! ======================= ! ========= Morison_InputType ======= diff --git a/modules/hydrodyn/src/SS_Excitation.f90 b/modules/hydrodyn/src/SS_Excitation.f90 index 6e026270a6..7c913081ce 100644 --- a/modules/hydrodyn/src/SS_Excitation.f90 +++ b/modules/hydrodyn/src/SS_Excitation.f90 @@ -87,8 +87,8 @@ SUBROUTINE SS_Exc_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Ini character(ErrMsgLen) :: ErrMsg2 ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" + ErrStat = ErrID_None + ErrMsg = "" u%DummyInput = 0.0_ReKi diff --git a/modules/hydrodyn/src/SS_Excitation.txt b/modules/hydrodyn/src/SS_Excitation.txt index 5bc4f67c99..1c98d4948b 100644 --- a/modules/hydrodyn/src/SS_Excitation.txt +++ b/modules/hydrodyn/src/SS_Excitation.txt @@ -24,7 +24,7 @@ typedef ^ ^ SiKi WaveTime {:} typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputHdr {7} - - "Header of the output" - typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputUnt {7} - - "Units of the output" - -typedef ^ ContinuousStateType ReKi x {:} - - "Continuous States" - +typedef ^ ContinuousStateType R8Ki x {:} - - "Continuous States" - typedef ^ DiscreteStateType SiKi DummyDiscState - - - "" - diff --git a/modules/hydrodyn/src/SS_Excitation_Types.f90 b/modules/hydrodyn/src/SS_Excitation_Types.f90 index c67af350f5..10966b9c6e 100644 --- a/modules/hydrodyn/src/SS_Excitation_Types.f90 +++ b/modules/hydrodyn/src/SS_Excitation_Types.f90 @@ -50,7 +50,7 @@ MODULE SS_Excitation_Types ! ======================= ! ========= SS_Exc_ContinuousStateType ======= TYPE, PUBLIC :: SS_Exc_ContinuousStateType - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: x !< Continuous States [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x !< Continuous States [-] END TYPE SS_Exc_ContinuousStateType ! ======================= ! ========= SS_Exc_DiscreteStateType ======= @@ -585,7 +585,7 @@ SUBROUTINE SS_Exc_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Int_BufSz = Int_BufSz + 1 ! x allocated yes/no IF ( ALLOCATED(InData%x) ) THEN Int_BufSz = Int_BufSz + 2*1 ! x upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%x) ! x + Db_BufSz = Db_BufSz + SIZE(InData%x) ! x END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) @@ -625,8 +625,8 @@ SUBROUTINE SS_Exc_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - ReKiBuf(Re_Xferred) = InData%x(i1) - Re_Xferred = Re_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%x(i1) + Db_Xferred = Db_Xferred + 1 END DO END IF END SUBROUTINE SS_Exc_PackContState @@ -672,8 +672,8 @@ SUBROUTINE SS_Exc_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, RETURN END IF DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) - OutData%x(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 + OutData%x(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 END DO END IF END SUBROUTINE SS_Exc_UnPackContState diff --git a/modules/hydrodyn/src/WAMIT.txt b/modules/hydrodyn/src/WAMIT.txt index bf5c92d65a..b4aedf027e 100644 --- a/modules/hydrodyn/src/WAMIT.txt +++ b/modules/hydrodyn/src/WAMIT.txt @@ -35,7 +35,7 @@ typedef ^ ^ ReKi typedef ^ ^ INTEGER NStepWave - - - "" - typedef ^ ^ INTEGER NStepWave2 - - - "" - typedef ^ ^ ReKi WaveDOmega - - - "" - -typedef ^ ^ SiKi WaveElev0 {:} - - "Wave elevation time history at origin (needed for SS_Excitation module)" m +typedef ^ ^ SiKi WaveElev0 {:} - - "Wave elevation time history at origin (needed for SS_Excitation module)" m typedef ^ ^ SiKi WaveElevC0 {:}{:} - - "Discrete Fourier transform of the instantaneous elevation of incident waves at the platform reference point. First column is real part, second column is imaginary part" (meters) typedef ^ ^ SiKi WaveTime {:} - - "" - typedef ^ ^ INTEGER WaveMod - - - "" - @@ -133,7 +133,7 @@ typedef ^ ^ INTEGER typedef ^ ^ INTEGER NumOutAll - - - "" - typedef ^ ^ CHARACTER(20) OutFmt - - - "" - typedef ^ ^ CHARACTER(20) OutSFmt - - - "" - -typedef ^ ^ CHARACTER(10) Delim - - - "" - +typedef ^ ^ CHARACTER(ChanLen) Delim - - - "" - typedef ^ ^ INTEGER UnOutFile - - - "" - # # diff --git a/modules/hydrodyn/src/WAMIT2.txt b/modules/hydrodyn/src/WAMIT2.txt index 5279528267..4226c37ca4 100644 --- a/modules/hydrodyn/src/WAMIT2.txt +++ b/modules/hydrodyn/src/WAMIT2.txt @@ -126,7 +126,7 @@ typedef ^ ^ INTEGER NumOuts typedef ^ ^ INTEGER NumOutAll - - - "" - typedef ^ ^ CHARACTER(20) OutFmt - - - "" - typedef ^ ^ CHARACTER(20) OutSFmt - - - "" - -typedef ^ ^ CHARACTER(10) Delim - - - "" - +typedef ^ ^ CHARACTER(ChanLen) Delim - - - "" - typedef ^ ^ INTEGER UnOutFile - - - "" - diff --git a/modules/hydrodyn/src/WAMIT2_Types.f90 b/modules/hydrodyn/src/WAMIT2_Types.f90 index 97724dd0a9..af1cddd8dd 100644 --- a/modules/hydrodyn/src/WAMIT2_Types.f90 +++ b/modules/hydrodyn/src/WAMIT2_Types.f90 @@ -130,7 +130,7 @@ MODULE WAMIT2_Types INTEGER(IntKi) :: NumOutAll !< [-] CHARACTER(20) :: OutFmt !< [-] CHARACTER(20) :: OutSFmt !< [-] - CHARACTER(10) :: Delim !< [-] + CHARACTER(ChanLen) :: Delim !< [-] INTEGER(IntKi) :: UnOutFile !< [-] END TYPE WAMIT2_ParameterType ! ======================= diff --git a/modules/hydrodyn/src/WAMIT_Types.f90 b/modules/hydrodyn/src/WAMIT_Types.f90 index eeac9d4036..b321d69848 100644 --- a/modules/hydrodyn/src/WAMIT_Types.f90 +++ b/modules/hydrodyn/src/WAMIT_Types.f90 @@ -149,7 +149,7 @@ MODULE WAMIT_Types INTEGER(IntKi) :: NumOutAll !< [-] CHARACTER(20) :: OutFmt !< [-] CHARACTER(20) :: OutSFmt !< [-] - CHARACTER(10) :: Delim !< [-] + CHARACTER(ChanLen) :: Delim !< [-] INTEGER(IntKi) :: UnOutFile !< [-] END TYPE WAMIT_ParameterType ! ======================= diff --git a/modules/hydrodyn/src/Waves2.txt b/modules/hydrodyn/src/Waves2.txt index d0b712d8ab..71aa3c56ad 100644 --- a/modules/hydrodyn/src/Waves2.txt +++ b/modules/hydrodyn/src/Waves2.txt @@ -137,7 +137,7 @@ typedef ^ ^ INTEGER NumOuts typedef ^ ^ INTEGER NumOutAll - - - "" - typedef ^ ^ CHARACTER(20) OutFmt - - - "" - typedef ^ ^ CHARACTER(20) OutSFmt - - - "" - -typedef ^ ^ CHARACTER(10) Delim - - - "" - +typedef ^ ^ CHARACTER(ChanLen) Delim - - - "" - typedef ^ ^ INTEGER UnOutFile - - - "" - diff --git a/modules/hydrodyn/src/Waves2_Types.f90 b/modules/hydrodyn/src/Waves2_Types.f90 index 8f4bb3ef64..affe3fdc41 100644 --- a/modules/hydrodyn/src/Waves2_Types.f90 +++ b/modules/hydrodyn/src/Waves2_Types.f90 @@ -127,7 +127,7 @@ MODULE Waves2_Types INTEGER(IntKi) :: NumOutAll !< [-] CHARACTER(20) :: OutFmt !< [-] CHARACTER(20) :: OutSFmt !< [-] - CHARACTER(10) :: Delim !< [-] + CHARACTER(ChanLen) :: Delim !< [-] INTEGER(IntKi) :: UnOutFile !< [-] END TYPE Waves2_ParameterType ! ======================= From f7c511996de45d60fbc08e0ae164d405686dae9b Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Fri, 15 Nov 2019 09:36:56 -0700 Subject: [PATCH 07/72] Sync ElastoDyn - use 2pi interpolation on a few inputs/outputs - add some init outputs for linear trim solution - modify input/output mesh packing routines for VTK visualization --- modules/elastodyn/src/ElastoDyn.f90 | 30 ++++++++---- modules/elastodyn/src/ElastoDyn_IO.f90 | 11 +++-- modules/elastodyn/src/ElastoDyn_Registry.txt | 12 +++-- modules/elastodyn/src/ElastoDyn_Types.f90 | 49 ++++++++++---------- 4 files changed, 58 insertions(+), 44 deletions(-) diff --git a/modules/elastodyn/src/ElastoDyn.f90 b/modules/elastodyn/src/ElastoDyn.f90 index 04206be782..eaebe4e176 100644 --- a/modules/elastodyn/src/ElastoDyn.f90 +++ b/modules/elastodyn/src/ElastoDyn.f90 @@ -236,6 +236,9 @@ SUBROUTINE ED_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut InitOut%HubHt = p%HubHt InitOut%TwrBasePos = y%TowerLn2Mesh%Position(:,p%TwrNodes + 2) InitOut%HubRad = p%HubRad + InitOut%RotSpeed = p%RotSpeed + InitOut%isFixed_GenDOF = .not. InputFileData%GenDOF + if (.not. p%BD4Blades) then ALLOCATE(InitOut%BldRNodes(p%BldNodes), STAT=ErrStat2) @@ -2063,7 +2066,7 @@ SUBROUTINE Init_DOFparameters( InputFileData, p, ErrStat, ErrMsg ) IF ( p%NumBl == 2 ) THEN p%NDOF = 22 ELSE - p%NDOF = 24 + p%NDOF = ED_MaxDOFs ENDIF p%NAug = p%NDOF + 1 @@ -8547,6 +8550,7 @@ END SUBROUTINE FillAugMat !> This routine allocates the arrays and meshes stored in the ED_OutputType data structure (y), based on the parameters (p). !! Inputs (u) are included only so that output meshes can be siblings of the inputs. !! The routine assumes that the arrays/meshes are not currently allocated (It will produce a fatal error otherwise.) +!! Also note that this must be called after init_u() so that the misc variables that contain the orientations are set. SUBROUTINE ED_AllocOutput( p, m, u, y, ErrStat, ErrMsg ) !.................................................................................................................................. @@ -8622,7 +8626,7 @@ SUBROUTINE ED_AllocOutput( p, m, u, y, ErrStat, ErrMsg ) IF (ErrStat >= AbortErrLev) RETURN ! Use orientation at node 1 for the blade root - CALL MeshPositionNode ( y%BladeLn2Mesh(K), p%BldNodes + 2, (/0.0_ReKi, 0.0_ReKi, 0.0_ReKi /), ErrStat2, ErrMsg2, Orient=u%BladePtLoads(K)%RefOrientation(:,:,1) ) + CALL MeshPositionNode ( y%BladeLn2Mesh(K), p%BldNodes + 2, (/0.0_ReKi, 0.0_ReKi, 0.0_ReKi /), ErrStat2, ErrMsg2, Orient=u%BladePtLoads(K)%RefOrientation(:,:,1), ref=.true. ) CALL CheckError( ErrStat2, ErrMsg2 ) IF (ErrStat >= AbortErrLev) RETURN @@ -8632,6 +8636,7 @@ SUBROUTINE ED_AllocOutput( p, m, u, y, ErrStat, ErrMsg ) DO J = 0,p%TipNode,p%TipNode if (j==0) then ! blade root NodeNum = p%BldNodes + 2 + y%BladeLn2Mesh(K)%RefNode = NodeNum elseif (j==p%TipNode) then ! blade tip NodeNum = p%BldNodes + 1 end if @@ -8749,7 +8754,7 @@ SUBROUTINE ED_AllocOutput( p, m, u, y, ErrStat, ErrMsg ) CALL CheckError(ErrStat2,ErrMsg2) IF (ErrStat >= AbortErrLev) RETURN - CALL MeshPositionNode ( y%TowerLn2Mesh, p%TwrNodes + 2, (/0.0_ReKi, 0.0_ReKi, p%TowerBsHt /), ErrStat2, ErrMsg2 ) + CALL MeshPositionNode ( y%TowerLn2Mesh, p%TwrNodes + 2, (/0.0_ReKi, 0.0_ReKi, p%TowerBsHt /), ErrStat2, ErrMsg2, ref=.true. ) CALL CheckError(ErrStat2,ErrMsg2) IF (ErrStat >= AbortErrLev) RETURN @@ -11630,7 +11635,7 @@ SUBROUTINE Compute_dY(p, y_p, y_m, delta, dY) END SUBROUTINE Compute_dY !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to pack the data structures representing the operating points into arrays for linearization. -SUBROUTINE ED_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op ) +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, NeedLogMap ) 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) @@ -11649,6 +11654,7 @@ SUBROUTINE ED_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 + LOGICAL, OPTIONAL, INTENT(IN ) :: NeedLogMap !< whether a y_op values should contain log maps instead of full orientation matrices @@ -11657,6 +11663,7 @@ SUBROUTINE ED_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ED_GetOP' + LOGICAL :: ReturnLogMap 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 @@ -11707,6 +11714,11 @@ SUBROUTINE ED_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, !.................................. IF ( PRESENT( y_op ) ) THEN + if (present(NeedLogMap)) then + ReturnLogMap = NeedLogMap + else + ReturnLogMap = .false. + end if if (.not. allocated(y_op)) then ! our operating point includes DCM (orientation) matrices, not just small angles like the perturbation matrices do @@ -11742,13 +11754,13 @@ SUBROUTINE ED_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, call PackMotionMesh(y%BladeLn2Mesh(k), y_op, index) end do end if - call PackMotionMesh(y%PlatformPtMesh, y_op, index) - call PackMotionMesh(y%TowerLn2Mesh, y_op, index) - call PackMotionMesh(y%HubPtMotion, y_op, index, FieldMask=Mask) + call PackMotionMesh(y%PlatformPtMesh, y_op, index, UseLogMaps=ReturnLogMap) + call PackMotionMesh(y%TowerLn2Mesh, y_op, index, UseLogMaps=ReturnLogMap) + call PackMotionMesh(y%HubPtMotion, y_op, index, FieldMask=Mask, UseLogMaps=ReturnLogMap) do k=1,p%NumBl - call PackMotionMesh(y%BladeRootMotion(k), y_op, index) + call PackMotionMesh(y%BladeRootMotion(k), y_op, index, UseLogMaps=ReturnLogMap) end do - call PackMotionMesh(y%NacelleMotion, y_op, index) + call PackMotionMesh(y%NacelleMotion, y_op, index, UseLogMaps=ReturnLogMap) y_op(index) = y%Yaw ; index = index + 1 y_op(index) = y%YawRate ; index = index + 1 diff --git a/modules/elastodyn/src/ElastoDyn_IO.f90 b/modules/elastodyn/src/ElastoDyn_IO.f90 index 6aa3f98b6b..2d1018fdcc 100644 --- a/modules/elastodyn/src/ElastoDyn_IO.f90 +++ b/modules/elastodyn/src/ElastoDyn_IO.f90 @@ -5182,11 +5182,12 @@ SUBROUTINE ValidatePrimaryData( InputFileData, BD4Blades, Linearize, ErrStat, Er END IF - ! Check that InputFileData%OutFmt is a valid format specifier and will fit over the column headings - CALL ChkRealFmtStr( InputFileData%OutFmt, 'OutFmt', FmtWidth, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2,ErrStat,ErrMsg,RoutineName ) - IF ( FmtWidth /= ChanLen ) CALL SetErrStat(ErrID_Warn, 'OutFmt produces a column width of '//TRIM(Num2LStr(FmtWidth))//& - ' instead of '//TRIM(Num2LStr(ChanLen))//' characters.',ErrStat,ErrMsg,RoutineName ) + !bjj: since ED doesn't actually use OutFmt at this point, I'm going to remove this check and warning message + !!!! ! Check that InputFileData%OutFmt is a valid format specifier and will fit over the column headings + !!!!CALL ChkRealFmtStr( InputFileData%OutFmt, 'OutFmt', FmtWidth, ErrStat2, ErrMsg2 ) + !!!!CALL SetErrStat(ErrStat2, ErrMsg2,ErrStat,ErrMsg,RoutineName ) + !!!!IF ( FmtWidth /= ChanLen ) CALL SetErrStat(ErrID_Warn, 'OutFmt produces a column width of '//TRIM(Num2LStr(FmtWidth))//& + !!!! ' instead of '//TRIM(Num2LStr(ChanLen))//' characters.',ErrStat,ErrMsg,RoutineName ) RETURN diff --git a/modules/elastodyn/src/ElastoDyn_Registry.txt b/modules/elastodyn/src/ElastoDyn_Registry.txt index 13a3d4290f..ef2fc56d52 100644 --- a/modules/elastodyn/src/ElastoDyn_Registry.txt +++ b/modules/elastodyn/src/ElastoDyn_Registry.txt @@ -40,6 +40,8 @@ typedef ^ InitOutputType ReKi TwrHNodes {:} - - "Location of variable-spaced tow typedef ^ InitOutputType ReKi PlatformPos {6} - - "Initial platform position (6 DOFs)" typedef ^ InitOutputType ReKi TwrBasePos {3} - - "initial position of the tower base (for SrvD)" m 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 isFixed_GenDOF - - - "whether the generator is fixed or free" - 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" - typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_u {:} - - "Names of the inputs used in linearization" - @@ -811,7 +813,7 @@ typedef ^ InputType MeshType NacelleLoads - - - "From ServoDyn/TMD: loads on the # Define inputs that are not on a mesh here: typedef ^ InputType ReKi TwrAddedMass {:}{:}{:} - - "6-by-6 added mass matrix of the tower elements, per unit length-bjj: place on a mesh" "per unit length" typedef ^ InputType ReKi PtfmAddedMass {6}{6} - - "Platform added mass matrix" "kg, kg-m, kg-m^2" -typedef ^ InputType ReKi BlPitchCom {:} - - "Commanded blade pitch angles" radians +typedef ^ InputType ReKi BlPitchCom {:} - 2pi "Commanded blade pitch angles" radians typedef ^ InputType ReKi YawMom - - - "Torque transmitted through the yaw bearing" N-m typedef ^ InputType ReKi GenTrq - - - "Electrical generator torque" N-m typedef ^ InputType ReKi HSSBrTrqC - - - "Commanded HSS brake torque" N-m @@ -831,18 +833,18 @@ typedef ^ OutputType MeshType TowerBaseMotion14 - - - "For AeroDyn 14: motions o # Define outputs that are not on this mesh here: typedef ^ OutputType ReKi WriteOutput {:} - - "Data to be written to an output file: see WriteOutputHdr for names of each variable" "see WriteOutputUnt" -typedef ^ OutputType ReKi BlPitch {:} - - "Current blade pitch angles" radians -typedef ^ OutputType ReKi Yaw - - - "Current nacelle yaw" radians +typedef ^ OutputType ReKi BlPitch {:} - 2pi "Current blade pitch angles" radians +typedef ^ OutputType ReKi Yaw - - 2pi "Current nacelle yaw" radians typedef ^ OutputType ReKi YawRate - - - "Current nacelle yaw rate" rad/s typedef ^ OutputType ReKi LSS_Spd - - - "Low-speed shaft (LSS) speed at entrance to gearbox" rad/s typedef ^ OutputType ReKi HSS_Spd - - - "High-speed shaft (HSS) speed" rad/s typedef ^ OutputType ReKi RotSpeed - - - "Rotor azimuth angular speed" rad/s typedef ^ OutputType ReKi TwrAccel - - - "Tower acceleration for tower feedback control (user routine only)" m/s^2 -typedef ^ OutputType ReKi YawAngle - - - "Yaw angle to be used for yaw error calculations" radians +typedef ^ OutputType ReKi YawAngle - - 2pi "Yaw angle to be used for yaw error calculations" radians typedef ^ OutputType ReKi RootMyc 3 - - "Out-of-plane moment (i.e., the moment caused by out-of-plane forces) at the blade root for each of the blades (max 3)" N-m typedef ^ OutputType ReKi YawBrTAxp - - - "Tower-top / yaw bearing fore-aft (translational) acceleration (absolute)" m/s^2 typedef ^ OutputType ReKi YawBrTAyp - - - "Tower-top / yaw bearing side-to-side (translational) acceleration (absolute)" m/s^2 -typedef ^ OutputType ReKi LSSTipPxa - - - "Rotor azimuth angle (position)" radians +typedef ^ OutputType ReKi LSSTipPxa - - 2pi "Rotor azimuth angle (position)" radians typedef ^ OutputType ReKi RootMxc 3 - - "In-plane moment (i.e., the moment caused by in-plane forces) at the blade root" N-m typedef ^ OutputType ReKi LSSTipMxa - - - "Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader)" N-m typedef ^ OutputType ReKi LSSTipMya - - - "Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader)" N-m diff --git a/modules/elastodyn/src/ElastoDyn_Types.f90 b/modules/elastodyn/src/ElastoDyn_Types.f90 index 8e0ae90bb4..4342da070b 100644 --- a/modules/elastodyn/src/ElastoDyn_Types.f90 +++ b/modules/elastodyn/src/ElastoDyn_Types.f90 @@ -60,6 +60,8 @@ MODULE ElastoDyn_Types REAL(ReKi) , DIMENSION(1:6) :: PlatformPos !< Initial platform position (6 DOFs) [-] REAL(ReKi) , DIMENSION(1:3) :: TwrBasePos !< initial position of the tower base (for SrvD) [m] REAL(ReKi) :: HubRad !< Preconed hub radius (distance from the rotor apex to the blade root) [m] + REAL(ReKi) :: RotSpeed !< Initial or fixed rotor speed [rad/s] + LOGICAL :: isFixed_GenDOF !< whether the generator is fixed or free [-] 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 [-] @@ -1119,6 +1121,8 @@ SUBROUTINE ED_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, Er DstInitOutputData%PlatformPos = SrcInitOutputData%PlatformPos DstInitOutputData%TwrBasePos = SrcInitOutputData%TwrBasePos DstInitOutputData%HubRad = SrcInitOutputData%HubRad + DstInitOutputData%RotSpeed = SrcInitOutputData%RotSpeed + DstInitOutputData%isFixed_GenDOF = SrcInitOutputData%isFixed_GenDOF IF (ALLOCATED(SrcInitOutputData%LinNames_y)) THEN i1_l = LBOUND(SrcInitOutputData%LinNames_y,1) i1_u = UBOUND(SrcInitOutputData%LinNames_y,1) @@ -1355,6 +1359,8 @@ SUBROUTINE ED_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Re_BufSz = Re_BufSz + SIZE(InData%PlatformPos) ! PlatformPos Re_BufSz = Re_BufSz + SIZE(InData%TwrBasePos) ! TwrBasePos Re_BufSz = Re_BufSz + 1 ! HubRad + Re_BufSz = Re_BufSz + 1 ! RotSpeed + Int_BufSz = Int_BufSz + 1 ! isFixed_GenDOF Int_BufSz = Int_BufSz + 1 ! LinNames_y allocated yes/no IF ( ALLOCATED(InData%LinNames_y) ) THEN Int_BufSz = Int_BufSz + 2*1 ! LinNames_y upper/lower bounds for each dimension @@ -1551,6 +1557,10 @@ SUBROUTINE ED_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs END DO ReKiBuf(Re_Xferred) = InData%HubRad Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RotSpeed + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%isFixed_GenDOF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%LinNames_y) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1866,6 +1876,10 @@ SUBROUTINE ED_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er END DO OutData%HubRad = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 + OutData%RotSpeed = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%isFixed_GenDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%isFixed_GenDOF) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_y not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -24365,8 +24379,7 @@ SUBROUTINE ED_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) END DO IF (ALLOCATED(u_out%BlPitchCom) .AND. ALLOCATED(u1%BlPitchCom)) THEN DO i1 = LBOUND(u_out%BlPitchCom,1),UBOUND(u_out%BlPitchCom,1) - b = -(u1%BlPitchCom(i1) - u2%BlPitchCom(i1)) - u_out%BlPitchCom(i1) = u1%BlPitchCom(i1) + b * ScaleFactor + CALL Angles_ExtrapInterp( u1%BlPitchCom(i1), u2%BlPitchCom(i1), tin, u_out%BlPitchCom(i1), tin_out ) END DO END IF ! check if allocated b = -(u1%YawMom - u2%YawMom) @@ -24470,9 +24483,7 @@ SUBROUTINE ED_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM END DO IF (ALLOCATED(u_out%BlPitchCom) .AND. ALLOCATED(u1%BlPitchCom)) THEN DO i1 = LBOUND(u_out%BlPitchCom,1),UBOUND(u_out%BlPitchCom,1) - b = (t(3)**2*(u1%BlPitchCom(i1) - u2%BlPitchCom(i1)) + t(2)**2*(-u1%BlPitchCom(i1) + u3%BlPitchCom(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%BlPitchCom(i1) + t(3)*u2%BlPitchCom(i1) - t(2)*u3%BlPitchCom(i1) ) * scaleFactor - u_out%BlPitchCom(i1) = u1%BlPitchCom(i1) + b + c * t_out + 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 b = (t(3)**2*(u1%YawMom - u2%YawMom) + t(2)**2*(-u1%YawMom + u3%YawMom))* scaleFactor @@ -24617,12 +24628,10 @@ SUBROUTINE ED_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg END IF ! check if allocated IF (ALLOCATED(y_out%BlPitch) .AND. ALLOCATED(y1%BlPitch)) THEN DO i1 = LBOUND(y_out%BlPitch,1),UBOUND(y_out%BlPitch,1) - b = -(y1%BlPitch(i1) - y2%BlPitch(i1)) - y_out%BlPitch(i1) = y1%BlPitch(i1) + b * ScaleFactor + CALL Angles_ExtrapInterp( y1%BlPitch(i1), y2%BlPitch(i1), tin, y_out%BlPitch(i1), tin_out ) END DO END IF ! check if allocated - b = -(y1%Yaw - y2%Yaw) - y_out%Yaw = y1%Yaw + b * ScaleFactor + CALL Angles_ExtrapInterp( y1%Yaw, y2%Yaw, tin, y_out%Yaw, tin_out ) b = -(y1%YawRate - y2%YawRate) y_out%YawRate = y1%YawRate + b * ScaleFactor b = -(y1%LSS_Spd - y2%LSS_Spd) @@ -24633,8 +24642,7 @@ SUBROUTINE ED_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg y_out%RotSpeed = y1%RotSpeed + b * ScaleFactor b = -(y1%TwrAccel - y2%TwrAccel) y_out%TwrAccel = y1%TwrAccel + b * ScaleFactor - b = -(y1%YawAngle - y2%YawAngle) - y_out%YawAngle = y1%YawAngle + b * ScaleFactor + CALL Angles_ExtrapInterp( y1%YawAngle, y2%YawAngle, tin, y_out%YawAngle, tin_out ) DO i1 = LBOUND(y_out%RootMyc,1),UBOUND(y_out%RootMyc,1) b = -(y1%RootMyc(i1) - y2%RootMyc(i1)) y_out%RootMyc(i1) = y1%RootMyc(i1) + b * ScaleFactor @@ -24643,8 +24651,7 @@ SUBROUTINE ED_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg y_out%YawBrTAxp = y1%YawBrTAxp + b * ScaleFactor b = -(y1%YawBrTAyp - y2%YawBrTAyp) y_out%YawBrTAyp = y1%YawBrTAyp + b * ScaleFactor - b = -(y1%LSSTipPxa - y2%LSSTipPxa) - y_out%LSSTipPxa = y1%LSSTipPxa + b * ScaleFactor + CALL Angles_ExtrapInterp( y1%LSSTipPxa, y2%LSSTipPxa, tin, y_out%LSSTipPxa, tin_out ) DO i1 = LBOUND(y_out%RootMxc,1),UBOUND(y_out%RootMxc,1) b = -(y1%RootMxc(i1) - y2%RootMxc(i1)) y_out%RootMxc(i1) = y1%RootMxc(i1) + b * ScaleFactor @@ -24765,14 +24772,10 @@ SUBROUTINE ED_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err END IF ! check if allocated IF (ALLOCATED(y_out%BlPitch) .AND. ALLOCATED(y1%BlPitch)) THEN DO i1 = LBOUND(y_out%BlPitch,1),UBOUND(y_out%BlPitch,1) - b = (t(3)**2*(y1%BlPitch(i1) - y2%BlPitch(i1)) + t(2)**2*(-y1%BlPitch(i1) + y3%BlPitch(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%BlPitch(i1) + t(3)*y2%BlPitch(i1) - t(2)*y3%BlPitch(i1) ) * scaleFactor - y_out%BlPitch(i1) = y1%BlPitch(i1) + b + c * t_out + 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 - b = (t(3)**2*(y1%Yaw - y2%Yaw) + t(2)**2*(-y1%Yaw + y3%Yaw))* scaleFactor - c = ( (t(2)-t(3))*y1%Yaw + t(3)*y2%Yaw - t(2)*y3%Yaw ) * scaleFactor - y_out%Yaw = y1%Yaw + b + c * t_out + CALL Angles_ExtrapInterp( y1%Yaw, y2%Yaw, y3%Yaw, tin, y_out%Yaw, tin_out ) b = (t(3)**2*(y1%YawRate - y2%YawRate) + t(2)**2*(-y1%YawRate + y3%YawRate))* scaleFactor c = ( (t(2)-t(3))*y1%YawRate + t(3)*y2%YawRate - t(2)*y3%YawRate ) * scaleFactor y_out%YawRate = y1%YawRate + b + c * t_out @@ -24788,9 +24791,7 @@ SUBROUTINE ED_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err b = (t(3)**2*(y1%TwrAccel - y2%TwrAccel) + t(2)**2*(-y1%TwrAccel + y3%TwrAccel))* scaleFactor c = ( (t(2)-t(3))*y1%TwrAccel + t(3)*y2%TwrAccel - t(2)*y3%TwrAccel ) * scaleFactor y_out%TwrAccel = y1%TwrAccel + b + c * t_out - b = (t(3)**2*(y1%YawAngle - y2%YawAngle) + t(2)**2*(-y1%YawAngle + y3%YawAngle))* scaleFactor - c = ( (t(2)-t(3))*y1%YawAngle + t(3)*y2%YawAngle - t(2)*y3%YawAngle ) * scaleFactor - y_out%YawAngle = y1%YawAngle + b + c * t_out + CALL Angles_ExtrapInterp( y1%YawAngle, y2%YawAngle, y3%YawAngle, tin, y_out%YawAngle, tin_out ) DO i1 = LBOUND(y_out%RootMyc,1),UBOUND(y_out%RootMyc,1) b = (t(3)**2*(y1%RootMyc(i1) - y2%RootMyc(i1)) + t(2)**2*(-y1%RootMyc(i1) + y3%RootMyc(i1)))* scaleFactor c = ( (t(2)-t(3))*y1%RootMyc(i1) + t(3)*y2%RootMyc(i1) - t(2)*y3%RootMyc(i1) ) * scaleFactor @@ -24802,9 +24803,7 @@ SUBROUTINE ED_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err b = (t(3)**2*(y1%YawBrTAyp - y2%YawBrTAyp) + t(2)**2*(-y1%YawBrTAyp + y3%YawBrTAyp))* scaleFactor c = ( (t(2)-t(3))*y1%YawBrTAyp + t(3)*y2%YawBrTAyp - t(2)*y3%YawBrTAyp ) * scaleFactor y_out%YawBrTAyp = y1%YawBrTAyp + b + c * t_out - b = (t(3)**2*(y1%LSSTipPxa - y2%LSSTipPxa) + t(2)**2*(-y1%LSSTipPxa + y3%LSSTipPxa))* scaleFactor - c = ( (t(2)-t(3))*y1%LSSTipPxa + t(3)*y2%LSSTipPxa - t(2)*y3%LSSTipPxa ) * scaleFactor - y_out%LSSTipPxa = y1%LSSTipPxa + b + c * t_out + CALL Angles_ExtrapInterp( y1%LSSTipPxa, y2%LSSTipPxa, y3%LSSTipPxa, tin, y_out%LSSTipPxa, tin_out ) DO i1 = LBOUND(y_out%RootMxc,1),UBOUND(y_out%RootMxc,1) b = (t(3)**2*(y1%RootMxc(i1) - y2%RootMxc(i1)) + t(2)**2*(-y1%RootMxc(i1) + y3%RootMxc(i1)))* scaleFactor c = ( (t(2)-t(3))*y1%RootMxc(i1) + t(3)*y2%RootMxc(i1) - t(2)*y3%RootMxc(i1) ) * scaleFactor From 30e4fd986c77e1e0c59ded37f52f5d0a9c5a2e86 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Fri, 15 Nov 2019 09:55:35 -0700 Subject: [PATCH 08/72] Sync AeroDyn - added nodal outputs ([optional] change in input file) -- CHECK value of ChanLen - placeholder for NeedWriteOutput - updated routine to compute AD_JacobianPInput (will not give error about being non-differentiable) --- .../aerodyn/examples/ad_primary_example.inp | 16 +- modules/aerodyn/CMakeLists.txt | 1 + modules/aerodyn/src/AeroDyn.f90 | 330 ++++++- .../aerodyn/src/AeroDyn_AllBldNdOuts_IO.f90 | 846 ++++++++++++++++++ modules/aerodyn/src/AeroDyn_IO.f90 | 86 +- modules/aerodyn/src/AeroDyn_Registry.txt | 14 + modules/aerodyn/src/AeroDyn_Types.f90 | 301 +++++++ modules/aerodyn/src/DBEMT.f90 | 4 +- modules/aerodyn/src/UnsteadyAero.f90 | 4 - modules/openfast-library/src/FAST_Lin.f90 | 29 +- .../src/OutListParameters.xlsx | Bin 107107 -> 207757 bytes vs-build/FASTlib/FASTlib.vfproj | 1 + 12 files changed, 1567 insertions(+), 65 deletions(-) create mode 100644 modules/aerodyn/src/AeroDyn_AllBldNdOuts_IO.f90 diff --git a/docs/source/user/aerodyn/examples/ad_primary_example.inp b/docs/source/user/aerodyn/examples/ad_primary_example.inp index d4e6b5a685..590e71eacf 100644 --- a/docs/source/user/aerodyn/examples/ad_primary_example.inp +++ b/docs/source/user/aerodyn/examples/ad_primary_example.inp @@ -83,4 +83,18 @@ True SumPrint - Generate a summary file listing input option "B1N1Alpha, B1N2Alpha, B1N3Alpha" "B1N1Theta, B1N2Theta, B1N3Theta" END of input file (the word "END" must appear in the first 3 columns of this last OutList line) ---------------------------------------------------------------------------------------- +====== Outputs for all blade stations (same ending as above for B1N1.... =========================== [optional section] + 1 BldNd_BladesOut - Number of blades to output all node information at. Up to number of blades on turbine. (-) + "All" BldNd_BlOutNd - Future feature will allow selecting a portion of the nodes to output. Not implemented yet. (-) + OutList - The next line(s) contains a list of output parameters. See OutListParameters.xlsx for a listing of available output channels, (-) +"Fx, Fy" +"Vx, Vy" +Vrel +TnInd +AxInd +Theta +Phi +Vindx +Vindy +Alpha +END (of optional nodal output section) diff --git a/modules/aerodyn/CMakeLists.txt b/modules/aerodyn/CMakeLists.txt index db590322c8..ea3acc5ce0 100644 --- a/modules/aerodyn/CMakeLists.txt +++ b/modules/aerodyn/CMakeLists.txt @@ -27,6 +27,7 @@ endif() set(AD_LIBS_SOURCES src/AeroDyn.f90 src/AeroDyn_IO.f90 + src/AeroDyn_AllBldNdOuts_IO.f90 src/AirfoilInfo.f90 src/BEMT.f90 src/DBEMT.f90 diff --git a/modules/aerodyn/src/AeroDyn.f90 b/modules/aerodyn/src/AeroDyn.f90 index cd3349e10e..85785acff2 100644 --- a/modules/aerodyn/src/AeroDyn.f90 +++ b/modules/aerodyn/src/AeroDyn.f90 @@ -1,7 +1,7 @@ !********************************************************************************************************************************** ! LICENSING ! Copyright (C) 2015-2016 National Renewable Energy Laboratory -! Copyright (C) 2016-2018 Envision Energy USA, LTD +! Copyright (C) 2016-2019 Envision Energy USA, LTD ! ! This file is part of AeroDyn. ! @@ -93,11 +93,11 @@ subroutine AD_SetInitOut(p, InputFileData, InitOut, errStat, errMsg) errMsg = "" InitOut%AirDens = p%AirDens - - call AllocAry( InitOut%WriteOutputHdr, p%numOuts, 'WriteOutputHdr', errStat2, errMsg2 ) + + call AllocAry( InitOut%WriteOutputHdr, p%numOuts + p%BldNd_TotNumOuts, 'WriteOutputHdr', errStat2, errMsg2 ) call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - call AllocAry( InitOut%WriteOutputUnt, p%numOuts, 'WriteOutputUnt', errStat2, errMsg2 ) + call AllocAry( InitOut%WriteOutputUnt, p%numOuts + p%BldNd_TotNumOuts, 'WriteOutputUnt', errStat2, errMsg2 ) call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) if (ErrStat >= AbortErrLev) return @@ -168,7 +168,11 @@ subroutine AD_SetInitOut(p, InputFileData, InitOut, errStat, errMsg) InitOut%WriteOutputUnt(i) = p%OutParam(i)%Units end do #endif - + + + ! Set the info in WriteOutputHdr and WriteOutputUnt + CALL AllBldNdOuts_InitOut( InitOut, p, InputFileData, ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) InitOut%Ver = AD_Ver @@ -644,8 +648,8 @@ subroutine Init_y(y, u, p, errStat, errMsg) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) end do - - call AllocAry( y%WriteOutput, p%numOuts, 'WriteOutput', errStat2, errMsg2 ) + + call AllocAry( y%WriteOutput, p%numOuts + p%BldNd_TotNumOuts, 'WriteOutput', errStat2, errMsg2 ) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) if (ErrStat >= AbortErrLev) RETURN @@ -974,7 +978,16 @@ subroutine SetParameters( InitInp, InputFileData, p, ErrStat, ErrMsg ) call setErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if (ErrStat >= AbortErrLev) return -#endif +#endif + + + + ! Set the nodal output parameters. Note there is some validation in this, so we might get an error from here. + CALL AllBldNdOuts_SetParameters( InitInp, InputFileData, p, ErrStat2, ErrMsg2 ) + call setErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + + end subroutine SetParameters !---------------------------------------------------------------------------------------------------------------------------------- @@ -1107,7 +1120,7 @@ end subroutine AD_UpdateStates !! This subroutine is used to compute the output channels (motions and loads) and place them in the WriteOutput() array. !! The descriptions of the output channels are not given here. Please see the included OutListParameters.xlsx sheet for !! for a complete description of each output parameter. -subroutine AD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) +subroutine AD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, NeedWriteOutput ) ! NOTE: no matter how many channels are selected for output, all of the outputs are calculated ! All of the calculated output channels are placed into the m%AllOuts(:), while the channels selected for outputs are ! placed in the y%WriteOutput(:) array. @@ -1125,6 +1138,7 @@ subroutine AD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) 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 + LOGICAL, OPTIONAL, INTENT(IN ) :: NeedWriteOutput !< Flag to determine if WriteOutput values need to be calculated in this call integer, parameter :: indx = 1 ! m%BEMT_u(1) is at t; m%BEMT_u(2) is t+dt @@ -1135,10 +1149,17 @@ subroutine AD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_CalcOutput' real(ReKi) :: SigmaCavitCrit, SigmaCavit - + LOGICAL :: CalcWriteOutput + ErrStat = ErrID_None ErrMsg = "" + if (present(NeedWriteOutput)) then + CalcWriteOutput = NeedWriteOutput + else + CalcWriteOutput = .true. ! by default, calculate WriteOutput unless told that we do not need it + end if + call SetInputs(p, u, m, indx, errStat2, errMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1182,28 +1203,36 @@ subroutine AD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) !------------------------------------------------------- ! get values to output to file: !------------------------------------------------------- - if (p%NumOuts > 0) then + if (CalcWriteOutput) then + if (p%NumOuts > 0) then #ifdef DBG_OUTS - call Calc_WriteDbgOutput( p, u, m, y, ErrStat2, ErrMsg2 ) + call Calc_WriteDbgOutput( p, u, m, y, ErrStat2, ErrMsg2 ) #else - call Calc_WriteOutput( p, u, m, y, OtherState, indx, ErrStat2, ErrMsg2 ) + call Calc_WriteOutput( p, u, m, y, OtherState, indx, ErrStat2, ErrMsg2 ) #endif - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - !............................................................................................................................... - ! Place the selected output channels into the WriteOutput(:) array with the proper sign: - !............................................................................................................................... + !............................................................................................................................... + ! Place the selected output channels into the WriteOutput(:) array with the proper sign: + !............................................................................................................................... - do i = 1,p%NumOuts ! Loop through all selected output channels + do i = 1,p%NumOuts ! Loop through all selected output channels #ifdef DBG_OUTS - y%WriteOutput(i) = m%AllOuts( i ) + y%WriteOutput(i) = m%AllOuts( i ) #else - y%WriteOutput(i) = p%OutParam(i)%SignM * m%AllOuts( p%OutParam(i)%Indx ) + y%WriteOutput(i) = p%OutParam(i)%SignM * m%AllOuts( p%OutParam(i)%Indx ) #endif + end do ! i - All selected output channels - end do ! i - All selected output channels - + end if + + y%WriteOutput(p%NumOuts+1:) = 0.0_ReKi + + ! Now we need to populate the blade node outputs here + call Calc_WriteAllBldNdOutput( p, u, m, y, OtherState, indx, ErrStat2, ErrMsg2 ) ! Call after normal writeoutput. Will just postpend data on here. + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end if + @@ -1245,7 +1274,7 @@ subroutine AD_CalcConstrStateResidual( Time, u, p, x, xd, z, OtherState, m, z_re end if - call SetInputs(p, u, m, indx, errStat2, errMsg2) + call SetInputs(p, u, m, indx, errStat2, errMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1350,7 +1379,7 @@ subroutine SetInputsForBEMT(p, u, m, indx, errStat, errMsg) end if ! "Angular velocity of rotor" rad/s - m%BEMT_u(indx)%omega = dot_product( u%HubMotion%RotationVel(:,1), x_hat_disk ) + m%BEMT_u(indx)%omega = dot_product( u%HubMotion%RotationVel(:,1), x_hat_disk ) ! "Angle between the vector normal to the rotor plane and the wind vector (e.g., the yaw angle in the case of no tilt)" rad tmp_sz = TwoNorm( m%V_diskAvg ) @@ -2431,6 +2460,206 @@ END SUBROUTINE TwrInfl_NearestPoint !> 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) +!.................................................................................................................................. + + 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_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(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(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) :: dZdu(:,:) !< Partial derivatives of constraint state functions (Z) with + !! respect to the inputs (u) [intent in to avoid deallocation] + ! local variables + TYPE(AD_OutputType) :: y_p + TYPE(AD_OutputType) :: y_m + TYPE(AD_ContinuousStateType) :: x_copy + TYPE(AD_DiscreteStateType) :: xd_copy + TYPE(AD_ConstraintStateType) :: z_copy + TYPE(AD_OtherStateType) :: OtherState_copy + TYPE(AD_InputType) :: u_perturb(1) + REAL(R8Ki) :: delta_p, delta_m ! delta change in input + INTEGER(IntKi) :: i, j, k, n + + 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 + integer(intKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_JacobianPInput' + + + ! Initialize ErrStat + + ErrStat = ErrID_None + ErrMsg = '' + + + ! get OP values here: + !call AD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat2, ErrMsg2 ) + call SetInputsForBEMT(p, 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 + call BEMT_CopyInput( m%BEMT_u(indx), m%BEMT_u(op_indx), MESH_UPDATECOPY, ErrStat2, ErrMsg2) ! copy the BEMT OP inputs to a temporary location that won't be overwritten + 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 + + + if ( p%FrozenWake ) then + ! compare arguments with call to BEMT_CalcOutput + call computeFrozenWake(m%BEMT_u(op_indx), p%BEMT, m%BEMT_y, m%BEMT ) + m%BEMT%UseFrozenWake = .true. + end if + + + ! make a copy of the inputs to perturb + call AD_CopyInput( u, u_perturb(1), 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: + + ! 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 + + + ! make a copy of outputs because we will need two for the central difference computations (with orientations) + call AD_CopyOutput( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AD_CopyOutput( y, y_m, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + ! make a copy of the states to perturb + call AD_CopyContState( x, x_copy, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AD_CopyDiscState( xd, xd_copy, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AD_CopyConstrState( z, z_copy, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AD_CopyOtherState( OtherState, 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_CopyInput( u, u_perturb(1), 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(1), delta_p ) + + call AD_CopyContState( x, x_copy, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AD_CopyDiscState( xd, xd_copy, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AD_CopyConstrState( z, z_copy, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AD_CopyOtherState( OtherState, OtherState_copy, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + + 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) + + ! compute y at u_op + delta_p u + call AD_CalcOutput( t, u_perturb(1), p, x_copy, xd_copy, z_copy, OtherState_copy, 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 AD_CopyInput( u, u_perturb(1), 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(1), delta_m ) + + call AD_CopyContState( x, x_copy, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AD_CopyDiscState( xd, xd_copy, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AD_CopyConstrState( z, z_copy, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AD_CopyOtherState( OtherState, OtherState_copy, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + 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) + + + ! compute y at u_op - delta_m u + call AD_CalcOutput( t, u_perturb(1), p, x_copy, xd_copy, z_copy, OtherState_copy, 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, delta_m, dYdu(:,i) ) + + end do + + + if (ErrStat>=AbortErrLev) then + call cleanup() + return + end if + + END IF + + IF ( PRESENT( dXdu ) ) THEN + if (allocated(dXdu)) deallocate(dXdu) + END IF + + IF ( PRESENT( dXddu ) ) THEN + if (allocated(dXddu)) deallocate(dXddu) + END IF + + IF ( PRESENT( dZdu ) ) THEN + if (allocated(dZdu)) deallocate(dZdu) + END IF + + call cleanup() +contains + subroutine cleanup() + m%BEMT%UseFrozenWake = .false. + + call AD_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) + call AD_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) + call AD_DestroyContState( x_copy, ErrStat2, ErrMsg2) + call AD_DestroyDiscState( xd_copy, ErrStat2, ErrMsg2) + call AD_DestroyConstrState( z_copy, ErrStat2, ErrMsg2) + call AD_DestroyOtherState( OtherState_copy, ErrStat2, ErrMsg2) + + call AD_DestroyInput( u_perturb(1), ErrStat2, ErrMsg2 ) + end subroutine cleanup + +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 AD_JacobianPInput_orig( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) +! This routine should be used instead of AD_JacobianPInput iff `OLD_AD_LINEAR` is defined in the FAST glue code. !.................................................................................................................................. REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point @@ -2463,7 +2692,8 @@ SUBROUTINE AD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM TYPE(AD_InputType) :: u_perturb REAL(R8Ki) :: delta_p, delta_m ! delta change in input INTEGER(IntKi) :: i, j, k, n - logical :: ValidInput + logical :: ValidInput_p + logical :: ValidInput_m 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 @@ -2536,13 +2766,13 @@ SUBROUTINE AD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ! we need to see if these perturbed inputs put us in different solution regions: call SetInputsForBEMT(p, 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 - ValidInput = CheckBEMTInputPerturbations( p, m ) + ValidInput_p = CheckBEMTInputPerturbations( p, m ) ! if so, we do a 1-sided difference: - if (.not. ValidInput) then + if (.not. ValidInput_p) then call AD_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 - delta_p = 0 + delta_p = 0.0_R8Ki end if @@ -2559,14 +2789,14 @@ SUBROUTINE AD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ! we need to see if these perturbed inputs put us in different solution regions: call SetInputsForBEMT(p, 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 - ValidInput = CheckBEMTInputPerturbations( p, m ) + ValidInput_m = CheckBEMTInputPerturbations( p, m ) ! if so, we do a 1-sided difference: - if (.not. ValidInput) then + if (.not. ValidInput_m) then call AD_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 - delta_m = 0 - if (EqualRealNos(delta_p, 0.0_R8Ki)) then + delta_m = 0.0_R8Ki + if (.not. ValidInput_p) then call SetErrStat(ErrID_Fatal,'Both sides of central difference equation change solution region. '// & 'dYdu cannot be calculated for column '//trim(num2lstr(i))//'.',ErrStat,ErrMsg,RoutineName) return @@ -2636,13 +2866,13 @@ SUBROUTINE AD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ! we need to see if these perturbed inputs put us in different solution regions: call SetInputsForBEMT(p, 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 - ValidInput = CheckBEMTInputPerturbations( p, m ) + ValidInput_p = CheckBEMTInputPerturbations( p, m ) ! if so, we do a 1-sided difference: - if (.not. ValidInput) then + if (.not. ValidInput_p) then call AD_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 - delta_p = 0 + delta_p = 0.0_R8Ki end if @@ -2659,14 +2889,14 @@ SUBROUTINE AD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ! we need to see if these perturbed inputs put us in different solution regions: call SetInputsForBEMT(p, 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 - ValidInput = CheckBEMTInputPerturbations( p, m ) + ValidInput_m = CheckBEMTInputPerturbations( p, m ) ! if so, we do a 1-sided difference: - if (.not. ValidInput) then + if (.not. ValidInput_m) then call AD_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 - delta_m = 0 - if (EqualRealNos(delta_p, 0.0_R8Ki)) then + delta_m = 0.0_R8Ki + if (.not. ValidInput_p) then call SetErrStat(ErrID_Fatal,'Both sides of central difference equation change solution region. '// & 'dYdu cannot be calculated for column '//trim(num2lstr(i))//'.',ErrStat,ErrMsg,RoutineName) return @@ -2716,7 +2946,7 @@ subroutine cleanup() call AD_DestroyInput( u_perturb, ErrStat2, ErrMsg2 ) end subroutine cleanup -END SUBROUTINE AD_JacobianPInput +END SUBROUTINE AD_JacobianPInput_orig !---------------------------------------------------------------------------------------------------------------------------------- !> 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. @@ -2923,8 +3153,6 @@ SUBROUTINE AD_JacobianPConstrState( t, u, p, x, xd, z, OtherState, y, m, ErrStat ErrStat = ErrID_None ErrMsg = '' - -!bjj: how do I figure out if F is 0??? In that case, need to se dY/dz = 0 and dZ/dz = 1 {and need to ask jmj if this is the whole matrix or just a row/column where it applies} ! get OP values here: !call AD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat2, ErrMsg2 ) ! (bjj: is this necessary? if not, still need to get BEMT inputs) @@ -3238,7 +3466,7 @@ SUBROUTINE AD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, end do index = index - 1 - do i=1,p%NumOuts + do i=1,p%NumOuts + p%BldNd_TotNumOuts y_op(i+index) = y%WriteOutput(i) end do @@ -3300,8 +3528,8 @@ SUBROUTINE Init_Jacobian_y( p, y, InitOut, ErrStat, ErrMsg) ! determine how many outputs there are in the Jacobians - p%Jac_ny = y%TowerLoad%NNodes * 6 & ! 3 forces + 3 moments at each node - + p%NumOuts ! WriteOutput values + p%Jac_ny = y%TowerLoad%NNodes * 6 & ! 3 forces + 3 moments at each node + + p%NumOuts + p%BldNd_TotNumOuts ! WriteOutput values do k=1,p%NumBlades p%Jac_ny = p%Jac_ny + y%BladeLoad(k)%NNodes * 6 ! 3 forces + 3 moments at each node @@ -3324,7 +3552,7 @@ SUBROUTINE Init_Jacobian_y( p, y, InitOut, ErrStat, ErrMsg) 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 - do i=1,p%NumOuts + 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 @@ -3384,6 +3612,12 @@ SUBROUTINE Init_Jacobian_y( p, y, InitOut, ErrStat, ErrMsg) 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 SUBROUTINE Init_Jacobian_y @@ -3770,7 +4004,7 @@ SUBROUTINE Compute_dY(p, y_p, y_m, delta_p, delta_m, dY) end do - do k=1,p%NumOuts + do k=1,p%NumOuts + p%BldNd_TotNumOuts dY(k+indx_first-1) = y_p%WriteOutput(k) - y_m%WriteOutput(k) end do @@ -3852,7 +4086,7 @@ FUNCTION CheckBEMTInputPerturbations( p, m ) RESULT(ValidPerturb) do k=1,p%NumBlades do j=1,p%NumBlNds - ! don't allow the input perturbations to change Vx or Vy so that Vx=0 or Vy=0: + ! don't allow the input perturbations to change Vx or Vy so that Vx=0 and Vy=0: if ( EqualRealNos( m%BEMT_u(indx)%Vx(j,k), 0.0_ReKi ) .and. EqualRealNos( m%BEMT_u(indx)%Vy(j,k), 0.0_ReKi ) ) then ValidPerturb = .false. return diff --git a/modules/aerodyn/src/AeroDyn_AllBldNdOuts_IO.f90 b/modules/aerodyn/src/AeroDyn_AllBldNdOuts_IO.f90 new file mode 100644 index 0000000000..46f7dc2289 --- /dev/null +++ b/modules/aerodyn/src/AeroDyn_AllBldNdOuts_IO.f90 @@ -0,0 +1,846 @@ +! This module is an add on to AeroDyn 15 to allow output of Aerodynamic data at each blade node. +! +! Copyright 2016 Envision Energy +! +MODULE AeroDyn_AllBldNdOuts_IO + + USE NWTC_Library + USE NWTC_LAPACK + USE AeroDyn_Types + + IMPLICIT NONE + + PRIVATE + + PUBLIC :: AllBldNdOuts_InitOut + PUBLIC :: Calc_WriteAllBldNdOutput + PUBLIC :: AllBldNdOuts_SetParameters + + + ! Parameters related to output length (number of characters allowed in the output data headers): + + INTEGER(IntKi), PARAMETER :: OutStrLenM1 = ChanLen - 16 ! The NREL allowed channel name length is usually 10. We are making these of the form AeroB#_Z######y_namesuffix + + +! =================================================================================================== +! NOTE: The following lines of code were generated by a Matlab script called "Write_ChckOutLst.m" +! using the parameters listed in the "OutListParameters.xlsx" Excel file. Any changes to these +! lines should be modified in the Matlab script and/or Excel worksheet as necessary. +! =================================================================================================== +! This code was generated by Write_ChckOutLst.m at 12-Dec-2017 22:02:25. + + + ! NOTES: + ! (1) These parameters are in the order stored in "OutListParameters.xlsx" + + + ! Blade: + + INTEGER(IntKi), PARAMETER :: BldNd_VUndx = 1 + INTEGER(IntKi), PARAMETER :: BldNd_VUndy = 2 + INTEGER(IntKi), PARAMETER :: BldNd_VUndz = 3 + INTEGER(IntKi), PARAMETER :: BldNd_VDisx = 4 + INTEGER(IntKi), PARAMETER :: BldNd_VDisy = 5 + INTEGER(IntKi), PARAMETER :: BldNd_VDisz = 6 + INTEGER(IntKi), PARAMETER :: BldNd_STVx = 7 + INTEGER(IntKi), PARAMETER :: BldNd_STVy = 8 + INTEGER(IntKi), PARAMETER :: BldNd_STVz = 9 + INTEGER(IntKi), PARAMETER :: BldNd_VRel = 10 + INTEGER(IntKi), PARAMETER :: BldNd_DynP = 11 + INTEGER(IntKi), PARAMETER :: BldNd_Re = 12 + INTEGER(IntKi), PARAMETER :: BldNd_M = 13 + INTEGER(IntKi), PARAMETER :: BldNd_Vindx = 14 + INTEGER(IntKi), PARAMETER :: BldNd_Vindy = 15 + INTEGER(IntKi), PARAMETER :: BldNd_AxInd = 16 + INTEGER(IntKi), PARAMETER :: BldNd_TnInd = 17 + INTEGER(IntKi), PARAMETER :: BldNd_Alpha = 18 + INTEGER(IntKi), PARAMETER :: BldNd_Theta = 19 + INTEGER(IntKi), PARAMETER :: BldNd_Phi = 20 + INTEGER(IntKi), PARAMETER :: BldNd_Curve = 21 + INTEGER(IntKi), PARAMETER :: BldNd_Cl = 22 + INTEGER(IntKi), PARAMETER :: BldNd_Cd = 23 + INTEGER(IntKi), PARAMETER :: BldNd_Cm = 24 + INTEGER(IntKi), PARAMETER :: BldNd_Cx = 25 + INTEGER(IntKi), PARAMETER :: BldNd_Cy = 26 + INTEGER(IntKi), PARAMETER :: BldNd_Cn = 27 + INTEGER(IntKi), PARAMETER :: BldNd_Ct = 28 + INTEGER(IntKi), PARAMETER :: BldNd_Fl = 29 + INTEGER(IntKi), PARAMETER :: BldNd_Fd = 30 + INTEGER(IntKi), PARAMETER :: BldNd_Mm = 31 + INTEGER(IntKi), PARAMETER :: BldNd_Fx = 32 + INTEGER(IntKi), PARAMETER :: BldNd_Fy = 33 + INTEGER(IntKi), PARAMETER :: BldNd_Fn = 34 + INTEGER(IntKi), PARAMETER :: BldNd_Ft = 35 + INTEGER(IntKi), PARAMETER :: BldNd_Clrnc = 36 + INTEGER(IntKi), PARAMETER :: BldNd_Vx = 37 + INTEGER(IntKi), PARAMETER :: BldNd_Vy = 38 + INTEGER(IntKi), PARAMETER :: BldNd_GeomPhi = 39 + INTEGER(IntKi), PARAMETER :: BldNd_Chi = 40 + INTEGER(IntKi), PARAMETER :: BldNd_UA_Flag = 41 + + ! The maximum number of output channels which can be output by the code. + INTEGER(IntKi), PARAMETER, PUBLIC :: BldNd_MaxOutPts = 41 + +!End of code generated by Matlab script +! =================================================================================================== + +CONTAINS +!---------------------------------------------------------------------------------------------------------------------------------- + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This subroutine populates the headers with the blade node outputs. The iteration cycle is blade:node:channel (channel iterated +!! fastest). If this iteration order is changed, it should be changed in the Calc_WriteAllBldNdOutput routine as well. +SUBROUTINE AllBldNdOuts_InitOut( InitOut, p, InputFileData, ErrStat, ErrMsg ) + + TYPE(AD_InitOutputType), INTENT(INOUT) :: InitOut ! output data + TYPE(AD_ParameterType), INTENT(IN ) :: p ! The module parameters + TYPE(AD_InputFile), INTENT(IN ) :: InputFileData ! All the data in the AeroDyn input file (want Blade Span for channel name) + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! The error status code + CHARACTER(*), INTENT( OUT) :: ErrMsg ! The error message, if an error occurred + + INTEGER(IntKi) :: INDX ! Index count within WriteOutput + INTEGER(IntKi) :: IdxBlade ! Counter to which blade we are on + INTEGER(IntKi) :: IdxNode ! Counter to the blade node we ae on + INTEGER(IntKi) :: IdxChan ! Counter to the channel we are outputting. + CHARACTER(16) :: ChanPrefix ! Name prefix (AeroB#_Z######y_) + CHARACTER(6) :: TmpChar ! Temporary char array to hold the node digits (2 places only!!!!) + CHARACTER(*), PARAMETER :: RoutineName = ('AllBldNdOuts_InitOut') + + + ! Initialize some things + ErrMsg = '' + ErrStat = ErrID_None + + + ! Warn if we will run into issues with more than 99 nodes. + IF (p%NumBlNds > 99 ) CALL SetErrStat(ErrID_Severe,'More than 99 blade nodes in use. Output channel headers will not '// & + 'correctly reflect blade stations beyond 99. Modifications to the variable ChanLen in FAST are required.',ErrStat,ErrMsg,RoutineName) + + + ! Populate the header an unit lines for all blades and nodes + ! First set a counter so we know where in the output array we are in + INDX = p%NumOuts + 1 ! p%NumOuts is the number of outputs from the normal AeroDyn output. The WriteOutput array is sized to p%NumOuts + num(AllBldNdOuts) + + DO IdxChan=1,p%BldNd_NumOuts + + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + + ! Create the name prefix: + WRITE (TmpChar,'(I2.2)') IdxNode ! 2 digit number + ChanPrefix = 'B' // TRIM(Num2LStr(IdxBlade)) // 'N' // TRIM(TmpChar) // '_' + ! Now write to the header + InitOut%WriteOutputHdr(INDX) = trim(ChanPrefix) // p%BldNd_OutParam(IdxChan)%Name + InitOut%WriteOutputUnt(INDX) = p%BldNd_OutParam(IdxChan)%Units + + ! Increment the index to the Header arrays + INDX = INDX + 1 + + ENDDO + ENDDO + + ENDDO + +END SUBROUTINE AllBldNdOuts_InitOut + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This subroutine populates the headers with the blade node outputs. The iteration cycle is channel:blade:node (node iterated +!! fastest). If this iteration order is changed, it should be changed in the Calc_WriteAllBldNdOutput routine as well. +!! +!! NOTE: the equations here came from the output section of AeroDyn_IO.f90. If anything changes in there, it needs to be reflected +!! here. + +SUBROUTINE Calc_WriteAllBldNdOutput( p, u, m, y, OtherState, Indx, ErrStat, ErrMsg ) + TYPE(AD_ParameterType), INTENT(IN ) :: p ! The module parameters + TYPE(AD_InputType), INTENT(IN ) :: u ! inputs + TYPE(AD_MiscVarType), INTENT(IN ) :: m ! misc variables + TYPE(AD_OutputType), INTENT(INOUT) :: y ! outputs (updates y%WriteOutput) + TYPE(AD_OtherStateType), INTENT(IN ) :: OtherState ! other states + INTEGER, INTENT(IN ) :: Indx ! index into m%BEMT_u(Indx) array; 1=t and 2=t+dt (but not checked here) + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! The error status code + CHARACTER(*), INTENT( OUT) :: ErrMsg ! The error message, if an error occurred + + ! local variables + + INTEGER(IntKi) :: OutIdx ! Index count within WriteOutput + INTEGER(IntKi) :: IdxBlade ! Counter to which blade we are on + INTEGER(IntKi) :: IdxNode ! Counter to the blade node we ae on + INTEGER(IntKi) :: IdxChan ! Counter to the channel we are outputting. + INTEGER(IntKi) :: compIndx ! index for array component (x,y,z) + CHARACTER(*), PARAMETER :: RoutineName = 'Calc_WriteAllBldNdOutput' + REAL(ReKi) :: ct, st ! cosine, sine of theta + REAL(ReKi) :: cp, sp ! cosine, sine of phi + REAL(ReKi) :: Tmp33a(3,3) + REAL(ReKi) :: Tmp33b(3,3) + REAL(R8Ki) :: Tmp33aR8Ki(3,3) + REAL(R8Ki) :: Tmp33bR8Ki(3,3) + REAL(ReKi) :: ThetaYXZ(3) + REAL(ReKi) :: ThetaYXZ_RD(3) + REAL(ReKi) :: BladeLocalOrient(3,3) + + ! Error handling + INTEGER(IntKi) :: ErrStat2 ! Temporary Error status + CHARACTER(ErrMsgLen) :: ErrMsg2 ! Temporary Error message + + + ! Initialize some things + ErrMsg = '' + ErrStat = ErrID_None + + + ! Populate the header an unit lines for all blades and nodes + ! First set a counter so we know where in the output array we are in + OutIdx = p%NumOuts + 1 ! p%NumOuts is the number of outputs from the normal AeroDyn output. The WriteOutput array is sized to p%NumOuts + num(AllBldNdOuts) + + + ! Case to assign output to this channel and populate based on Indx value (this indicates what the channel is) + ! Logic and mathematics used here come from Calc_WriteOutput + DO IdxChan=1,p%BldNd_NumOuts + + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (0) ! Invalid channel + CYCLE + ! ***** Undisturbed wind velocity in local blade coord system ***** + CASE ( BldNd_VUndx ) + + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + + !Tmp3 = matmul( m%WithoutSweepPitchTwist(:,:,IdxNode,IdxBlade), u%InflowOnBlade(:,IdxNode,IdxBlade) ) + !y%WriteOutput( OutIdx ) = Tmp3(1) + y%WriteOutput( OutIdx ) = dot_product( m%WithoutSweepPitchTwist(1,:,IdxNode,IdxBlade), u%InflowOnBlade(:,IdxNode,IdxBlade) ) + + OutIdx = OutIdx + 1 + END DO + END DO + + + CASE ( BldNd_VUndy ) + + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + + !Tmp3 = matmul( m%WithoutSweepPitchTwist(:,:,IdxNode,IdxBlade), u%InflowOnBlade(:,IdxNode,IdxBlade) ) + !y%WriteOutput( OutIdx ) = Tmp3(2) + y%WriteOutput( OutIdx ) = dot_product( m%WithoutSweepPitchTwist(2,:,IdxNode,IdxBlade), u%InflowOnBlade(:,IdxNode,IdxBlade) ) + + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_VUndz ) + + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + + !Tmp3 = matmul( m%WithoutSweepPitchTwist(:,:,IdxNode,IdxBlade), u%InflowOnBlade(:,IdxNode,IdxBlade) ) + !y%WriteOutput( OutIdx ) = Tmp3(3) + y%WriteOutput( OutIdx ) = dot_product( m%WithoutSweepPitchTwist(3,:,IdxNode,IdxBlade), u%InflowOnBlade(:,IdxNode,IdxBlade) ) + + OutIdx = OutIdx + 1 + END DO + END DO + + + + ! ***** Disturbed wind velocity in the local blade coordinate system ***** + CASE ( BldNd_VDisx ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + + !Tmp3 = matmul( m%WithoutSweepPitchTwist(:,:,IdxNode,IdxBlade), m%DisturbedInflow(:,IdxNode,IdxBlade) ) + !y%WriteOutput( OutIdx ) = Tmp3(1) + y%WriteOutput( OutIdx ) = dot_product( m%WithoutSweepPitchTwist(1,:,IdxNode,IdxBlade), m%DisturbedInflow(:,IdxNode,IdxBlade) ) + + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_VDisy ) + + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + + !Tmp3 = matmul( m%WithoutSweepPitchTwist(:,:,IdxNode,IdxBlade), m%DisturbedInflow(:,IdxNode,IdxBlade) ) + !y%WriteOutput( OutIdx ) = Tmp3(2) + y%WriteOutput( OutIdx ) = dot_product( m%WithoutSweepPitchTwist(2,:,IdxNode,IdxBlade), m%DisturbedInflow(:,IdxNode,IdxBlade) ) + + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_VDisz ) + + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + + !Tmp3 = matmul( m%WithoutSweepPitchTwist(:,:,IdxNode,IdxBlade), m%DisturbedInflow(:,IdxNode,IdxBlade) ) + !y%WriteOutput( OutIdx ) = Tmp3(3) + y%WriteOutput( OutIdx ) = dot_product( m%WithoutSweepPitchTwist(3,:,IdxNode,IdxBlade), m%DisturbedInflow(:,IdxNode,IdxBlade) ) + + OutIdx = OutIdx + 1 + END DO + END DO + + + ! ***** Structural translational velocity in the local blade coordinate system ***** + CASE ( BldNd_STVx ) + + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + !Tmp3 = matmul( m%WithoutSweepPitchTwist(:,:,IdxNode,IdxBlade), u%BladeMotion(IdxBlade)%TranslationVel(:,IdxNode) ) + !y%WriteOutput( OutIdx ) = Tmp3(1) + y%WriteOutput( OutIdx ) = dot_product( m%WithoutSweepPitchTwist(1,:,IdxNode,IdxBlade), u%BladeMotion(IdxBlade)%TranslationVel(:,IdxNode) ) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_STVy ) + + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + !Tmp3 = matmul( m%WithoutSweepPitchTwist(:,:,IdxNode,IdxBlade), u%BladeMotion(IdxBlade)%TranslationVel(:,IdxNode) ) + !y%WriteOutput( OutIdx ) = Tmp3(2) + y%WriteOutput( OutIdx ) = dot_product( m%WithoutSweepPitchTwist(2,:,IdxNode,IdxBlade), u%BladeMotion(IdxBlade)%TranslationVel(:,IdxNode) ) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_STVz ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + !Tmp3 = matmul( m%WithoutSweepPitchTwist(:,:,IdxNode,IdxBlade), u%BladeMotion(IdxBlade)%TranslationVel(:,IdxNode) ) + !y%WriteOutput( OutIdx ) = Tmp3(3) + y%WriteOutput( OutIdx ) = dot_product( m%WithoutSweepPitchTwist(3,:,IdxNode,IdxBlade), u%BladeMotion(IdxBlade)%TranslationVel(:,IdxNode) ) + OutIdx = OutIdx + 1 + END DO + END DO + + + ! Relative wind speed + CASE ( BldNd_VRel ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%BEMT_y%Vrel(IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + END DO + END DO + + ! Dynamic pressure + CASE ( BldNd_DynP ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = 0.5 * p%airDens * m%BEMT_y%Vrel(IdxNode,IdxBlade)**2 + OutIdx = OutIdx + 1 + END DO + END DO + + ! Reynolds number (in millions) + CASE ( BldNd_Re ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = p%BEMT%chord(IdxNode,IdxBlade) * m%BEMT_y%Vrel(IdxNode,IdxBlade) / p%KinVisc / 1.0E6 + OutIdx = OutIdx + 1 + END DO + END DO + + ! Mach number + CASE ( BldNd_M ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%BEMT_y%Vrel(IdxNode,IdxBlade) / p%SpdSound + OutIdx = OutIdx + 1 + END DO + END DO + + + ! Axial and tangential induced wind velocity + CASE ( BldNd_Vindx ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = - m%BEMT_u(Indx)%Vx(IdxNode,IdxBlade) * m%BEMT_y%axInduction( IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_Vindy ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%BEMT_u(Indx)%Vy(IdxNode,IdxBlade) * m%BEMT_y%tanInduction(IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + END DO + END DO + + + ! Axial and tangential induction factors + CASE ( BldNd_AxInd ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%BEMT_y%axInduction(IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_TnInd ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%BEMT_y%tanInduction(IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + END DO + END DO + + + ! AoA, pitch+twist angle, inflow angle, and curvature angle + CASE ( BldNd_Alpha ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = Rad2M180to180Deg( m%BEMT_y%phi(IdxNode,IdxBlade) - m%BEMT_u(Indx)%theta(IdxNode,IdxBlade) ) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_Theta ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%BEMT_u(Indx)%theta(IdxNode,IdxBlade)*R2D + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_Phi ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%BEMT_y%phi(IdxNode,IdxBlade)*R2D + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_Curve ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%Curve(IdxNode,IdxBlade)*R2D + OutIdx = OutIdx + 1 + END DO + END DO + + + ! Lift force, drag force, pitching moment coefficients + CASE ( BldNd_Cl ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%BEMT_y%Cl(IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_Cd ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%BEMT_y%Cd(IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_Cm ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%BEMT_y%Cm(IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + END DO + END DO + + ! Normal force (to plane), tangential force (to plane) coefficients + CASE ( BldNd_Cx ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%BEMT_y%Cx(IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_Cy ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%BEMT_y%Cy(IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + END DO + END DO + + ! Normal force (to chord), and tangential force (to chord) coefficients + CASE ( BldNd_Cn ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + ct=cos(m%BEMT_u(Indx)%theta(IdxNode,IdxBlade)) + st=sin(m%BEMT_u(Indx)%theta(IdxNode,IdxBlade)) + y%WriteOutput( OutIdx ) = m%BEMT_y%Cx(IdxNode,IdxBlade)*ct + m%BEMT_y%Cy(IdxNode,IdxBlade)*st + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_Ct ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + ct=cos(m%BEMT_u(Indx)%theta(IdxNode,IdxBlade)) + st=sin(m%BEMT_u(Indx)%theta(IdxNode,IdxBlade)) + y%WriteOutput( OutIdx ) = -m%BEMT_y%Cx(IdxNode,IdxBlade)*st + m%BEMT_y%Cy(IdxNode,IdxBlade)*ct + OutIdx = OutIdx + 1 + END DO + END DO + + + ! Lift force, drag force, pitching moment + CASE ( BldNd_Fl ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + cp=cos(m%BEMT_y%phi(IdxNode,IdxBlade)) + sp=sin(m%BEMT_y%phi(IdxNode,IdxBlade)) + y%WriteOutput( OutIdx ) = m%X(IdxNode,IdxBlade)*cp - m%Y(IdxNode,IdxBlade)*sp + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_Fd ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + cp=cos(m%BEMT_y%phi(IdxNode,IdxBlade)) + sp=sin(m%BEMT_y%phi(IdxNode,IdxBlade)) + y%WriteOutput( OutIdx ) = m%X(IdxNode,IdxBlade)*sp + m%Y(IdxNode,IdxBlade)*cp + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_Mm ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%M(IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + END DO + END DO + + ! Normal force (to plane), tangential force (to plane) + CASE ( BldNd_Fx ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%X(IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_Fy ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = -m%Y(IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + END DO + END DO + + ! Normal force (to chord), and tangential force (to chord) per unit length + CASE ( BldNd_Fn ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + ct=cos(m%BEMT_u(Indx)%theta(IdxNode,IdxBlade)) + st=sin(m%BEMT_u(Indx)%theta(IdxNode,IdxBlade)) + y%WriteOutput( OutIdx ) = m%X(IdxNode,IdxBlade)*ct - m%Y(IdxNode,IdxBlade)*st + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_Ft ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + ct=cos(m%BEMT_u(Indx)%theta(IdxNode,IdxBlade)) + st=sin(m%BEMT_u(Indx)%theta(IdxNode,IdxBlade)) + y%WriteOutput( OutIdx ) = -m%X(IdxNode,IdxBlade)*st - m%Y(IdxNode,IdxBlade)*ct + OutIdx = OutIdx + 1 + END DO + END DO + + ! Tower clearance (requires tower influence calculation): + CASE ( BldNd_Clrnc ) + if (.not. allocated(m%TwrClrnc)) then + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = 0.0_ReKi + OutIdx = OutIdx + 1 + END DO + END DO + else + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%TwrClrnc(IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + END DO + END DO + end if + + + CASE ( BldNd_Vx ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%BEMT_u(Indx)%Vx(IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_Vy ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%BEMT_u(Indx)%Vy(IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_GeomPhi ) + if (allocated(OtherState%BEMT%ValidPhi)) then + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + if (OtherState%BEMT%ValidPhi(IdxNode,IdxBlade)) then + y%WriteOutput( OutIdx ) = 0.0_ReKi + else + y%WriteOutput( OutIdx ) = 1.0_ReKi + end if + OutIdx = OutIdx + 1 + END DO + END DO + else + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = 1.0_ReKi + OutIdx = OutIdx + 1 + END DO + END DO + end if + + CASE ( BldNd_chi ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%BEMT_y%chi(IdxNode,IdxBlade)*R2D + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_UA_Flag ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,u%BladeMotion(IdxBlade)%NNodes ! Note p%node_total is total number of nodes including all elements + IF ( OtherState%BEMT%UA_Flag(IdxNode, IdxBlade) ) THEN + y%WriteOutput( OutIdx ) = 1.0_ReKi + ELSE + y%WriteOutput( OutIdx ) = 0.0_ReKi + ENDIF + OutIdx = OutIdx + 1 + ENDDO + ENDDO + + + END SELECT + + END DO ! each channel + + +END SUBROUTINE Calc_WriteAllBldNdOutput + + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine validates and sets the parameters for the nodal outputs. +SUBROUTINE AllBldNdOuts_SetParameters( InitInp, InputFileData, p, ErrStat, ErrMsg ) +!.................................................................................................................................. + + + ! Passed variables: + + TYPE(AD_InitInputType), intent(IN ) :: InitInp !< Input data for initialization routine, out is needed because of copy below + TYPE(AD_InputFile), INTENT(IN ) :: InputFileData !< Data stored in the module's input file + TYPE(AD_ParameterType), 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 + character(*), parameter :: RoutineName = 'AllBldNdOuts_SetParameters' + + ErrStat = ErrID_None + ErrMsg = "" + + + ! Check if the requested blades exist + IF ( (InputFileData%BldNd_BladesOut < 0_IntKi) .OR. (InputFileData%BldNd_BladesOut > p%NumBlades) ) THEN + CALL SetErrStat( ErrID_Warn, " Number of blades to output data at all blade nodes (BldNd_BladesOut) must be between 0 and "//TRIM(Num2LStr(p%NumBlades))//".", ErrStat, ErrMsg, RoutineName) + p%BldNd_BladesOut = 0_IntKi + ELSE + p%BldNd_BladesOut = InputFileData%BldNd_BladesOut + ENDIF + + + ! Check if the requested blade nodes are valid + ! InputFileData%BldNd_BlOutNd + + + ! Set the parameter to store number of requested Blade Node output sets + p%BldNd_NumOuts = InputFileData%BldNd_NumOuts + + ! Set the total number of outputs ( requested channel groups * number requested nodes * number requested blades ) + p%BldNd_TotNumOuts = p%BldNd_NumOuts*p%NumBlNds*p%BldNd_BladesOut ! p%BldNd_NumOuts * size(p%BldNd_BlOutNd) * size(p%BldNd_BladesOut) + +! ! Check if the blade node array to output is valid: p%BldNd_BlOutNd +! ! TODO: this value is not read in by the input file reading yet, so setting to all blade nodes +! ! -- check if list handed in is of nodes that exist (not sure this is ever checked) +! ! -- copy values over +! +! ! Temporary workaround here: +! ALLOCATE ( p%BldNd_BlOutNd(1:p%NumBlNds) , STAT=ErrStat2 ) +! IF ( ErrStat2 /= 0_IntKi ) THEN +! CALL SetErrStat( ErrID_Fatal,"Error allocating memory for the AeroDyn OutParam array.", ErrStat, ErrMsg, RoutineName ) +! RETURN +! ENDIF +! DO I=1,p%NumBlNds ! put all nodes in the list +! p%BldNd_BlOutNd(i) = i +! ENDDO + + +! ! Check if the requested blades are actually in use: +! ! TODO: this value is not read in by the input file reading yet, so setting to all blades +! ! -- check if list handed in is of blades that exist (not sure this is ever checked) +! ! -- copy values over +! ALLOCATE ( p%BldNd_BladesOut(1:p%NumBlades), STAT=ErrStat2 ) +! IF ( ErrStat2 /= 0_IntKi ) THEN +! CALL SetErrStat( ErrID_Fatal,"Error allocating memory for the AeroDyn OutParam array.", ErrStat, ErrMsg, RoutineName ) +! RETURN +! ENDIF +! DO I=1,p%NumBlades ! put all blades in the list +! p%BldNd_BladesOut(i) = i +! ENDDO + + if (p%BldNd_TotNumOuts > 0) then + call BldNdOuts_SetOutParam(InputFileData%BldNd_OutList, p, ErrStat, ErrMsg ) ! requires: p%NumOuts, p%numBlades, p%NumBlNds, p%NumTwrNds; sets: p%BldNdOutParam. + if (ErrStat >= AbortErrLev) return + end if + + + +END SUBROUTINE AllBldNdOuts_SetParameters + + +!********************************************************************************************************************************** +! NOTE: The following lines of code were generated by a Matlab script called "Write_ChckOutLst.m" +! using the parameters listed in the "OutListParameters.xlsx" Excel file. Any changes to these +! lines should be modified in the Matlab script and/or Excel worksheet as necessary. +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine checks to see if any requested output channel names (stored in the OutList(:)) are invalid. It returns a +!! warning if any of the channels are not available outputs from the module. +!! It assigns the settings for OutParam(:) (i.e, the index, name, and units of the output channels, WriteOutput(:)). +!! the sign is set to 0 if the channel is invalid. +!! It sets assumes the value p%NumOuts has been set before this routine has been called, and it sets the values of p%OutParam here. +!! +!! This routine was generated by Write_ChckOutLst.m using the parameters listed in OutListParameters.xlsx at 12-Dec-2017 22:08:06. +SUBROUTINE BldNdOuts_SetOutParam(BldNd_OutList, p, ErrStat, ErrMsg ) +!.................................................................................................................................. + + IMPLICIT NONE + + ! Passed variables + + CHARACTER(ChanLen), INTENT(IN) :: BldNd_OutList(:) !< The list out user-requested outputs + TYPE(AD_ParameterType), INTENT(INOUT) :: p !< The module parameters + INTEGER(IntKi), INTENT(OUT) :: ErrStat !< The error status code + CHARACTER(*), INTENT(OUT) :: ErrMsg !< The error message, if an error occurred + + ! Local variables + + INTEGER :: ErrStat2 ! temporary (local) error status + INTEGER :: I ! Generic loop-counting index + INTEGER :: J ! Generic loop-counting index + INTEGER :: INDX ! Index for valid arrays + + LOGICAL :: InvalidOutput(1:BldNd_MaxOutPts) ! This array determines if the output channel is valid for this configuration + CHARACTER(ChanLen) :: OutListTmp ! A string to temporarily hold OutList(I) + CHARACTER(*), PARAMETER :: RoutineName = "BldNdOuts_SetOutParam" + + CHARACTER(OutStrLenM1), PARAMETER :: ValidParamAry(41) = (/ & ! This lists the names of the allowed parameters, which must be sorted alphabetically + "ALPHA ","AXIND ","CD ","CHI ", & + "CL ","CLRNC ","CM ","CN ","CT ","CURVE ","CX ","CY ","DYNP ", & + "FD ","FL ","FN ","FT ","FX ","FY ","GEOMPHI ","M ","MM ", & + "PHI ","RE ","STVX ", & + "STVY ","STVZ ","THETA ","TNIND ","UA_FLAG ", & + "VDISX ","VDISY ","VDISZ ","VINDX ","VINDY ","VREL ","VUNDX ","VUNDY ","VUNDZ ", & + "VX ","VY "/) + INTEGER(IntKi), PARAMETER :: ParamIndxAry(41) = (/ & ! This lists the index into AllOuts(:) of the allowed parameters ValidParamAry(:) + BldNd_Alpha , BldNd_AxInd , BldNd_Cd , BldNd_Chi , & + BldNd_Cl , BldNd_Clrnc , BldNd_Cm , BldNd_Cn , BldNd_Ct , BldNd_Curve , BldNd_Cx , BldNd_Cy , BldNd_DynP , & + BldNd_Fd , BldNd_Fl , BldNd_Fn , BldNd_Ft , BldNd_Fx , BldNd_Fy , BldNd_GeomPhi , BldNd_M , BldNd_Mm , & + BldNd_Phi , BldNd_Re , BldNd_STVx , & + BldNd_STVy , BldNd_STVz , BldNd_Theta , BldNd_TnInd , BldNd_UA_Flag , & + BldNd_VDisx , BldNd_VDisy , BldNd_VDisz , BldNd_Vindx , BldNd_Vindy , BldNd_VRel , BldNd_VUndx , BldNd_VUndy , BldNd_VUndz , & + BldNd_Vx , BldNd_Vy /) + CHARACTER(ChanLen), PARAMETER :: ParamUnitsAry(41) = (/ & ! This lists the units corresponding to the allowed parameters + "(deg) ","(-) ","(-) ","(deg) ", & + "(-) ","(m) ","(-) ","(-) ","(-) ","(deg) ","(-) ","(-) ","(Pa) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(1/0) ","(-) ","(N-m/m)", & + "(deg) ","(-) ","(m/s) ", & + "(m/s) ","(m/s) ","(deg) ","(-) ","(-) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) "/) + + + ! Initialize values + ErrStat = ErrID_None + ErrMsg = "" + InvalidOutput = .FALSE. + + +! ..... Developer must add checking for invalid inputs here: ..... + +! ................. End of validity checking ................. + + + !------------------------------------------------------------------------------------------------- + ! Allocate and set index, name, and units for the output channels + ! If a selected output channel is not available in this module, set error flag. + !------------------------------------------------------------------------------------------------- + + ALLOCATE ( p%BldNd_OutParam(1:p%BldNd_NumOuts) , STAT=ErrStat2 ) + IF ( ErrStat2 /= 0_IntKi ) THEN + CALL SetErrStat( ErrID_Fatal,"Error allocating memory for the AeroDyn BldNd_OutParam array.", ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + + + ! Set index, name, and units for all of the output channels. + ! If a selected output channel is not available by this module set ErrStat = ErrID_Warn. + + DO I = 1,p%BldNd_NumOuts + + p%BldNd_OutParam(I)%Name = BldNd_OutList(I) + OutListTmp = BldNd_OutList(I) + p%BldNd_OutParam(I)%SignM = 1 ! this won't be used + + CALL Conv2UC( OutListTmp ) ! Convert OutListTmp to upper case + + + Indx = IndexCharAry( OutListTmp(1:OutStrLenM1), ValidParamAry ) + + IF ( Indx > 0 ) THEN ! we found the channel name + IF ( InvalidOutput( ParamIndxAry(Indx) ) ) THEN ! but, it isn't valid for these settings + p%BldNd_OutParam(I)%Indx = 0 ! pick any valid channel (I just picked "Time=0" here because it's universal) + p%BldNd_OutParam(I)%Units = "INVALID" + p%BldNd_OutParam(I)%SignM = 0 + ELSE + p%BldNd_OutParam(I)%Indx = ParamIndxAry(Indx) + p%BldNd_OutParam(I)%Units = ParamUnitsAry(Indx) ! it's a valid output + END IF + ELSE ! this channel isn't valid + p%BldNd_OutParam(I)%Indx = 0 ! pick any valid channel (I just picked "Time=0" here because it's universal) + p%BldNd_OutParam(I)%Units = "INVALID" + p%BldNd_OutParam(I)%SignM = 0 ! multiply all results by zero + + CALL SetErrStat(ErrID_Fatal, TRIM(p%BldNd_OutParam(I)%Name)//" is not an available output channel.",ErrStat,ErrMsg,RoutineName) + END IF + + END DO + + RETURN +END SUBROUTINE BldNdOuts_SetOutParam +!---------------------------------------------------------------------------------------------------------------------------------- +!End of code generated by Matlab script +!********************************************************************************************************************************** + +END MODULE AeroDyn_AllBldNdOuts_IO diff --git a/modules/aerodyn/src/AeroDyn_IO.f90 b/modules/aerodyn/src/AeroDyn_IO.f90 index 09d924c45b..94f803eb83 100644 --- a/modules/aerodyn/src/AeroDyn_IO.f90 +++ b/modules/aerodyn/src/AeroDyn_IO.f90 @@ -24,6 +24,7 @@ MODULE AeroDyn_IO use AeroDyn_Types use BEMTUncoupled, only : SkewMod_Uncoupled, SkewMod_PittPeters, VelocityIsZero + USE AeroDyn_AllBldNdOuts_IO implicit none @@ -1884,6 +1885,7 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, ADBlFile, OutFileRoot, UnE integer(IntKi) :: ErrStat2, IOS ! Temporary Error status logical :: Echo ! Determines if an echo file should be written character(ErrMsgLen) :: ErrMsg2 ! Temporary Error message + character(ErrMsgLen) :: ErrMsg_NoAllBldNdOuts ! Temporary Error message character(1024) :: PriPath ! Path name of the primary file character(1024) :: FTitle ! "File Title": the 2nd line of the input file, which contains a description of its contents character(200) :: Line ! Temporary storage of a line from the input file (to compare with "default") @@ -1901,7 +1903,11 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, ADBlFile, OutFileRoot, UnE CALL AllocAry( InputFileData%OutList, MaxOutPts, "Outlist", ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - + + ! Allocate array for holding the list of node outputs + CALL AllocAry( InputFileData%BldNd_OutList, BldNd_MaxOutPts, "BldNd_Outlist", ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! Get an available unit number for the file. CALL GetNewUnit( UnIn, ErrStat2, ErrMsg2 ) @@ -2359,6 +2365,75 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, ADBlFile, OutFileRoot, UnE CALL ReadOutputList ( UnIn, InputFile, InputFileData%OutList, InputFileData%NumOuts, 'OutList', "List of user-requested output channels", ErrStat2, ErrMsg2, UnEc ) ! Routine in NWTC Subroutine Library CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! Return on error at end of section + IF ( ErrStat >= AbortErrLev ) THEN + CALL Cleanup() + RETURN + END IF + + !---------------------- END OF FILE ----------------------------------------- + + + + !----------- OUTLIST ----------------------------------------------------------- + ! In case there is something ill-formed in the additional nodal outputs section, we will simply ignore it and assume that it is an NREL compatable input file. + ErrMsg_NoAllBldNdOuts='AllBldNd section of AeroDyn input file not found or improperly formatted. Therefore assuming no nodal outputs.' + + !----------- OUTLIST for BldNd ----------------------------------------------------------- + CALL ReadCom( UnIn, InputFile, 'Section Header: OutList for Blade node channels', ErrStat2, ErrMsg2, UnEc ) + IF ( ErrStat2 >= AbortErrLev ) THEN + InputFileData%BldNd_NumOuts = 0 + call wrscr( trim(ErrMsg_NoAllBldNdOuts)//' --> '//trim(ErrMsg2) ) + CALL Cleanup() + RETURN + ENDIF + + + ! Number of blade nodes to output: will modify this at some point for arrays + ! TODO: In a future release, allow this to be an array of N blade numbers (change BldNd_BladesOut to an array if we do that). + ! Will likely require reading this line in as a string (BldNd_BladesOut_Str) and parsing it + CALL ReadVar( UnIn, InputFile, InputFileData%BldNd_BladesOut, 'BldNd_BladesOut', 'Which blades to output node data on.'//TRIM(Num2Lstr(I)), ErrStat2, ErrMsg2, UnEc ) + IF ( ErrStat2 >= AbortErrLev ) THEN + InputFileData%BldNd_NumOuts = 0 + call wrscr( trim(ErrMsg_NoAllBldNdOuts)//' --> '//trim(ErrMsg2) ) + CALL Cleanup() + RETURN + ENDIF + + + ! Which blades to output for: will add this at some point + ! TODO: Parse this string into an array of nodes to output at (one idea is to set an array of boolean to T/F for which nodes to output). At present, we ignore it entirely. + CALL ReadVar( UnIn, InputFile, InputFileData%BldNd_BlOutNd_Str, 'BldNd_BlOutNd_Str', 'Which nodes to output node data on.'//TRIM(Num2Lstr(I)), ErrStat2, ErrMsg2, UnEc ) + IF ( ErrStat2 >= AbortErrLev ) THEN + InputFileData%BldNd_NumOuts = 0 + call wrscr( trim(ErrMsg_NoAllBldNdOuts)//' --> '//trim(ErrMsg2) ) + CALL Cleanup() + RETURN + ENDIF + + + ! Section header for outlist + CALL ReadCom( UnIn, InputFile, 'Section Header: OutList', ErrStat2, ErrMsg2, UnEc ) + IF ( ErrStat2 >= AbortErrLev ) THEN + InputFileData%BldNd_NumOuts = 0 + call wrscr( trim(ErrMsg_NoAllBldNdOuts)//' --> '//trim(ErrMsg2) ) + CALL Cleanup() + RETURN + ENDIF + + + ! OutList - List of user-requested output channels at each node(-): + CALL ReadOutputList ( UnIn, InputFile, InputFileData%BldNd_OutList, InputFileData%BldNd_NumOuts, 'OutList', "List of user-requested output channels", ErrStat2, ErrMsg2, UnEc ) ! Routine in NWTC Subroutine Library + IF ( ErrStat2 >= AbortErrLev ) THEN + InputFileData%BldNd_NumOuts = 0 + call wrscr( trim(ErrMsg_NoAllBldNdOuts)//' --> '//trim(ErrMsg2) ) + CALL Cleanup() + RETURN + ENDIF + + + !---------------------- END OF FILE ----------------------------------------- CALL Cleanup( ) @@ -2752,6 +2827,15 @@ SUBROUTINE AD_PrintSum( InputFileData, p, u, y, ErrStat, ErrMsg ) DO I = 0,p%NumOuts WRITE (UnSu,OutPFmt) I, p%OutParam(I)%Name, p%OutParam(I)%Units END DO + + WRITE (UnSu,'(15x,A)') + WRITE (UnSu,'(15x,A)') + WRITE (UnSu,'(15x,A)') 'Requested Output Channels at each blade station:' + WRITE (UnSu,'(15x,A)') 'Col Parameter Units' + WRITE (UnSu,'(15x,A)') '---- -------------- -----' + DO I = 1,p%BldNd_NumOuts + WRITE (UnSu,OutPFmt) I, p%BldNd_OutParam(I)%Name, p%BldNd_OutParam(I)%Units + END DO #endif CLOSE(UnSu) diff --git a/modules/aerodyn/src/AeroDyn_Registry.txt b/modules/aerodyn/src/AeroDyn_Registry.txt index fed1af801e..8258c7a2a2 100644 --- a/modules/aerodyn/src/AeroDyn_Registry.txt +++ b/modules/aerodyn/src/AeroDyn_Registry.txt @@ -109,6 +109,12 @@ typedef ^ AD_InputFile IntKi NumOuts - - - "Number of parameters in the output l typedef ^ AD_InputFile CHARACTER(ChanLen) OutList {:} - - "List of user-requested output channels" - typedef ^ AD_InputFile ReKi tau1_const - - - "time constant for DBEMT [used only when WakeMod=2 and DBEMT_Mod=1]" s typedef ^ AD_InputFile IntKi DBEMT_Mod - - - "Type of dynamic BEMT (DBEMT) model {1=constant tau1, 2=time-dependent tau1}" - +typedef ^ AD_InputFile IntKi BldNd_NumOuts - - - "Number of requested output channels per blade node (AD_AllBldNdOuts)" - +typedef ^ AD_InputFile CHARACTER(ChanLen) BldNd_OutList {:} - - "List of user-requested output channels (AD_AllBldNdOuts)" - +#typedef ^ AD_InputFile IntKi BldNd_BlOutNd {:} - - "The blade nodes to actually output (AD_AllBldNdOuts)" - +typedef ^ AD_InputFile CHARACTER(1024) BldNd_BlOutNd_Str - - - "String to parse for the blade nodes to actually output (AD_AllBldNdOuts)" - +typedef ^ AD_InputFile IntKi BldNd_BladesOut - - - "The blades to output (AD_AllBldNdOuts)" - +#typedef ^ AD_InputFile CHARACTER(1024) BldNd_BladesOut_Str - - - "String to parse for the he blades to output (AD_AllBldNdOuts)" - # ..... States .................................................................................................................... # Define continuous (differentiable) states here: @@ -179,6 +185,14 @@ typedef ^ ParameterType IntKi NBlOuts - - - "Number of blade node outputs [0 - 9 typedef ^ ParameterType IntKi BlOutNd {9} - - "Blade nodes whose values will be output" - typedef ^ ParameterType IntKi NTwOuts - - - "Number of tower node outputs [0 - 9]" - typedef ^ ParameterType IntKi TwOutNd {9} - - "Tower nodes whose values will be output" - + +typedef ^ ParameterType IntKi BldNd_NumOuts - - - "Number of requested output channels per blade node (AD_AllBldNdOuts)" - +typedef ^ ParameterType IntKi BldNd_TotNumOuts - - - "Total number of requested output channels of blade node information (BldNd_NumOuts * BldNd_BlOutNd * BldNd_BladesOut -- AD_AllBldNdOuts)" - +typedef ^ ParameterType OutParmType BldNd_OutParam {:} - - "Names and units (and other characteristics) of all requested output parameters" - +typedef ^ ParameterType IntKi BldNd_BlOutNd {:} - - "The blade nodes to actually output (AD_AllBldNdOuts)" - +typedef ^ ParameterType IntKi BldNd_BladesOut - - - "The blades to output (AD_AllBldNdOuts)" - + + typedef ^ ParameterType Integer Jac_u_indx {:}{:} - - "matrix to help fill/pack the u vector in computing the jacobian" - typedef ^ ParameterType ReKi du {:} - - "vector that determines size of perturbation for u (inputs)" typedef ^ ParameterType Integer Jac_ny - - - "number of outputs in jacobian matrix" - diff --git a/modules/aerodyn/src/AeroDyn_Types.f90 b/modules/aerodyn/src/AeroDyn_Types.f90 index 4fc49e4e75..17b398ce86 100644 --- a/modules/aerodyn/src/AeroDyn_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Types.f90 @@ -136,6 +136,10 @@ MODULE AeroDyn_Types CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutList !< List of user-requested output channels [-] REAL(ReKi) :: tau1_const !< time constant for DBEMT [used only when WakeMod=2 and DBEMT_Mod=1] [s] INTEGER(IntKi) :: DBEMT_Mod !< Type of dynamic BEMT (DBEMT) model {1=constant tau1, 2=time-dependent tau1} [-] + INTEGER(IntKi) :: BldNd_NumOuts !< Number of requested output channels per blade node (AD_AllBldNdOuts) [-] + CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: BldNd_OutList !< List of user-requested output channels (AD_AllBldNdOuts) [-] + CHARACTER(1024) :: BldNd_BlOutNd_Str !< String to parse for the blade nodes to actually output (AD_AllBldNdOuts) [-] + INTEGER(IntKi) :: BldNd_BladesOut !< The blades to output (AD_AllBldNdOuts) [-] END TYPE AD_InputFile ! ======================= ! ========= AD_ContinuousStateType ======= @@ -214,6 +218,11 @@ MODULE AeroDyn_Types INTEGER(IntKi) , DIMENSION(1:9) :: BlOutNd !< Blade nodes whose values will be output [-] INTEGER(IntKi) :: NTwOuts !< Number of tower node outputs [0 - 9] [-] INTEGER(IntKi) , DIMENSION(1:9) :: TwOutNd !< Tower nodes whose values will be output [-] + INTEGER(IntKi) :: BldNd_NumOuts !< Number of requested output channels per blade node (AD_AllBldNdOuts) [-] + INTEGER(IntKi) :: BldNd_TotNumOuts !< Total number of requested output channels of blade node information (BldNd_NumOuts * BldNd_BlOutNd * BldNd_BladesOut -- AD_AllBldNdOuts) [-] + TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: BldNd_OutParam !< Names and units (and other characteristics) of all requested output parameters [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: BldNd_BlOutNd !< The blade nodes to actually output (AD_AllBldNdOuts) [-] + INTEGER(IntKi) :: BldNd_BladesOut !< The blades to output (AD_AllBldNdOuts) [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_u_indx !< matrix to help fill/pack the u vector in computing the jacobian [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: du !< vector that determines size of perturbation for u (inputs) [-] INTEGER(IntKi) :: Jac_ny !< number of outputs in jacobian matrix [-] @@ -2512,6 +2521,21 @@ SUBROUTINE AD_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrSt ENDIF DstInputFileData%tau1_const = SrcInputFileData%tau1_const DstInputFileData%DBEMT_Mod = SrcInputFileData%DBEMT_Mod + DstInputFileData%BldNd_NumOuts = SrcInputFileData%BldNd_NumOuts +IF (ALLOCATED(SrcInputFileData%BldNd_OutList)) THEN + i1_l = LBOUND(SrcInputFileData%BldNd_OutList,1) + i1_u = UBOUND(SrcInputFileData%BldNd_OutList,1) + IF (.NOT. ALLOCATED(DstInputFileData%BldNd_OutList)) THEN + ALLOCATE(DstInputFileData%BldNd_OutList(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%BldNd_OutList.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInputFileData%BldNd_OutList = SrcInputFileData%BldNd_OutList +ENDIF + DstInputFileData%BldNd_BlOutNd_Str = SrcInputFileData%BldNd_BlOutNd_Str + DstInputFileData%BldNd_BladesOut = SrcInputFileData%BldNd_BladesOut END SUBROUTINE AD_CopyInputFile SUBROUTINE AD_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) @@ -2543,6 +2567,9 @@ SUBROUTINE AD_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) ENDIF IF (ALLOCATED(InputFileData%OutList)) THEN DEALLOCATE(InputFileData%OutList) +ENDIF +IF (ALLOCATED(InputFileData%BldNd_OutList)) THEN + DEALLOCATE(InputFileData%BldNd_OutList) ENDIF END SUBROUTINE AD_DestroyInputFile @@ -2672,6 +2699,14 @@ SUBROUTINE AD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg END IF Re_BufSz = Re_BufSz + 1 ! tau1_const Int_BufSz = Int_BufSz + 1 ! DBEMT_Mod + Int_BufSz = Int_BufSz + 1 ! BldNd_NumOuts + Int_BufSz = Int_BufSz + 1 ! BldNd_OutList allocated yes/no + IF ( ALLOCATED(InData%BldNd_OutList) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! BldNd_OutList upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%BldNd_OutList)*LEN(InData%BldNd_OutList) ! BldNd_OutList + END IF + Int_BufSz = Int_BufSz + 1*LEN(InData%BldNd_BlOutNd_Str) ! BldNd_BlOutNd_Str + Int_BufSz = Int_BufSz + 1 ! BldNd_BladesOut IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -2907,6 +2942,31 @@ SUBROUTINE AD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Re_Xferred = Re_Xferred + 1 IntKiBuf(Int_Xferred) = InData%DBEMT_Mod Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%BldNd_NumOuts + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%BldNd_OutList) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BldNd_OutList,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldNd_OutList,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%BldNd_OutList,1), UBOUND(InData%BldNd_OutList,1) + DO I = 1, LEN(InData%BldNd_OutList) + IntKiBuf(Int_Xferred) = ICHAR(InData%BldNd_OutList(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + DO I = 1, LEN(InData%BldNd_BlOutNd_Str) + IntKiBuf(Int_Xferred) = ICHAR(InData%BldNd_BlOutNd_Str(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%BldNd_BladesOut + Int_Xferred = Int_Xferred + 1 END SUBROUTINE AD_PackInputFile SUBROUTINE AD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -3178,6 +3238,34 @@ SUBROUTINE AD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = Re_Xferred + 1 OutData%DBEMT_Mod = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 + OutData%BldNd_NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldNd_OutList not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BldNd_OutList)) DEALLOCATE(OutData%BldNd_OutList) + ALLOCATE(OutData%BldNd_OutList(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutList.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%BldNd_OutList,1), UBOUND(OutData%BldNd_OutList,1) + DO I = 1, LEN(OutData%BldNd_OutList) + OutData%BldNd_OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + DO I = 1, LEN(OutData%BldNd_BlOutNd_Str) + OutData%BldNd_BlOutNd_Str(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%BldNd_BladesOut = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE AD_UnPackInputFile SUBROUTINE AD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) @@ -5680,6 +5768,37 @@ SUBROUTINE AD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) DstParamData%BlOutNd = SrcParamData%BlOutNd DstParamData%NTwOuts = SrcParamData%NTwOuts DstParamData%TwOutNd = SrcParamData%TwOutNd + DstParamData%BldNd_NumOuts = SrcParamData%BldNd_NumOuts + DstParamData%BldNd_TotNumOuts = SrcParamData%BldNd_TotNumOuts +IF (ALLOCATED(SrcParamData%BldNd_OutParam)) THEN + i1_l = LBOUND(SrcParamData%BldNd_OutParam,1) + i1_u = UBOUND(SrcParamData%BldNd_OutParam,1) + IF (.NOT. ALLOCATED(DstParamData%BldNd_OutParam)) THEN + ALLOCATE(DstParamData%BldNd_OutParam(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldNd_OutParam.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcParamData%BldNd_OutParam,1), UBOUND(SrcParamData%BldNd_OutParam,1) + CALL NWTC_Library_Copyoutparmtype( SrcParamData%BldNd_OutParam(i1), DstParamData%BldNd_OutParam(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcParamData%BldNd_BlOutNd)) THEN + i1_l = LBOUND(SrcParamData%BldNd_BlOutNd,1) + i1_u = UBOUND(SrcParamData%BldNd_BlOutNd,1) + IF (.NOT. ALLOCATED(DstParamData%BldNd_BlOutNd)) THEN + ALLOCATE(DstParamData%BldNd_BlOutNd(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldNd_BlOutNd.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%BldNd_BlOutNd = SrcParamData%BldNd_BlOutNd +ENDIF + DstParamData%BldNd_BladesOut = SrcParamData%BldNd_BladesOut IF (ALLOCATED(SrcParamData%Jac_u_indx)) THEN i1_l = LBOUND(SrcParamData%Jac_u_indx,1) i1_u = UBOUND(SrcParamData%Jac_u_indx,1) @@ -5737,6 +5856,15 @@ SUBROUTINE AD_DestroyParam( ParamData, ErrStat, ErrMsg ) ENDDO DEALLOCATE(ParamData%OutParam) ENDIF +IF (ALLOCATED(ParamData%BldNd_OutParam)) THEN +DO i1 = LBOUND(ParamData%BldNd_OutParam,1), UBOUND(ParamData%BldNd_OutParam,1) + CALL NWTC_Library_Destroyoutparmtype( ParamData%BldNd_OutParam(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(ParamData%BldNd_OutParam) +ENDIF +IF (ALLOCATED(ParamData%BldNd_BlOutNd)) THEN + DEALLOCATE(ParamData%BldNd_BlOutNd) +ENDIF IF (ALLOCATED(ParamData%Jac_u_indx)) THEN DEALLOCATE(ParamData%Jac_u_indx) ENDIF @@ -5877,6 +6005,37 @@ SUBROUTINE AD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Int_BufSz = Int_BufSz + SIZE(InData%BlOutNd) ! BlOutNd Int_BufSz = Int_BufSz + 1 ! NTwOuts Int_BufSz = Int_BufSz + SIZE(InData%TwOutNd) ! TwOutNd + Int_BufSz = Int_BufSz + 1 ! BldNd_NumOuts + Int_BufSz = Int_BufSz + 1 ! BldNd_TotNumOuts + Int_BufSz = Int_BufSz + 1 ! BldNd_OutParam allocated yes/no + IF ( ALLOCATED(InData%BldNd_OutParam) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! BldNd_OutParam upper/lower bounds for each dimension + DO i1 = LBOUND(InData%BldNd_OutParam,1), UBOUND(InData%BldNd_OutParam,1) + Int_BufSz = Int_BufSz + 3 ! BldNd_OutParam: size of buffers for each call to pack subtype + CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%BldNd_OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BldNd_OutParam + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! BldNd_OutParam + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! BldNd_OutParam + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! BldNd_OutParam + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! BldNd_BlOutNd allocated yes/no + IF ( ALLOCATED(InData%BldNd_BlOutNd) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! BldNd_BlOutNd upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%BldNd_BlOutNd) ! BldNd_BlOutNd + END IF + Int_BufSz = Int_BufSz + 1 ! BldNd_BladesOut Int_BufSz = Int_BufSz + 1 ! Jac_u_indx allocated yes/no IF ( ALLOCATED(InData%Jac_u_indx) ) THEN Int_BufSz = Int_BufSz + 2*2 ! Jac_u_indx upper/lower bounds for each dimension @@ -6107,6 +6266,68 @@ SUBROUTINE AD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf(Int_Xferred) = InData%TwOutNd(i1) Int_Xferred = Int_Xferred + 1 END DO + IntKiBuf(Int_Xferred) = InData%BldNd_NumOuts + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%BldNd_TotNumOuts + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%BldNd_OutParam) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BldNd_OutParam,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldNd_OutParam,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%BldNd_OutParam,1), UBOUND(InData%BldNd_OutParam,1) + CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%BldNd_OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! BldNd_OutParam + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%BldNd_BlOutNd) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BldNd_BlOutNd,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldNd_BlOutNd,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%BldNd_BlOutNd,1), UBOUND(InData%BldNd_BlOutNd,1) + IntKiBuf(Int_Xferred) = InData%BldNd_BlOutNd(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = InData%BldNd_BladesOut + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%Jac_u_indx) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -6418,6 +6639,86 @@ SUBROUTINE AD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg OutData%TwOutNd(i1) = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 END DO + OutData%BldNd_NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%BldNd_TotNumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldNd_OutParam not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BldNd_OutParam)) DEALLOCATE(OutData%BldNd_OutParam) + ALLOCATE(OutData%BldNd_OutParam(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutParam.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%BldNd_OutParam,1), UBOUND(OutData%BldNd_OutParam,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackoutparmtype( Re_Buf, Db_Buf, Int_Buf, OutData%BldNd_OutParam(i1), ErrStat2, ErrMsg2 ) ! BldNd_OutParam + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldNd_BlOutNd not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BldNd_BlOutNd)) DEALLOCATE(OutData%BldNd_BlOutNd) + ALLOCATE(OutData%BldNd_BlOutNd(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_BlOutNd.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%BldNd_BlOutNd,1), UBOUND(OutData%BldNd_BlOutNd,1) + OutData%BldNd_BlOutNd(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + OutData%BldNd_BladesOut = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_u_indx not allocated Int_Xferred = Int_Xferred + 1 ELSE diff --git a/modules/aerodyn/src/DBEMT.f90 b/modules/aerodyn/src/DBEMT.f90 index 981f5f5f3e..6117d04b34 100644 --- a/modules/aerodyn/src/DBEMT.f90 +++ b/modules/aerodyn/src/DBEMT.f90 @@ -234,9 +234,7 @@ subroutine DBEMT_UpdateStates( i, j, t, u, p, x, OtherState, m, errStat, errMsg ! local variables real(ReKi) :: spanRatio ! local version of r / R - real(ReKi) :: temp, tau2 , A, B, C0, k_tau, C0_2 ! tau1_plus1, C_tau1, C, K1 - real(ReKi) :: Un_disk - real(ReKi) :: AxInd_disk + real(ReKi) :: tau2 , A, B, C0, k_tau, C0_2 ! tau1_plus1, C_tau1, C, K1 integer(IntKi) :: indx character(*), parameter :: RoutineName = 'DBEMT_UpdateStates' diff --git a/modules/aerodyn/src/UnsteadyAero.f90 b/modules/aerodyn/src/UnsteadyAero.f90 index 04efb0fb11..ceeb86e3b6 100644 --- a/modules/aerodyn/src/UnsteadyAero.f90 +++ b/modules/aerodyn/src/UnsteadyAero.f90 @@ -29,7 +29,6 @@ module UnsteadyAero implicit none private - type(ProgDesc), parameter :: UA_Ver = ProgDesc( 'UnsteadyAero', '', '' ) public :: UA_Init public :: UA_UpdateDiscOtherState @@ -916,9 +915,6 @@ subroutine UA_Init( InitInp, u, p, xd, OtherState, y, m, Interval, & ! Initialize the NWTC Subroutine Library call NWTC_Init( EchoLibVer=.FALSE. ) - ! Display the module information - call DispNVD( UA_Ver ) - call UA_ValidateInput(InitInp, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return diff --git a/modules/openfast-library/src/FAST_Lin.f90 b/modules/openfast-library/src/FAST_Lin.f90 index b528e23950..bde1f397a9 100644 --- a/modules/openfast-library/src/FAST_Lin.f90 +++ b/modules/openfast-library/src/FAST_Lin.f90 @@ -491,9 +491,11 @@ SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD1 CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Linearize_OP' - REAL(R8Ki), ALLOCATABLE :: dYdz(:,:), dZdz(:,:), dZdu(:,:) REAL(R8Ki), ALLOCATABLE :: dUdu(:,:), dUdy(:,:) ! variables for glue-code linearization +#ifdef OLD_AD_LINEAR + REAL(R8Ki), ALLOCATABLE :: dYdz(:,:), dZdz(:,:), dZdu(:,:) INTEGER(IntKi), ALLOCATABLE :: ipiv(:) +#endif integer(intki) :: NumBl integer(intki) :: k CHARACTER(1024) :: LinRootName @@ -724,13 +726,19 @@ SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD1 !..................... if ( p_FAST%CompAero == Module_AD ) then ! get the jacobians +#ifdef OLD_AD_LINEAR call AD_JacobianPInput( t_global, AD%Input(1), AD%p, AD%x(STATE_CURR), AD%xd(STATE_CURR), AD%z(STATE_CURR), & AD%OtherSt(STATE_CURR), AD%y, AD%m, ErrStat2, ErrMsg2, dYdu=y_FAST%Lin%Modules(Module_AD)%Instance(1)%D, dZdu=dZdu ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - + call AD_JacobianPConstrState( 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, dYdz=dYdz, dZdz=dZdz ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) +#else + call AD_JacobianPInput( t_global, AD%Input(1), AD%p, AD%x(STATE_CURR), AD%xd(STATE_CURR), AD%z(STATE_CURR), & + AD%OtherSt(STATE_CURR), AD%y, AD%m, ErrStat2, ErrMsg2, dYdu=y_FAST%Lin%Modules(Module_AD)%Instance(1)%D ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) +#endif ! get the operating point call AD_GetOP( t_global, AD%Input(1), AD%p, AD%x(STATE_CURR), AD%xd(STATE_CURR), AD%z(STATE_CURR), & @@ -755,6 +763,7 @@ SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD1 if (p_FAST%LinOutJac) then ! Jacobians +#ifdef OLD_AD_LINEAR ! dZdz: call WrPartialMatrix( dZdz, Un, p_FAST%OutFmt, 'dZdz' ) @@ -763,16 +772,16 @@ SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD1 ! dYdz: call WrPartialMatrix( dYdz, Un, p_FAST%OutFmt, 'dYdz', UseRow=y_FAST%Lin%Modules(Module_AD)%Instance(1)%use_y ) - +#endif !dYdu: call WrPartialMatrix( y_FAST%Lin%Modules(Module_AD)%Instance(1)%D, Un, p_FAST%OutFmt, 'dYdu', & UseRow=y_FAST%Lin%Modules(Module_AD)%Instance(1)%use_y, UseCol=y_FAST%Lin%Modules(Module_AD)%Instance(1)%use_u ) end if +#ifdef OLD_AD_LINEAR end if - call allocAry( ipiv, size(dZdz,1), 'ipiv', ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if (ErrStat >= AbortErrLev) then @@ -794,18 +803,20 @@ SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD1 !y_FAST%Lin%Modules(Module_AD)%D = y_FAST%Lin%Modules(Module_AD)%D - matmul(dYdz, dZdu ) call LAPACK_GEMM( 'N', 'N', -1.0_R8Ki, dYdz, dZdu, 1.0_R8Ki, y_FAST%Lin%Modules(Module_AD)%Instance(1)%D, ErrStat2, ErrMsg2 ) - if (p_FAST%LinOutMod) then +#endif ! finish writing the file call WrLinFile_txt_End(Un, p_FAST, y_FAST%Lin%Modules(Module_AD)%Instance(1) ) end if +#ifdef OLD_AD_LINEAR ! AD doesn't need these any more, and we may need them for other modules if (allocated(dYdz)) deallocate(dYdz) if (allocated(dZdz)) deallocate(dZdz) if (allocated(dZdu)) deallocate(dZdu) - if (allocated(ipiv)) deallocate(ipiv) - + if (allocated(ipiv)) deallocate(ipiv) +#endif + end if !..................... @@ -964,16 +975,18 @@ SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD1 contains subroutine cleanup() +#ifdef OLD_AD_LINEAR if (allocated(dYdz)) deallocate(dYdz) if (allocated(dZdz)) deallocate(dZdz) if (allocated(dZdu)) deallocate(dZdu) if (allocated(ipiv)) deallocate(ipiv) +#endif if (allocated(dUdu)) deallocate(dUdu) if (allocated(dUdy)) deallocate(dUdy) if (Un > 0) close(Un) - + end subroutine cleanup END SUBROUTINE FAST_Linearize_OP !---------------------------------------------------------------------------------------------------------------------------------- diff --git a/modules/openfast-library/src/OutListParameters.xlsx b/modules/openfast-library/src/OutListParameters.xlsx index 915bc3af5b1d5d28ed572b7f0751471fad04ede2..ba2b2a76e2c5d53e4b06ffd58d481d588f2f20aa 100644 GIT binary patch delta 160742 zcma%j19)8TzIAM?vF*lAV_OXxqp{Iw8rxQ*rg3B2HXGYcqXzwUdT{^uJLjHzpJ!)g zz3aEu5ARH7Pxef^-3t@7fJCe;2ML7*1_K5M1_nk3=4L}L+6)c`_6rFN3=<3vB4slJ z9JA^zJOn6ZU2&NetN%RCBV@2aZ96zhI3wK&e3^MFsem$axOhe={tdop1|s7aeM^!Gi}ZthQghj#*2 zwpdTC$ghhr~~CiJ0=@*TZ_{s9}F?_uxutoztuqW~V+; zH&Osf=n&Hp2&yb@uLX@ZdP4`r!95`J;K375Q?6<@(ONrC!8NcT=!V-uEy`P>e(#_nS_Tn^A zE+&m=BF>!7)FGUeGV%6dVefUlU_&$&4O|I1M^RegtXFMc2)~}Ih7M{AcD;a|cX^}= zhBHEiF_z_DehY1K+sXNT7;dyEgUd?LYPQxS|2yFl9lK@=k_r-G14n<{2zX$j5o^$4 z>A*qBBUU}EXcBipF9B2S$w?szi9Fi1Sk<;OsAyOBA~r)GXQf`+yP*q%S;x9Rn#2ZL zpzO<5H$0x#hY58V+q(3NXI8@1vVAHaiEJY=Af9IwrEz5@$R{(gcvru^x^8Qb8#mq& zsIh9aQ~GiA{jT2KAa4nRPFU69yT_#NMNK}Ca4psOSH2;Pdqx>myWjJMEh=LNu@QM>0GdwD7^>gF;HK^(CZJT+j$=5yX}oM2tmK@-SX9iw+pW?(DSKCoq{aHLKOI9s`wGvZP1Few3jB&dzl zbs4tF?6}|9$|JdYp&JwzJx4__S0&?KX{5814Ac~ZsY8;lp!yQP?lBWMAi=;U zVZp#qfnO~T8y0taCu?JSduwJ7Tbr*MBX-NIXsvG!go{MKhspQJ5cRmlX%Rr$qERY3 zp`%Ss^BMPq$g282`J}|}PGTU`9`xZ9uadc&TX6oW#u0e$&m}+PC>`x-1jeR;mr${N z;dp!FfCkgAnx^udGO`DRoO&^`vmG)ed)UyVY7Y(}&5q)19btr(#sMob7DxYXD9Pv zZ$Qo2n>nV^tC03)I+}B1f5Z)S;qgh5o#7p*UfB66(m#MwYgnual4LqT7nQi7;=hU4 z7nlBUWm;=U_{C}oQU|L+y;02r*TL$W|9^=QMQzVIx8*f?91}=*udh^DcpqYw;_o9~sK(w4BAt^mOQ-%*iPlfUJ{=;9VW+}C1r+2`I^i+_CPM>e?dR=EA z!ej!6Wl_u<90z~sskO;ODq<>;EhYUX;m9kdU=Xc83P0NCa!!al{!IhJaQ)p+7v|W4 zn!V0xG(VebtVFnTuEg_Zlr3Z1%L&KCWX_AbQ{R~%MQIB&5|m$TCYL(JYp33DiBc*M z7^3;xugueeK5CANIv0JidfZIS2BWrun9X}~CX$Cxcz=mAqj@O@)*U{(EwC}m0bKng zWS}=f*ls}hvwrjBDg7Y}5VX6^n>R{5@{@7);jmvhVh{&=21%1qC$8zugZ$e6pelTaQ<|KjZs zzsH&J=_vP?=hfd&B*OiUylYHX4QGQ7x;9y?ff7wy#D-robXg*0KpP=jVc^zpU1=7n!O7Tat}atJ_2o$ z^!CgwhkEdF=|5vhc6fIEB>!FQO)MWH0J%H!@bDPg$t&E^Bs+S$>H4rzrX@(DQ;e93 z?aeFvyT#e3+U1IA3=W1uty@rQ>kIwc+dUVe@XjRC<5;RuzIMKZ^~~j%xUR*DgbA9C zOrkYB*RO$8Qlv-9%5Ml~p#XE!k2spr{WSFTai;g- zpS_1#J51L)EY>;-*EV(^5-Di7S)yn|cco@bo$@<%`2P08r5jCZs0wzsTUe2Gcj2f_Zlh7Vvj za-ilIkGGt-itpFfXXBCgN(K&fulQ|=9g_5CjftqC18?FJ5??ahbo5AKQ>c8z^miBJ z6s*cn+%92W3FUZxe$Cu?404$cM2S!svKWIXU%ZX@XyK8tX1WqsL_~0N`MI;P!4p8zap#Gp#6eo&5;Xwd|V*G@ohk)#Ji6szuH$^0nU{pg4LTyA> zhpG-(fy;vu^bhZR_m*f!5>43!*1&gHcpz~}yt;CQJKicfQ*HLB?C9--lrXV2Bizk0-RQaxs~p9%g*x&-NBhsva>4Ih zqN4c99Li@C7{>~6-73we@4+_Z`S$ z&tz+=*rYYNK6I-W-SH`4;WBj#k~o2sgF7a);+?TtD-z~ayQ%jhU7Usbw@OQY(5L>i zWL8vcY;Y1@@wtRO}*R5>2tnNlbFMQBp_{+Eou0Nw^1N8-x(3{|7%5D}-A ze{g)uhw8wUStsBLVV$%>HLXlov4axLNXBhN=x3L-!Z7u!^g+@VJ(J~uSfy`D%8_#@ zk1zf79SWIBYsnP8DQ6E32@AA9-y~X)%cDOuN1-jsjKTXVRm^{tTGLhs>Y+PAHETHG ziKT4lP-$W4!6VRnl8~rH#ZSjphjet>1B<%NKC?G+(% zRFJyQF%lfi19bu`z=Fjx+>3HbpnDt;WLdVeaBb4R7h7%e$MIgc8W@8V|%7hkaQGi z%33v-=q7Fsy{RmOZ_Qy(oKXhKw5t5qU^CwmfIqApq%>#K@FWUx<0cBxI4Y)k`3lfD zUS#$go$V{7K7JCgSQ1;G$VQ8&eGJ-{_rfLI`|>-mbsrWa)MFt~_~1OTgqVr{X#f6@ zD1FH`a-i_%HsY3}Czes339K}SzHhtu@{P%_(r+r`xVR6Q-MraK6NJu8uD+7Yq8F?9 z=Or40sg*q{P#-ayq1wq%!kI+MhFTwBg%PAVi{TQ3)u00KtYGa*@NO1osgJ6P7@cr3{a!`r3o?L}1-ZDc-_gg#`bfB#V<}3hS)fg zURSlrwz?k2l3v>m%wG__HMiQ1#aTzp4MO^vdS@uulZ$Lx1{#94Iz+e1Y4jZ z{xA-UhQl|!*J9>Ihl-$gkH-)nF4m+MW4YREAihE}O!rGklKbfBA@G2K!DGm|pX>P` z?aM&r`;t+G`Xblg+U-bVh20IcwEy7GZaGswxH3JpUYEHAk3FYrqHf1|F}qv~OA8); z#CT@Ho^N`Qh`Sk-iN{P|{c)WN;+X;w|6UmMj%$g%5sR)k;-Ak0JXkK`Yh(#=rAJ#GDg=gCLeeA zW*DcUZgGekeG`_t!XvWrtE%ku{=(bFhGo(}B)#oDk1t`kMC2`1ZsR)P=U1K%jSD&qZ>a8yV^`Tw4s9nG zFxKMgM5KNZ{bf-6%U#h8>Kkzt`?bGBtI2F(W>znw#OiN`1l?u=A`koBfuo=w88y)9 zCFzL-=X%1EL3oL>>tV&Gg{=HSNt=u;3&Kdfgo0mI-m)pTS3KFnS)rLF^80 zPy^G#=oVVXy4dMe!J*N+Dw6cf4a9++Qv^QZCT#=Xb^17xz^$vOzjPHV_LX&^cy7{M zvR_6-KBgDBukZ)rBJWs!PR7+zp5HFzpVHehA>*o|Sj6xuFt(fA5aJI9y)$ZXORf^bKH9kj#}lJ{*SQ@f z%r>ko>PbGE6TJqwOgyd%Q9_h>=|g=f2}@cIM&s`sVD>WsK|LFJ!s7r z7TG)wdrBwu)p!tTXnr<3Z6%;r?>T9uY8~FTb_6dO?Wks!K)$iGebHX=U7DV#Th^L? zTa+tQzS>^hE(`=tZ?&JC>0|7*vr~e9{c!NNEK;(*p4c)|O9Pp$@(~<)^~^Tr3UQ9s z>vmhq2`|`@5cE>+Ux9uo130_y`YY43UW<>Jj~f2b{?cj9eN1hg?{^?KG4TG-&k(<9t9c-%Vx0Dr8e*F}Y znPPsn#OPEV!m%@)VGPp(!y{b;=D}84wHOM+P`wxreW*|>%4S8e?!j+k#5yX8OdZEi zudBlkYE*$Ti7{4-Vt~3svfn0|mR=&smwuuY3Yx0u!m|5dtOU~~)Q0*q<_eYIYx>+;r*7&odH;}*`jOswK^-^md=Mv} z6qQ%Gn~ji~Z)o0`6g0~4`JjgxW3-cS2)VnDlTAOQQZTMxp=#XsRR2R4wA}tL&3;lg zZBSP@RgE$gbV$G~``r&U%G}_zEO9a9N(|XgQ8ue&C2bf+0)A6TTb-CaiM?kG2{AKz zv2T(&R5-jVcu)&mg^?*}owe$$v|`pumK`LuE3m;UTaLB@meuTNcb&gaQM9uG;q)dsQPJ?>m>FK!4irzFv)yyu(4ZLU{Qn^~O` zW%-~yDcPOMn_|2bQW@AMpgm*y9#!Etbx%v0V{w&S5eJf$P0J+c&`xoWze`qP-^;#m z=m%~^!>^7_o`{yT-;fZ!iYwV}vk*ML&dyqO?-YyqMD{<>N!W#%RaA}7uC~t0CNzV} zo4I)3A4LCvs6e>Pa40})%zcl|=Um^JDEdS#PX}c;m?)|>iIb`tx*kXu)QOy?dLX?7 zp$2GK0WFyt!m6^ap)8p%<~J+|Zd2J@Olw4Wx?cP4MA404c{&$ATR*y>dxcb0xRqGC zApJ%rz|{e-hP0s(PFEMWKSKs8C$Y54(mfBLxbC6b^$fv(L@jSDx?{+yxpW*y{biEx z)blmkN(ZCIvmHvIZG?Y6JMKLLa#i}5-Vy%LpF_P}eVyvRyuUlq7FQa*9hV&WcD^Lt zp_cb8>W*O{IVR}+Y~fr>lJ(Gl7h{Rpja{G4{FSCFk5JQ-4pGd+0U4wUC@lRbdO|0? z9HVZQD7&s!nJ9Xq%lxG#dccB7Og&_~Cb_R9;c_TLmXdo4A{TM?<#pShXZUgflnQ z>}xG2$2N}(_HSmA&(4A$v~DU>kNx(SB)B{@*qjQJ`FDZqng$Vlc0-; z2jZf@EmR(h*U+?a%1BfMR(-Y$+4j04*p!<;-`G7E;UXUw&k>9H1|nmubr}5qtCBDF zQt6#Euk#^w1GB%wlSY-XfuvE^JzUJys*iDKAbOSSkwm2~*cWqTdErXxCL|+b8ZE($ zeoafL^+!CaBfjr>k%9d1Mo60q0(f~1qKj)B(PuiA-|&gh8qJv`jlQ$!T+f|Gs5E1r zUR1yh*P0_Vlol92$ANy0R%yK!+m;uuV8^=f5g%GOMe7P9S5Ucjlko^xRV_7ng!;2OjHp&zNbk$_R0omg6#8BY zs0Hl&w>4z|TbGmK3mMb14q<`-cWCGpL;YG6)op$R~!`n)ei{@IP^PCj->s0 zvRu(tY2k^*hfkJP;hyQw9wj!)Vq)mlOupWQ3$|=6U0M0b4o5U!z9-v15S#r1X<*O` zGkhYyG?kIZKEgBSBNuP0#t8~5sK?|C+*nidub$?d&co3;GCt=|mM~I3%6k!cF#Xtl zt3;>Q3mxYK^4vcy-eYRxsB;JRpj)Y!KrKfeZBs@_k!6XiPARQmX7ZyGFyo@Abc4k4418YjW#+nwZ5)XK-e z?)982?(n9t9`q+7%-k`M1%RztwYb5Tw>OuSgj7cM=jG>&lqR8$RLn{5YPW4^>I>Nw z7!M0SffNPxlu-@R^og?}ZOGb+@4*Ouf>{TlqSq&HM7^yl+70CB4{3P^HFcZvprwy_ zp!HrdKeF0k;0>9ZujZPjLD$Xd{SXSyR_GcW3u9zz4L(+2it9cuANISMtj&b3LvU{h z^XRt~(mCGzTqUeHNOl5Ytxb9(1SAHy-YH>X@}S`dfkojLCwEJzy9KDPq!T8V5b?p7 zf#|T%5Xivc+9~4qP7FBOfUCJVxxk_Cq)a;bdQ|YxqJ0F8q6I=MI1b>LB|t%d!Uv8c zroX!j#Ahp+N5m7!Rt!|3sPd4EhLUn}6GK&%WySFzkPE~U=|QWBil*zfiN4 zH~%s3|0PEveXcm@uhqdh+n*Dq@i7@5F}EzA%!R zB?4D_oW9Y>N#pGT7k4rbhcNz6vM3Cyc)G(313CQ?jAAbOZL~BldJ|UAfF@S-+nd=F zH8RB^A#7vygM{2ttJ`9`gB-twWNa`R3pwM+M!Ek(q?T2yte#zB9#j&k zlB?wEB&u>+oQ_e#CK)6&Cj%!@S7;?vG>nV=OPz)QYwk3M3;&|<8L|2JZgjPPVuf61+Pq$nna}J zTd#&l3_$;-C=*3TLH{cK@EUvwH0R5P;6 z>ndE(FIvPGHlb%TZ)PDvU+i!rix~U!yO^i|HUXkICDa3VVO6-t zof*hqt0pEO6fN7FFT~2{(dgVmC(9}v(W8YRchvK-LW_Yodm*9(B}Z_nHc#nFBX3_t zK|vwP=3w`*!u61GY^=uW zxe?>oZsAn#V{=0NiP70U=2=^*M4)9yW7xE5 z;cSHEyeBr-h(Fy;4a%lpQvUeXi=lH_UF|96Y#%q0YRS97I6L6d#a5keW%zGslj;*E zLY1Gfblyyr3APT>vAVFuhq0S1iZv`cFeX8Mph3nZp^bitoEjZ8RQMv@-_;-|v#Gee5L_R$qvEykx`%d}I~?I)_fquRs9 z0TnK-bay9a7%Xm4?c>(B+J1Q$mmmkSfK#ktH}(Um3K^Ko)7b_mT% z=_bpbAs9uk=^=cp3)~G5zReg#ZyQOhP+OK4pt(ys@@dxHQFIo!$!met(bRR2tN zoaF6Q2Hg1R9484#C*8=l+gy55{dU^~ZmP}NM29~1X+WT=Shk7EX!In{>Q(IMs(Q7l zA{6y{2K5!!>l+yjmumr|Eil-8TJ|)16W!MD6YG61VE%gPi={0OMC=;$L5`R6 zSv5alsTY5&OxmTUX$JLYcIaEnIbPTrjCdvmsjQ^C%{P8M3F-@~b6Z-M!qv-{rMrV& zfdz*!(H-{DWdY7PxXaU0kM#&+%X~!l-RUh4C5WYZA0{})i{oafg67?_sv9f!?B46W zH?v^;PBPd~-25GVt6_$o-^B5`vQyzvm%`AYP{XZ%>z7Dy#x1Bp@_tjX^dz$HMhu7h z)IQ3vKTGomUIb#45`Weig7uksGkZy*+)&EOFI1?0vQS;w_N|K&6)d#>Cpd;< zk3QgB-tc;U=6pRr1AX&tfL_n)ofyp;q?1&g7&_8ZdiV%q1#+L?EnFr8O$I}B1sC=fV*fyKqW?g|?KMJpoUZdUCNnGA*^%jd#|c$(r)5f# z3RyQpi}^sniMtWhKblU;8qvjWJ`W;v{PT8#RgMk81V6wNo9oR{|`r)%BPp4R-j zwDSEbQm?+8t4@&dUE%V`A(n~L{YFr`19$^u=oAFZE?MrCIP{(H2^g+XzKp)@`~A))z7YAmom+{4O(sA=l?yG zWStXx)Uqfa7M~p=FGS7AUd|2^N83n$A4QwRAFSp7!^~Ov3MYNd%(=Wfi*1bI6QaU- zH81T7-3&m3UU}t4wQsqA51z_C_fU`>7PxD|7-h}~h;Nwu$(&&`Cl;S93Y+v~Ju2bw z!g=Rijkf`hkU+jMp5+-a9lLrsbkau(Nv?hnhbdfq7Sj`yC5Nv_KVo2PfDslO8|jcb zscuo$z%(_P!%BccG6J!?hl__(^yo)Cd{qW!Qyr8)*LJshnWy>X$=`sVR@+3gSR!qk^(< zy|7cLBvskCQyT|^14skFx3I@!*~X(HXX!L0ts5E#c7ASCCZ1={)Xgcbxqeg@o3t%2 zB5U&{G-LN4eqUNQbsYttA8l{^CjaX+W<}lY1g|#QP-#5D*96)959~o2>AxAWhY(oE zv53ue$GFN5)x*aYClfOG;fYkaKL~(qLPc*R0-ij%V-6eaG^d}e9W{^Qmh=6V1)UxZ zH{4=YeBU~>NZEA|Hm*`M7$C2l#VuFB+T9JFazi$F?c6T=EoZFE6Xbrd@=`k{EUH@_ z+s=e?ZEZPBTvl)cBxZ(opPG-tC1PcT6p^a$wdgzNf^E2etRk&^A3mjS$$;`()@Vvl zTOkL5WbK4gRb3i-@G3q?)tSJst(y^3+U)nI{fKr*i2__a zrm?033_7FTW1~g*a1T3CeEtr?x?jVr(|(w-B7881hF>9RxB^^|rn{tJ6;ojj7l{vZ zy7dHcYbxxxOU>_osA}QEHWh1u(yHbcC-dGqb0e(_wV0i%)YJiBW|zt0{#KjCp0}rA z;`65wymlY1QQh&2Q+AUzr(pYRs_SHS@5jhAFB2YY*E>gUp_s!TYdw6e1VBvYI#~|z za{lpF{_)n2{qfrW@do|Po7s@Lxooj-wnET@jyWN{ecMQot<#m(yDv^U9D`(@EcwgP z80rF(9z;$bJ8ac`edeYDmk?x+##YekV3Noi z5^vhp&M1rtbgejc=cKLzoOtW~CG3RrRXPw%@PeU7LexZd<|bd=%4$Je5zPqi0NU9Q zhBT9uSaGH^*6ZI>Y=cwE^!tR+1y18CP^Pi@x$5J*-=J3M{|*skcQfc1gp$QggXZ<8cr)kjLyG;Im=r%g#_**a8f$ zSn^>JGT_ow9@~mAT^=FU6&owS*2&R1cXc{S8+rEmUiR9I`7~HqcW-(e?Tm%a-^tPf zP7e5TK!M&89qleaegtk6la!fHk^F*HnNQW>|AhqocNWZ#SmeK1zIMtim;}EQqf2p9 z#o&ESnrJAV7~o&QzeYM$QYhj7t*a91ENe3--QzSOOmO?e}W| z>IwXt(x5fSQoMnyKM%7-%57OsfSeb}_h7sR*pyq~L2ax>JyZDRrN)wO?_jA^k?%R> zy`1u+BENJ#ayiSoy{o_naf}!s0T=LiI9N_NdO28<%zMYw?h)uM0UHejfW8021;{;) z%3yGN-fmy-5D8DXc#d;7)*|1PKft8iid-WzpT<-qTyFA%*6GLYs4{ulrMq>xF%%uz zF0!OgB#pMDPj~N?0@>`oG;6i<$HlyJ@j>gLNDvP-#rXanif%3|{1dJhLtUXrMV7Ue zO*UP&-IG|yb|HE4vn$5jVWb$j+wb>{UA@>dlTl{D$X&F84EZ-c113(MSn_XIJP(52 z6h$*<3*kH!}nf3ApsI$>;~?&9T=A0 z2)st@2}0q7HX+`urG`)(55e|N(qEm9bGf5I$BZV9hv8n_2z?s3#or?qGd7o14U~8K z5rxCD!wg~*`s8N$&$8IBAy^s}h5KMJGdcT1FJuWp#6({*D{}kDb)byVNAl9STrnuU zWQ^a2y?h#bf29R_F3LTvDP7j&to7k?eRghU;)K#iwJOrLDjQG{TejG#FSq*mh_q6# zh3sm)^zFynvf$>$L|X%lBwGz2Y+K)ERfNf3BZBPe&Q@d_x>k!tpVYN4Yu)4yV-tGbhMuoR_pacRMI6YyUmT9uKr@CFS$=HZb57kX+Po2!r3-oMzGAf z7gFek15H@e65(0&ztLhcx5%qdKRKu66?EfiVT3UXe2C*n8cr2i(4mKf`cSJb3EBLy z81C6+3Is#Qj6I+6y-xkYwV9Tp2bQW9YGwh*-JVQ0{IgDe3dYAwJWswnk`!2ng3|Iv zrL?{k!u8*$P7?|z;`F4RpRwHCU5pJp@CJLks=v%ZUd@di?hm`~H4xjRZ4P*qWRq zX~`(5xXebrE{l*8fnTe{##>{gH%1 zobxV8ti#mNHmnxhaaFQDbQwM0i&)GOYOswG$M`e@Rk*S=kp+_vXQ(~PFoMm_=fq<) ztU}E8fBfx!ef9Momce8R8^2+hr?Zb~W)%M0&&@+W+UFzRCM~5lQ>SacR6$NZG%5ww zJzhPK3DZ-t3sid`|CxHH>snXtl}i|=rM@r=1V$Cs`98 zNHc*i>V(~6@Tr+({LXOp!WegO$YMe1emvOmRTPl&dzz^j@4e}A=JAQp=1I`Wwd0ItY8I1Gk?hJFp9Wrs=`|v{;RJGP|7kAy_$ePWGw7U6u5A@KS+IH91 zaX+*!?#t1;I{F)2>In0$FpKx8V)dY<PvyQE>`ulLh$^{{x_?>ux>=0pNf*E&CvGu4iN4^#YAIbclk8?+usqb$-lz)@bI^uo_si7 zwjqmojSF56=G~N_dx#@v`3~!J5pPNCKa;$A5Z+h8T6mh1gb`I^vTy`{%N>3<~ z-ehmwoo5r1V;0A{f*fD8eM zzdzVR%FQvT>p?TgfD5JtRz|rQ?1BEit0-cT&e$MU@&C%5;f8B$v(beH4OC)uaSm3V zv|ly~b#y}gi*HRB_?#o6@tRV{u#R}hbuqa7+zPy*y_P{|bVvfrignSr!pLVzGY=+! z{}z9K!7dqJvfL?5PrGiI>U;2Qqd4=X&MrpNidB-F9`dPU7)Wmch&Un7)2B4zFKuHq zEm|kZ?R1xEFgtSA4p2EkFVd$B&gqouZCQPck=v=R)L@R2Yt(G&otq?18LTrd)gxbU z1qzhr3Nptb4r(@uGv5LQw8Xsh$hDH*gc6T^@hh!)=VNN4>ps_+i<(l>5F(UN94$s- zraq9X1O_VEo+Q{m;`!-Y!-vwQP#P^ZOm_C9c0MRMeNwuJO6 zlqNJ;Uj;oJotK7)bXO^YsO$#~G}WCF|JW-{>_Dt~_G|L~4=}mH5{p0kPE_^Fx_NDb zFE$&AqO-Bq{H2?$KTCxhLJFwj6Kur!{{V|goPq&)d~M|Fq@Zd5C#LH~zL5STG-N%F z32T>9OuKA;RvjcG!=#&vH39%UMgTMd;E)~w1psKG13al4Pehq* zjK&4(P((C6nn5%b2h`Tbn}?GyM{U%)Ma`(MJ9W^CvgW!QUw7)EUw#kqH-L6|qA3+R zWYhaSqpIU(1NgKWTr2!corCL<8DWh}3)&a!$zw@})r&;6u%-RAyc#Adm8$QoA1NOx zkBPgsa<8rh#64vAKc|gSe)4=e1Ca|pO$?6GwpO=wUJl85gix`2h8cQ()Zb8iJZ&$Gs|x%~bFJYm&mdOY zPY!4e(pN3mj<6sWTo=hl zJAJ=@&iIKtH}Nrg%Zny@zvLHuuZnk4&s)hG_RRcyw?LD~;a)lrs&5L}^SMfvaEx&m zm%;=ubW5qo0IoSQUq7q$tN2S2$vPM>yY4y*_=N#MZl>l4mGZ7H891wbMe~L%?H|r^eB9oaa4tH}+(3i>L;Vo_<@f)-`M=nK0*`h& zwf0t1?XMkuPBQ&_gMXGlgX;jSZ&_~0qkIEjf_i?()cpBi$`A`Lb5 z+}_y!Z>3-JH=Zyrz5my){!;q2anZW1pG{3tZ^}VB8^D;@z?3x5z~sDsz~r*86#6R# z^#z1}|M1xY7_GYHqsf1m`k(pD+^72g`-c28^p`y=!KP8_v=kd`i*ewNdbAvoR0At;{A7$=!qH zmSG6Jqb&_YMH{Bygbb{f{Wnx&@fd&d1vp^x{;aGCPePig(G3e{mh>-_29wdJgY)GJ z>+DEEYAhjgUZ5^W(+Ma%xdRkF95NE!G)a7Ik?yrcO%%*wdZU5hb@hLr?q4cIBX<=4 z$4>v=e32FWh!;vba>uRFBnYUfmJ8Gz5CdvXgaO+^f=dK+$IAzF7w7^s$9TvJY=fK4 zy~6)C;NLqsS-i;jcN_IDdsmWN39_?u2<|X`Ft5+*po?Gu^;h>D6C64`$yhkKJw2PV z5rWFnkOmCQse3LhQimL##>@c9Fbye0j&HT1<=2EPpG8B!w!L)x=6yh%DbEWZC0?{J zv`p~!xe!26!~j$t1s)2t#@$Hci{SkDkJF9&f;m$jUolR+Xagw)Q1G_9Qo`oF#0;M%AHybclI--BcezgOpq}-GD46zK2~@r2Q3zwr7|t?bdEC5SCQP0(gC7f zlgK5SjKD$}Sj5G`1VNA?BlL;jV<7|pYG^e||U|AaDVK3n1K0^YfsFBqccGqr$r>39vb3x#)+JOlNg=0fL+wNFfiT$N(I? zfWrfDJOU1+VM&mLgiH1BggKg;>r&%SUe6_ZZ%&2$PGS6X3JIVPGVIWbjGIMrOb=oF zetji?3XcN_0e~3&2&+;`2Y}B9Fn(6K1W>X8Km@W`#Bk;u#*e6-0IL4l4sEezS!9;$ z2mnbfB8G@(Fn-VV1W;TH03ibq%O@~?Ai-(^s18F`1O3)z`|yGDy&4HJDZ7c0i2LNO z45uo-Z2NN^t|5|YqlcgXoADeQQoV}tjv=nW8r z4hDj8ufdP66u~PM0#H-0l!tV1Ip`8VAcN1ZQL@);p|9D6K^r<3IMb3 z0qrE9ol6F^O@MY4(1x=BT0dSxEo-R;4;qD4dpajM{u)8_(e zVVTgn5*kGGIz@oU1PD&RVh&h(Ov&<`hD62N;)6ozcXu(=hhK(O-HYQR2CUs8L15J^yH-vg-FOGpy-xb1H=kIbOS_M0&0W~4G9jkk`QCb7r-F| zI6$CjBWnp|AV)61hyhF(V8Pw($>SRikqApfjo_mrNltOW;nu1djvv3e$z#+^x$>WO zb9-?fxl4>r$nij@fe+WRkI(V=K@A_iU=4s=0BC&#faNP=$|o|%(oZRJNiUCq#nJ(Q zW;p;f0zg&{1fVJaEy)6)#KphFKtaZT%Pf(SR$mwZK?wkO3xI-n08jv+FAf0MP4o>( zlE01H1v`H2r`Ydj*pgMONzd5dt&Wd~v+9G(KyACm0N_*_YMV0}06ze56A6Gm0Mtc9 z8{RPBgc-If#)07aOECdN9S7IXfDV9{Sb#wRz&rpLkchgD7O*k8JUGeFBNxyBuuBR6 zL;xhc0vG^DkfI~)c14svywG=E@9rAk)F&_>MEd*Zup`j>jnmSC^W__!pGW#Dbg(11 zJ&w~Z?(ydvg6yMImlyf-L55O5sJxXO;r0RuwF04qvq=BbW`H;Zh#cMgS+_j^!~+o) zAfnI+WLXCYH-P9kjr5PI2Z%+QhGXts-x!T;8?TmRf^(FHbxY+%>zSO&&2J(`3km_< z^BFKf&)moe84mbZZd<@h-N0&&m6sC;c;VaQpgkD}>gShv@J_Xtq`0Mu=OIz}mAOR{6}{0j8Nz%F8B?pG`0xYq9O z?vppOK~ue+H7Fiw09hC>I>VQZko(1y$L?jwfe|cz^F0)0PZb(SI@sjxB;I#@G+;#w zER1522DV7?qM=3E2qOYbd2kQ_ISwFa1^#Kr8)RTX2rL8u^=Ckh9)~m_N{$!ZC(cHQ z7!Ihh-#q4R9eUpKeNYD^MSw&FkmLap2?-$K9|@3y9>}5onh=EjkJbMu&)Pitt9Nds z5ya;W4E3)`zu!qnc#t`?dwaw98Q`>7hgXPTc^9$A3Ufw9zA6w|{ zaB9pRT*Lb>yUfeC1IE$^U^D7sP`Rv0NkBI9qC$&hVcwP61P_KalEXdU7i0k<4Iuad zBKWGyoM{)Z3T?dNUWISIPG4!DH9=k0v&%hsPRw0j;lYof1vESUB|ArqeCs2w`GQmVQ@@c8QT zxGsxC=$Ic+djP~WpgsoFYk+!eKV+hL0uUQiH?)d9&mVU@J-OePfj?hp!~WW=!TH%^ zA$Slnkv@rWGyEAWaTsTa;=mcW$n4IReB>ao&E)t>sS=%I1uO<)~8Y%g!s#_ z2IXg$Ir2fk*slrL79IZT8Xxo1+2i)sR`!-z=^l^a51PES$a0Ie$0*(&A;RZNX_kf+VUA9tS`Op9i;RX!xycaToKMr)533SLS z4Dz0L2F5%D#$4FlUa)?h+Z`Y-0b(Dp%mbD-VD9t@z>*DEI=r7ep8*2@b;=wPU*L}% zXK=t20GQx`op=N61lP|VDWChYGyb6rrw=R4`^&~E%m(%qI%lb|uwnG9s2D*8#HMwc zJC6YZAn8Q+Pq9S@SEMSvyCQjZBLU*Y$uQcb;{Xv05HKSFW%@@~KSYQr>B|MAv9thj zArKP4<8^%Y2icz3IOj(j9AdSQNhLfM25+RilfZDN) zhSj9nou(qypNITS!4sfCLlD%6@zC-(l!&R6gPs8M7vkSqptM>3k^^Y2I`EqDA1VIJ zq0*Vj;p_9`L!SWO^ZM`OUkwWe=W_W2QiXyc9<+{x4l4UR8=51cAWdrkU-E3^oj7(% zoNj-PfEWaSqoE9ASB~Y>DIvJ?IU;Wmyg}zpbuAFP0%Dx;kjw~FuzKopD2=pfY!240 z36RX;GytIt5cxnhIo^%D9Kfux`#EBI7(C@o=vv)s7`bEJAZm6>^wY&Bq9Ifg*Likf zZ+#=sRnPt|HGsST5JU@rq~U=IgFIk$Ll3N4uX?1~_LL3kTKssouJKdWA2y*`{yeYk zaH97^Qo66M{~vAN9Y|&S|9@wVqsb3M;O)|BU{+EYfCJ&yG8lY+0 z4%EE#e#VXWBe|dbnJHSg%#Y?I?SVy?R1~(W2CL)1Kz+MP#|a?3@#f&Pp>F=r# zuan)6`Iw;wH{MTNDr~aL^eBdGt=x!o+M@~DZY7V( z`~-IVJDR>>Gb* zqqR4b6mFf%+F@RY+EXz_)eTRt2k+>GnO+vwZp<=F%k43(uOql}sW3lzb$)hrk7jAW zXs8%fDaP56WYo5Tw#p2Sy01Q?%K32E$`ZcsSMyS`fcXS)OT_z}$fD%IK=y8KDm=_i|wilsD89^;H*-hbpC;I%=YZAc6y z*PTBRAIkN;TPww!Uwh}C74M!gdbTf5kJIRb=xZ_QDN~DPP3z`6U;33BW(L5wH_01Y zB#HGEaB|gK=L##kJFGmgyb3Y%#O$npxMyf0&ZZO!l2tZ;Hk)K+vx^>{Q_Kx2&F1%- z+?m}(hi>P4Rwh->#`HQeGLDB|-(!XLErlSSz;AD}gc>Fw`(uT#rBKgk*WEprGp^c& z-mWn&6cVz$!#XgNa31%-Nb-t&^8A8YWqSfuGJaIwuYqr2foE5|g7 zd)KWY1Z7U0v1T6k_C{E7W4&SS-ns#2HY*n$)B+{o7Y>%t`S~t%yENpw1eaO zX22wYH6Is$Wo%c{H)G5EVC_e{t`JGY({q8?YumQEmmLdL3Ij4kLwUYL)I%B zj>qu|O`qR}_R;&jl-_%f`t|a5M73}Oj@ghRi#Ai!Bl;ivc{^Pus}VRq^2%HP^1T|C zg&#`GI~5#_TbG9hII}XwY+`%%B2qc)h9~RU&f>*{lD9N@(2U+7Svf1Yb#w%Be05v2 z;w#qm0gl)_gnpDTfx+nj%bQh~PBI$=*=i;s=|mi4Yu(ahBXKU1)e4*&3G+UF`Ce(x z=JmHqYoB|)>J8RE1UgOYU%bIaf0r)e$K6x(KV-_1E$yFOH`;yCXs<_fH^bNTwKz3P zT(hjqhsW)La|%RGcXZ!`U2jdc6^w=`@q@~^FTIRcRj{FV5vzD3Ps0@7d}Summ*piz z9QQq#B6>!FNdJy*08D`dKTuu>D!X#&WmW2>ILi1pWz180y<_j`TJAP}(#g#1**G|4j3n>axrGN}{WN&TrpujBgk>1`v$0E7c%(>PHJYjwb%Jt_9Xw z1PMRIKf&T0pWbDRVqNv3vJ#EqMahc9^=vmHzc1fI7u_JX{8Z+$-MBAS@Xq1*^7L7h z=#n5r#b!-(lZL@n<#E5{i?iom1wWL#Nplw5-n;SQ5`0T@GYp^!{S>;d3H9QpZ@ges zW6z>IgOWG}KGY6UI^la&8>gh6@iKN>oA_F=p1NnObu20Ga_Y%zT293U>pzrvxjgZZ zo>a@HHpenQeMv;#X0MS>e$&y+g%Y7sguY4ZiEHV-ERb|Y&auV;F7fg)wo%^odJ|bv z#gzb+H=!zLQJ&gb4zEAG3$1W1s31b#-Cgch;B6~7e`1uW-B_#G*ZFZ?6xur7I8Pt* zlNs}KW*eSCVSYY^e-`iy#xT!h=8o5K+CSvt=U~ZyA7}!#YlUf$2hIpFcd(amU%l;y z8}`)d+eMNP?w~ zr<>yw=`=+iLl8QmoL?-ka`6~p4|8WauOX(RFX(N^26os_luI)ZicOy`+Pcc_ z9(wJlbMIBh6&@85uICIpA7Kp?jTW}}=HrRQZ%ta43UFN)rML!&dKf^u$h^3{%I)c_ckEj$#f7s&w+NXovbB*3j=V)i`%yZj!Agl zzS49rtO6noq+tfQgzm9pzPR#$v_g5|QtA14fXga{y?DWxw)$0)-APo{I#fnh?y`tP zZO}UjuPLIJ#~-%Hev7Gee7SrigXZJI7QM3T6fadt6fz!N(*F=t#x9wl`ZX;5{(apO zBR|;H8dO=5xV>&0pWwK_L8%;8d4<>OM8=6b>`>is%T#uo?1wf&u}fR@3%>RP zP^md<4JSbl_~Hpeg=t?RFFou0;NxHYQNv0d^zOdJGgKMYs_bKK!};=h8ug#bJC;xC zAeVZ&!n+(VwW=)7%^Uf@UXaEMp;VfQ;#W3geKX9QP=60wJ0f^l!V0;hIOeq!IwZ6h znk{W9^!5o~WouXFJkR>%SZ!-!2F?E72vn?GH03@1>CwJtAGE!Z=x}SS`g*gdGg4JJ zfX+VSO$1|5k-yXF^d8Tc0121f1R>MYdZm$bS*6XWCs!(*dlyDg8=96Y;mlUn1(f&D z)nnP}ev$0$^-l$w!N;l;9GsbwWU$2le@(=yZ~uc>6S zv-lQuIf-viw#jTzsBo0`W}vH7__jK0vg0q0mS;bbe$Ha3@3Hyg`a{l$gzH@uNLjBB zIgwoE{6jVKLVSI(dLmGM*g)NdBlP%A+lh0InFa5Qi+p%iI*Pdre1kNeec$0OcYi`9 zYRJX2W}KVD_K=@{rY(OfbDn=CQ8=ovj^VD9XoOIxY>ss#m%)XC!Vpw^xl9T{xe}>h zSJUg4jy0#5x5pCg7zZBIS2y^j8W6qN(kNEiJ2s`q#GQXsQ7ga}>ZCjO9`O=lT3IzR zGRn_mrJGWsNN;NFX_~d~F7|C{2&8LTkitFVZ|yr~&hUx*D_f+2Nor7}sm_pf+$!C6 z@ONVBVUa@lZC~X(`yaGfchQbFG;?8 z=Vadmo8hcooHzY;Fm$=7Nx80K>CRi>RW?JbC{$3wNbqH+N#(j#Q7u+_=wZp+9e>4c z52v`vBRL*y=Jb$V!_pn(Ae(t%t3&Q`R=)g>Qvc}H#v4%z^J8^A^LLiik%0sbz)Nl@ zn|VH4rTN(1$W_r*wlS^Lg1J=6;^6H5DI9HN>v0P|s+55`D7=7pxp^W8)(TgEwZ@`B zxV`nk*?qyo*~=Hqy+jVkPCJ(3*=v+Yr$t?DR(tIE5BIt>S)CUOz&DLfi5H(qU>>B? zW_4yWUv^yrxx>Mj-GhVSZv<&taVhuPD8C-43wLx~Y(`<+VM2$t$(_dT%9e<5ubAZlx@|Q(MvE z4SRPUD}hu)!KA+gUm@^3L*@q)<8S%hI>rIGANj2ArXZ7OW$p&J{HRJz;9Y>+5^f)R z(_O)vIeyoYoA)-he0W}bdw~L3{Ds@iLDF}lZ9*MAkfHXjra^uy;7by|1#*pdl<#cs zZSgjhghd%#=lKFTL*H7t$N5Wk+~L_uc=l-;Fg<>GoWE?R3ZATkCo|H)qyo=4f9Xy< zJlO;$n~!D6jcMy_a5gT;RNsLZg9g z#@KXBIziaEfjRT1RueCGoawg;iJ|4zt@tU^^AW_QPXwtGa_$S5 zTL0Qg+F4YPYiezI%O!rr|4j5$#VFpU_&QflF@EK$WR_UKuE+Jare=2%!tzcb?Xw-z z$j@bUt!X&#KUjC@?yb9EV~sEhP8VWZ2uZ4}j92N`D*o;?Y0&d&W=rpE_~j>1QEDaF ztE1p08(bTnw#}R=xD5mW6a_vu|arQZ&2iJ26^O zv$4_8wyJw&#p;Lv`fVnjkXEn8w~M!5?$Q}nMLfyQSc#g+0Eg66E?=IEiWNJuwOUi~ z+b5&*3v=Er7%e&?6M77I{hX}wA!mi$^&bL(SH)AiN_*bN%_g?4mGm&Y1pT?E>Qs4_L8c42tykKcAr9q^=8tU}b$)iQ zBn#f{PYiFx?d97E^-zYlU5EHsL;5afA~{Ch?`_I5b9pV(r=!2#DKURd9$iWQI(C4X zt?S8C4yzAADXd(?Z)L=8APb3k)Y<1n={L9r=J*?=q>6V#>-x)N6PJh4QS}iycIVaY zwI(A!(xxR`f4|F)c1~@dS=Kn761_XNxzKbXqt1LQ@vh?dj>hJZ$GS^UsJ@fiO@miv zwe0HtchLS$VwE4)RBrF0E^khHSS^i+exfhW`ay5*>J}49$M_g!I5YL~V{U7vrEGhw zlgpW9Su}z3^7XwQ(d7Z*Hx6`0u~J4i{4<)|J>NU=9nD>^RWXb3Lr-c--xcR5WtR-L7p9ajp;QF5i)0TYke;SM#@o3dM?WFXwe;XYt zYuzF^@@Oi7o(&h;xxL}1-86s->FFAt$=SBwJ(8JZ3=tF6@Vri87mn>b)5G(+?}!K( zRPnqPdFmjUW^}WOWnE_EBp%!5Eobk~YQcIz^j%0rvw@JY^vz3@8?p}MN5w>qNW@AjO;)Pa!Ur;6e9z*ed z+|<^O@JHq;=yg_xYYd=(U@XaP^O@O9=k zdb#bHrP`Iy%De*hj<~&m2P*NsP3VDV0*jvO#-c4+-&i`ILyBK%1xjX7JV=LO1FH5! zHY%2C-@UIa1GDsY58h7;h){Y>ecpVBzoAAtzclEaRO&=0{D{}C#LXiGpB%aPxowbw zoG$y6@OWvUk{h$IUAOTfC4N*PH!3QFdSD<`TiM7atvI4jF*PiMdS9u|5N|!BEoS-A zHp+;r%mHU`4{Dv|P#HUuRQH2{Vfi6tc#;HjzY&R56@!r&Lya_&*8Q09xQy@Bzg z-(+08wKQ+Pl>g0V=fN0#(f81(JIM0UB(cb#?NhDU^4()Ggc;?K|2Su{2*20>CHi($ z4Qf#QRH#=^ZowxO zcL;-VJ%cfh0kuK!-l43$8?wek`!aV(0sPwoHM7kJ+Uab8w4!aHvtuLfvH*(CfuW+a z7^vq329g^D5bq;JZ7ajswvK2+CsMUGWg*8zlz7s%vBv>42cp7HnNB(*3M>?zGJ#X* z)Yn9m4RGP6wAMxzHEq(ISkw*FN!8mzcgEJIO*+$y+z%;V4k)Lx4jAQ!jLu&Sj6dB& zf2NAsus_L^Y3asUEhitf_Kweo0+|N_u|NQVef~I5@HvcF?oh$_mjWi@97U%iD}~#q zvXfDkhZbfB7FCA<0t+~&Q`ralBZmR@9?Gj96y$c&c0dEj?0b6Ag%s$Z8Xpgs?+%L* zc*y*Iz`T1H7+_*b`S`$XJV;G)zOCb{q0`+%?Z<}}PkvcoLjQUwe^|NJL;3E+A_y+_ z)bYt_{gp)(nr}|)bYGA);}qf5rjcKecOE*uCqT|92wY)2<23%V|CUq~_Xqy(EfZHK zeV(mO9kH9aK@LL|E&!rlZK0i-T)t}0ct$fB-&|8)lIMF1mFB9XV4m}9fGe}XcsGOH zOaR?Ge_zgMSZNHp2pb5z00yCYCF;ueo4ubsE5t7J_e~{>1_ln60JonY?zb<0{qSRK zwg>F_Aql|yw_%)?bg>pfs-oa7_Ca(W$0`yb# z|H#EhpEBa%C8tNo5BAog14{i49T$k*R=?@n}gl;u~NjlFA{_p+-&9gqwMlHFJ(t(g6&v$>L82J9kc?S?ve>E_R zO#SH#w-RP;egUj%HrPrRAFyB&6|^oXm|oNfaHWhc+NqlEOGuNzmqO}KVjsI;*T<^C+)jj;kxRD5pXa$2Xdy~@nzk~V{!S~;8NzE(5Duow86uHWV z<{x99P)>r|@Iy;~2Swlzr~rpOEY08+ln`V1r)ZX3G`KbWY50fclh|vp3-3R@`#V6e zXt$)L1l80dS_zC(5L%WT=z1_aMfqnyfBVVFXybc5E*ef?N|%nT7{3(GY#JG$+QTxM z0-75R@pqeII+>`yTe8I)^#31yZO;gSRv!FsG5$vc4(TFLll0MgP`nUFxXuAwpw5M~ z5FW_$pTj!yICeGTy5%?9Y`Nz7>X$k=K6F0qmD=T^+_N{zMK90lmy2GSRro61!8_X^ zt@NA}8fTg*aTi+&2-Yc&Le{ErZ%d_x`btXFPdRKvkh`QN{ zp$-j$m9jjK9Kw$gy@K3d$VgIf7-vd41-aA6WVT$cJe#@JB&c&VDEzU>3-SAApHnFC z#d8y~Bx!KtGFAw4GqcEOaL3lWPw5^FQa8nzWTa3)_~MV3gs+=rrQiVTA=r8>z6Z9U zHHU5NMf~3Mn1chU`(~vWLDFp4M5z}xiEm;Yb??Raw898BU`(#UCUI!sQz9Go$=8SR zX^k=IfKB|dfXi;!C6sH45gf~U2-{Afph05Ig7Y(H15zf(^b1``>vRON*Gvd7upHkqI-+g8A)8N2$~r6Vm+Se z$5!Lumv&BCz7Xf;vp)?1Ngp~X8eIKY4~n#w5pXtVx++k{Ktn6y%S~7%=?AE3E#gx~hn6tIr&P2jWSAM8g6VHxgoeD=aRzw{665B$8|Mwxh?ybFQ2KsV=#!!x{g5!Q>C}_F6p=1PAN=JJ`eIqLbTsK+qI*o5XN# z-o+3mUHFb1l;^L~{1f^AM`a*P>Hp01S84vSGN(jl4NW=L=sR|tUpi;3iR^kyY0P`D zY~LVnC%nokeBGXz{!L&R!AIL=tgEcg7+&Fs>Kr8*b^#9D1O~xcF_77THGhS3ilPFG zo|_QgvIMLxw9FmVWOkH*#Bc`>HmlP9Y4Ij+4D=^5(cFi7&vjX2;FRtT-dL@uAK|de zchX@OutI;!(&@t9BylZE2uNJTPcMQNI7%Q4I;jH75B7GA(N$m&wBFA!4(#Fl-2|d3 z00Fe#Uj#Tj@zc$(7|1q3>%GD`ApA;)g-oZ90W=ug1dTCv*NzNhMMz+_gP_+i784-> zyqw(xaN7!ZOo03sHKG8y{HYTV0zGf{V$9j~H3T<5gxL>E)Il5To3o%V?*DG=O=5RN zgdkH|3nQkZPU~vK{M-(fo^|SujyC$SQY<6KeE!q{>XH?bexMFuM`5 z{9iZPuR3HM`KNNcz=3x)T$z8leW9QGHv~Nu1Y*7q8UPLntTmO>ohD| zBem$<@e#+9JEP$5_VnaBvRV|WrErbccV)5j*@izs-W}MJvv7K$(@Eg&^r%zH-O03* z+1=^2joc~sLZi;Np*7&UE|H!!+&gbWZ()Wd*Ps?^_XwnC9y}+^0smw_OS9J?{S0s0 zE14VoQoQ+cs0k{#DGyKf)58WeM^-~8Z~&_|=J`-l!Ohzk`xo#~BD(k$VR>W0&FkHPCr7#igK?^NV%t2Z=AD)(CJVX!7SpUV)fyU#oU3L@^Um^hi;BFT-fiN~T z+W&RN|AZipc%V#tDrBz^55cZHNmTOmYyFX%`R}iNt%nY;n9COeEEk(x?&ijV)h;nK z50}$=6WAD0yBVNGuo250V^G-;0uO*I% z7TYg`;XMaDEW{qTk3iyKxqux&hyYCo;er!YtJBTR%3MD4>Ul-8OM{pgEA|8dhyB?%oMg)8P zf(?h8jBtSf_B-U?xg+*LV2uYwVA3WV9^fZLR1D2?7T)*odEk~YBC^O?h8783cBS0+JHN=1peg4rA|RGjQEVND zfiFCOtiujyLb43_?@dVkUkfMm z(K##Zzb~b9ph?Ect_iJtmx4oCr9eP%o8y9DKu^_Z(_hw_jEH1#1%`h@4St9(W(Ov_tY=euC=f-yP!ZrQM4=!G1Psqdp$;T| zQ@O>kOY;6y$3XuL$4m&6MfKouXlFtedvSifZx4MfYKz)sm292IMP7_^El^&JV-3oX z7vowZZV$x@+HRHS@5sZuKmIM#3@ZrvG({a@*soEK5GV$>dAaQiSRr6?0Ec~LT&LIxLP)%t{^w$V2%Ya@k_Q05piaz zh6m!%Z**|yvI~gdvdd-jpC|^ja6Wl0A>8ETHQ?e;P@tG3`UeOiy5Udol1sTdzS#Q7 z68)11Gc|9lFGao#Gc$zge_dik@k_SVP9~#*p;C~U2<+0D92V*Wfzu%RCurd1#R1D( z1uyREBf&Af~^078vL-p@*bG{hPcJ>!SemV#y}-N{4ZhXzpqTTaB`>91L0?g z$T7JD^2n1vNbXMUwxDY=ij4`Ri%IY@qP?RIbgn+!vo!F=!*|)b1olW~B=#GS25O|q z1OnOY6@V}on*RSJ_@Cql{Zr{4(w2Bd?Sv!D`}=#7i?{d3$IE+?VypWpU9tlQh%NL* zvYzRSC|l}_ys_37Q3clka8;Mn=Of5Ti>%8_qod80Lm0Wa9LKZBA`}3_K$l|~(j`9F z0%+X#EG`)eC7##<4tVfT{hBA##W^U6^_~>x9%V__<-wa+@9$!Ue9;xNv=*_5#zrh= zqQTiS7BPs(*#WPEi}!s!zN0yE2-%JPTL7KvKRt94OZbUPhF=MnBEpFI`LT>(*kSk) z*h@r-=kk$8cWhv3%6eaKof0sOl%Iq6)~N&_FgC)BPq17HC+-FIg>ZnhBrvrS3~34l z3K*9>jYuH%!V=Peu4kLBKD&WURieqJvr&$G>$-;eQQe)L9#lS)c(mvrRaIL2rj#X< zc*pU$?MrWBd22CH6zaqxB)P&^Tv~`P5b3PC!lKvC*_TRUc|%&l&AXUprV_DXg1>6NYk zkC?RcbpOifUq(2IcdUh&?`OupQ#uG6QzGb~Mwpy#-Q?>0t40{cn^#(2{wmQQMUC_m zyCjEbs*VD+ofwe?Rb2U56fb<5!a?ca8Mxe5XS_j~Q{6H|us4K6mxPYBdsTO{e?W6( zs6%BwnJFbcYX!AFnQ7o!0j`&j47x8`7#{rhpyp+3jq4iyBA_Ws-PI}P(k z_(5AnfqvvHUOfAjgVH$xG}#3r<~nA99+sdmCrYy*SqmF^cmr^~1ifaX01w4p9?SSp z23k}7BHUjIWf17K9?UrHx@VW_5b#t;1$)wjJ?&zKx*sY`)8M^uff(-L4B)g;5;M#M z?W_j3b2jW^T^)8&jTvfyZsvr$d9DoZW-i#<8W_?P3lt13DT|yzUMVgi4cmmkI!{+r ziKd#))^pLKbJEkeicM!nUQ6z{`Z#SF>T{h2>$d}UY%y4kDy}!Lw83hOzzw?zTHKzTJ{kIdeFfX=STM*j{mFm~*PeBC;Zm-X;lam(K#yq6NdER zGVDfBfeaZ>40dX(mxjJp0iDWt0(90ZxOw%S->iTi&S~&-i5;{e1>Cz8*q*Q8hqE5s z+J6v^QNWMB3V7@MK{yZm{*;3W&;jGtO?I#u4)lIA-n>!)o9$Nsi+T<4!~N3ui<=e0 zizlj?>0a&ln5hgZNf&_4D%{l>s>!#$WT3BY13Em=$Eiz#QLD5{i`&!`1vbyPJDdYQ z9Cxnn^P7NzO@q>bz@}z{cNGyxr2yO04o*c2j!YTerBonyJG^5{L?D#{I4~64#0P}) z!&D#@J6QD(!mSE6kja7EZ^D~b${>?NxnBeZ3KRry>)!!j7}xY1D!H_FM+we`Dl5!XOVvk^uyda&<@#NL0}hfmQ~pJe}@h3#30P5S;6+u{CFO)C@y4q z1xW$}dC*3GvbfVUKY|T)DEpiB!gKCi+@UP=7fr^LnicHK1KopYFf?7g{9BLzjt1k5 z@VKRac{qKPo!v6|=(z&R3^5$Ob)%B1J(AAOC@fkukB&b0Yk0Fw2%j86S_l6$uz6QP zK$2*rG~Db3apxf-9Sz*mXe6=rMb0v?>R#}wp98C&LwL-R0<5~m3$W_cx?t5MK$}=n zoF6_1Ry~IhEaD%8TNM&u)h#JN6a7JW^U4ce^#i$I1O^If@a}LZ2mNA*pW`e8FGPO? z05e=~YK$(r*D^ifK5^dxkQ`#7 z(F6QeHZ2Fg^s|O;Vx8`}uV-2g-Zu_zz?*~b6Y!Ey%@;(|1KucnpFo&9@OGe23$)Tm znX34Df8Bt$jZSx1?uKU?DR|#GxcM(@|D&`Xtw;7v(FxWD{T_Vt&RMTZv}hJ6Bkc)z z%?#@5%qp!Ctur<4xyA@aT9Tm2a-@4pGeQocq zPN}y(PM03)(;M=wSJLy`$X|jlQbOp9SOoEX^pp%>6<~3ru6basu z4{zWGJ5apiZItut<`4Pb>UMA=3&Xt|`Jn>Db9e*&7qlyQ$jogWt9XK>R!REZyOdeM zZ&~mj8Q0la9qQwB60E8=-?|}C0C&8lH!Mzp((<#yT^TSFtS^os3F4HZx<9UX*(Kv)_X+MJI@7W?t9l<&KBS zfb*y=s^j25%DEJGW#kw*ky>}K>etBFcLnE@pU%POlSw5zEV$sD={bBpNe>AA1i=0W z)`~tEFfVux4zNt%v#pZ?5IEezZ}8&=$1p8;z{UW^6k!@Aw^$^6f^`hgEpg%VFBlRl z*_p%w%2#0%QUFol0O%_?8p8w1@8Lr(Mp&5uKxtSFek7;+y-PBDibF{j8*B0&r5BN1 zn32X;(IyC7W5P*Bxk0tt0a!nzz>L=m>!;u5;26v}!O`$j6WHC!lAT^<`0!O3+`V%k zf|HYjUE_0$WgiFU$=maa&P9wkj%QHi{#cC;XM9O?oDE#8F?S#vIG&S-_Lt$~RD8G? zSa6~ks07-nfe+*kY<^+jAQuOu^9LORfpkEf{-FO*4kTdLQT`uXNo;lyJEf|)J z@&YTSlU~Hh39_u+&dZ4wy$sGA&;NrgsJ}m4rhl#bGvYPgSq<`^S;E%y)&iGHko%54 zB=9LZ4k$|vIAF&I1*w70`2hCx5DKF|3F>!f@(aQg2{wU#(P7MG%O49Iq5naLl}k!@ zTIdJ*cItN*I;fp@W}2KKTPMhAqi?M#vbewry*D($-!Y&$aC&!rIe#X0U&D`}UsJTe z$q8B=qb6@E-WlGTTjAQ+r;99hTn;ZslbV}}78DAqE%kJmL-a*rd5&QV6k7wk=>%J! zYKk4>htpm&UyMw&iyzK?O?^>x>)VGrg^r2CJXC&)!g5OwDtV}y6btSz)tZxq*4eMH zh$<|pR34|2RTNfO(x@b+iW@?7wuPEEH^3mC*4xgkD;=V;y=wl zUrgmkDgILw+vtt`-SP~Dkgm3k1+IZYC#SDXZ#L-XQ^nGLtX}7eO0#d6K9ck)IWo<@ zaT+g4)_Kk3{X%=-AUTR&v^NFiWS^7o2thnz1~dD+H5r21t7AN&ewvV|<<<`{YSJvS zK+=;$OlbBCg!K!sn4b>fC#$0+81r#kt`bL%Og1bmSCy{9!{`Fb`@bxR37Eg-J%Gx_ zo^ut1vT;#xqHxOUU)0aIEXofp3o;aFB&UPvlaX3cTwJuAsHV_Rve1r+`g)Ig^vasm zm;_YON?TnY9C}Q4K^9!8DP_$EM7B{q^-1U(CeBN1ANaKQmgWRYwfZ!j!_6m!yhRje z$9R_nZl}?l!Bq@c`VN^7+T9s3fE1?G^?&wcBlm>a}q^d zhtcN%{YnRqz;_2sThwY67jHvbYvKGID0<(bEerJS7`kI%BhzC?%^{I4!@g{qHOVMB zGQ+-fI*?l1axNi{C1?GCCZ&c$A}3L*h$1y!N5AqPH<5{6t|qc=5+5=*rlnE~ZL`tg zQkKK5#08F3)0dK%lOxmZtER6eQ74NcD=Vu(e8c+IkldrCG!WLNiYBF+BP!?M3PR=( zRib`*fp2V;ya^Q7yIT-NXXO z(lG``A0z;@7Dijg{4~<&n?l7N*A^`YSR*53at$=KJ}GdjhISkYmTn)jzB2|-`{saY z=JW70t0z1yKOCTG$e|j_?<j49)BA z^EZX}U1dE1==!W#6n zo74-T_HA0zZLQ1ls7O9{*`m4i)Shs&h1>$N_PUah=zXZVtq(<~b>osKAK5@lb=8pi z9UL(mdfK_T#niot=^>H+)*y22hjktcMxje)@w3#WLR)R@)lo)Q_jJW3wPh8G>sxTbsr8Av2tG|FiL~;inJw^w;kC1-aD-iN>5RY$;a~!Wk7GcRLKD;@38ih$xj#|7u%A^_U?(P8AS&W0Rxl6dx{I~k)`Ujwl?%g_HKPS+N0cWHwisfKQuQsG`Y7jH`9jp z%ib+lU|C(>P1H)+P73vy=%`O~pW&B2#{IYK*Z5A2ak%XYhdD3nLGhjy{hyjaru(9#3j zO>)KE`jwHMq20x?%~C~M-pJ1n`!$}VYTS(y6%`S}-Zv_?>w$7}cjEH)dY^^YC&|*6 zYfnN^8)5^s`^AgUqBgn5zz+GoU0$xnRx=xw1O49M{+7+s*Zt*1^u`Eu#(A%L589f^ zj-Bai#Ip09`Ba>R-jLcLc-H3lSxCEeWGLUHad)AzK7;u|i8jFsQao)#dlAz# zq9kp`tt9I!k3I?Z7Au_Tb8jx7--nhpHF8^JN^-`_v@3QU1pUwE2RH+^!(N6>d1Aul zy~Oed9%$RdSR3UhdD5v>^Q5tcXbZ>9)up+`l`>7sRGa}wcylH@&xUGvXsGI?-)<$r zfJUBJ;LMgS|BL<2uiJKO9<(q06e?1DKPM)Ri`(kIK?_ADS&EaAcb7$nKm>C-_p9CJ z*RFaV-}Y{_&lFXDI<}`YAr=;!yQO|p4XWDwBTmW*|Xx=8%f4ZcL{&KDq2@`w-rn2&gyqEe9yfisX6}P zg{`;md2iS%7oX`P;8|_O!aoa1t<&6WmL*V0(DK%!Io~3OCW?SfI^O*VN_*=VMoVag@orykLNMm8Ee^gxTjLzhWJ#o=5UR(9Kmn-+uQzb502{)(Z;lm)j(ykne9B zumb1|i5^k^wz@X|_0TYxshS6&KDR&8MBNlSi;?mD6;0WK7)V|pk$8NeSug1Jd2*n6g=G5PiK*g;*X7iZ}0aZ-gJ*vEYX zWIk821lG_(-ZCr@jltgi*oJFs$9?5xqAOVxl=kks?dX0U3k#1?*(b@=kh&&!m+9df zhabZaBfU4n>Q#AiQ^fnZeqn?uqtwCTkW{rgA#P^!hKnS#VJ7}_oHN!I_QA9g zuh}kk(t8|twehD4K|221ZZQbrN0vO~#-deLArLDd(UbTzAmcwXo%lkArE<+n?u0-6 z$EOjeKCdz;+h&1S*nf-`l{Y|+U!6{{NN*9x8AbJXn4mrf+9_Hdjw ztu0oqeVlzV*v`NF{EUKOl_l>?-pd<1N7~jdB`%)xxc!}$VaocM#0W!UGP1#pnR62{?fWf7 zP@`)@5W)6`?ec@n*+mvMFP=u;I&mUCYtOc_C3%!F8II#Q)8^!^R45#ZFWc1x_wLag z?9=gRPyv0&U0LQDFcMfrUYOsp<4 zzgmogi)8e|n7(c{dYtWd;c1|K-AQ8wa53;Ir^Ge~5==cJp-?zYE{nYo77`i2s-(M|i)2*Y$3M2fOup z3#EAf)fe3%6c%CE2U8>nzQ2iU6n)3=^>Ph$$9Z#twkPi_g*N9M0Al|bTVa&YTRi&FpZ8|+`%iTi_ zRXAOl!@HW`-u;Y=1(#*`6v*I4h#>mWYle=H>re1;!v$B`hjCb?BM4F(Q-0v>3(?#% zrhk7o0twgBnl4As)>!`KbnivnoE2ocp&t(? z@xles-Q%Ku8)eCj_zLc8EJ+%%LLbPoCqA!8e`=*z{+=M1t^od@KltHSL~pA!>7v`y zlsSH<@3zlkv70zkl*wIP)2!6Bc=c|TXE;Ol?Ng_ZrglWg6yHd(haRyW{W3^;?UBCa z8`YGj*K&+EH2OkM>J{^y)Wiwsv*PoGG z*5`jDa;|F?iClqRa=3f}oa^;ZS{K|+?72Q^@8?H4^Ag&5rx!#C2LPH$qK*R|`Yso=pD5EVX%;{=2%;H@x^x5U|RxlPcR}Ms@9{dW7Jg zEDyORQ&+?)Z=?NMW7Zh_bu~rJ*;5rCXOq+H{3uz`?rix`ckV1iAaZWtZB$u^J%GYh zyUL|qt4v^@-L%GSA~DyhaCMFVgw|5l40ot5b$!KMjg;Yn;YM&owWZ@DPobxbgy2t; z7pM1KGgNLosn99!7Zy~g=1Kc3w)6#;B$w@2D8+PJM9gWP_#C`2i+A;X@+lQ}@`Bxo z3wnv6`QE3|WhSzLtY-f1S=1YkR6QlE*+`XVBITQU+O?-;rihl1fbc@Fm%DgDQf8V>I*|@1(1x5FGd3}a5 z`<8wkB2iI}=;&*?Qz`t5V6m>wNxowx9-L!(I2j{ca&_(U+Jl85cSM8%_NmspqUK!p zZg@{zUT&zPW^`iA_7p1S`x;Tuazzq-wOz|Ko}D_ZcWg7V*xfGA+xcr_#Ktpv3pEj& zXo&kRL*&tsM0(#=+h%S~GpZ8>qmmib$@6YqC6WzewvFjDh>`SVI@cg3Mm#LH?PDc| zCo4yVnH^MQ9LY8dUR|@N;beEAle8qHsbF%c5AdzExQFd!$WGv>Wy(-ufu$F_Y}bj8 zjlTxK<$zkBd)UM+79|s_FA(KHc!*d52$y6SXeQJfC{{mL&$TSaisGTcCdoL3@E$(O z{Yn}UYRDhR9ElskSsWk+VzZzchc(H->z}pIfSK*;z}~ z#d};yqK_GhYwWM=qw`h4dC_^WQ(q&B2cLPP()0u2Z-DHSE z@k&@2Z-~4PevF4Ma;1YLRqyA^zil5St8t(S!7HhfF)?#X9+dhP<91vJi@VNMZAy6D zp2k3J<up{^$sy(HRKdT9{vw4y3p%~9w?N8_aHUzRi8Rz;Wny#_#t81o? zGx-gNa;3bUUd5-qB;NJLI;I~8cjijFRd!C1xx3?)aH}Uii04H!9n(=cfdKi9)`lTC z>%T_p>ap!!(;#=_<YPZD?$4JC_$gCkm)pc z4M1SVeJ8LgGA5Tz;WEew=)8G6l#b{Od;9^ksm|T{MG12A<5$H5jDsg6@tn@9KQ(T{7$_m3B4#fxB4pK?q~iWk`9KHdCfefSDPep>Sv zYDYCgGdXeS_D!C6F|RAhg#x6vG}*7r;?W!NaEjRzX*ZRDkAu+?cxRX~qysOpUoc)Ce;*S4e{6kq zTvT1xHYq(IEvX`{fCvI2ARwW%bc29^beC`lVWd?`kZvR;q!|#9l_3804 zR%jU-!H2= zO!{o$)o7I&)-gLW*l@N<>Fo&7)(7EyAOxV8%wkm6X?7=MWbBBntrnd2kanfX}{spf*B3QJdWQyrL7;}>Er+`al6@C>5PMv2^N zth0!q7m4?MdY>m)CM{ftoOC~RegmV^E7RXKwvg|1?5ceOqbax4H>j9E_5?C2uuF9F znTamdoX^+2Pa3fV_MF`s+U{z71Y}3y52)t0fL6;+M|2DG@lJY#+c2Ggn0Iir`h}tq zUHiO|-X?8M$PKkBVpz>Zf78h=jrkb*0V$oRGP)p;f(wMzef^K9#bV2y}?M zJoT6^$*0m9Xs;QSuZkXB)%`W!UkQcIl=h8t*t&WeHnyy&4j(cct}eM$U2{%)TsmOa zBhO#2+5QXz6k}(ij4HO0@=LyKuD65-y*%51!PPkF`xd~}Za_{G z|Bx7cIc>K~-jN+Y{1~)Cio@l_gW)X+7Q~!ylNIBq(zl#sVUi+YBl_UH4dy#NTGjPot6}3RPo{8sl!h#u9C|bWkG*^yEM!qSE>V#RHU4q0o)OiV zYGrjLR|VXjL~<7zCd87MBN`KuC}DhRDb@MyD-Jb|C-tvZzb@VftLqalaqw^mc?)H= zi3kl#hNCD8xFO(1B2GM}k#MC;Qk`#&qQ%p$WR~9w!T(gKCZw&`DytcAqPsOJZ(3PPW>OC1#yr0-vL9oX*E$s>_7j4<1pDK>uVtG zz#R6ZthS36?xHd=Dgvn=MzYQP54M~idX0Z(_+>Wy8}qP9s!=;$!~W|7H0g1L{3Nb7 zy}B4EWnWC7JRA-;1g_Srvk`dPyaw*C#9H&@$daBS+o7W}d-`T%w#ZC>J_t zZtKqBENIS3r{%SP`G7w|&6ae>z!gI{jHq#ZjrE*maR#R@8G;OIlU!@QEaLL$4Gt($ zl@MWtt%qX9nd$UJxqY;IJ)?fLwf3iqDoO*Lub5bmD$wa<$UkdOYc}aurb1O*AGMFt z((`By`ZvIEsVmaN{1hi{178H~wX?BBd~nXVQZa8>>3k|(_h#E^8j*eJ-wBFE1w^#d(q^UX)@?@x^Cv!x<{ zo6~edIg9pm7(wwG<l8(`eb!usUE-n@I)_ZuN6>%Rj6(tHu^oBJC%@&bpB8jfm(N0f0Eu+OZY0 zt<^6ynPH^wvFAtE7zlXW`BaL^5s3CVC?4Q3B_w6^%J!rSoSDgXb;g)rpO) z294TGAm9*u@&Ryr(BE|!bJf@+8+#+vuvyAVhrc|LA#*Vd^G3WzCU}nbcetvCIXrz- zHGD4K69&&2;UO5f2grzCvo(M z!9y7}6%Lm!7*$`uROMU{AF33Vn)zP28l$M|NfcLTDL%O>zU7hYx5Os|{OD^2&sWKE zbx>3Sz^refedMk{<*w^4ZuH2F6JC}-4iaN#pg}~QuZz_Rau2fY+!EIqsk{YMT7!_Mr`N!X7v;+HA zELUi25$Au!0bgPSDG{4QY3y3{z;yk8^aorD{?Wg}3)=`xZ7=hcu$G5|UP5WK6r)TC z8h__ZpJq!w!Sw83d$NqZ z_ZU!_wfQ%*x~s;MUOH9a)&y#lO~(J76>vtz;qBSCZjv-lMZ%)hE1^69M8A1=&G?W8 zWp3@toD!QwLq^peyp61k`|; zxE08t_hSZM7>+=Qtg+{MIy0g`4=SS*~l*K&;)t|q_L4n}hrOnH|r@YjY zx=^4{bDvE9$huO&*Fl@eT5r%lcE({&Xb`^<(Aa8TJQ_5dgkLNohCQ~6MXRJr!4Icw z`wiDSj341I+pZECsA{JIw`u(}=H`{vBwL@_e9w$-7^zVnXlVC9|07GpiL1tJ!~ z<$|`B`Je32%ePWQ-jylFlmnD95%$r zmFS4uKY^65_jhoU)Hs;w(a(diwA8e}0_;WN z7zv%}WOKkNz15#w{Uz_a-FE<6XVL#{4Fp>YUZYxz%YAMqZU0FY6etSw?D<`@NH-wj zYCH=6uPJkl-wYrThQ(%#Tj)v`dv-qY03o2NOp?a#DcoFl(sY-)oFMLJGV*G zNsFu;kKsY~{+I>_YW=k0V4^FYEmM~wU>pOR=V*v}t6(LCTfEC*2IPmX?r zq3$0}39G0=Vk#x`-=Z9uG4f|p>aB0$1E1**@}npb_0F@m~|1kCv1-MEibJtIo3L8`CWqU0e9ds|o@5 zcO*vNv>4Zkt^761rV829d#x)OW%gfA1oAE^pQDS!3LmML()>zuXrfNb4 z?g$XqFwVb$o^UTIA8_&EfGoZE2R|vEC1nrcLz1h+{Dt|P6mqmxNuz^s1=c6+1g{f= z0=whNfHT3r26hlr7dx*|NeM9cFFXplP31GZzsefOwP%t(}+Smau*CT67@urSt@ zES^wwY7}g2x}M>do<+AHb*l}1bQ1k4-*^#EMNXE>qb1jHoU6Aoy?+)3Ipm6IffWn3 zBTAzsf7kZ;QaVuYfZVuhb1jLMT-xg62HTEM`nv|LzvG^3Ptd19CZsxA!{Gzmi65Mu5hfWD&BunY#HOY>Or+GG{-ZO za&RMqE}YL;VZ#GAhmO~daU<%2Q@GV{vE1jw4Ke`r!H0XXTIZc3Cal$y`%AV6`Upw7 za`8$W!Pf^vSW2n~H5TAJ#~J#KLHM0Y`vt)k@uR1$pR!iM-JWHE_K4B55hZINx31a* z9%s?L5|coi`*=a@K(|gjVHCn7*Gs!2`BLx?tHIU7Z!%(#P|g7<|yF(d}ixoie$NY{XddVDRcKBG!aF(zs1 z&DO6Nm0oQyO3;F6bhKn|t$jVcJpht{AB1Dj$qwg*klG9ceiz&@{%PB}@j|HFr}4t6 zdUQOT6J?f+Za~@5c;;ySkqmbwiyiIi_LwC~P6Muu>~zSYj405eMCtEh8lhLj3;nKn z@rpL1(&R(gs!WMidGRBZRskR+;~xaU%Ak=yLcwJ6{7S$Q|F$`RRdphqN%vAL_0H?! z`*;ByVRJ!jjbpUoIl#2 zGj9$zsL??W0|aCZ{=D7^ecVLH1DG@{M3xOV41E`^<_ZD**zS$IoKL44_+c;J>n*rN z3|2m|c%$**J?rNI4k+v(eyEx&CjpHO{j%VvUXZ^+x-Zf(*MsT_;tpi;!am%BXNJ*Z zV{0Y{Y^|fGIlBYqB=p829q6LXIU7p57Dw~F^TPXq9qyL+U+Q4snj)_XC*mfaO^Tq@ zn2PAv1xk?aFruo?`B)OHIg0-JTgW|5ur3)_FE zgW4rLay3>?7^PkPM$wW9iw{7F$wA?%st@7`JeFRmB{9FH*;Ln)Yw+$9AGx7JG2X+c3flD zvo&!py|g9zOoZ|Izc?gLRvd+o5N8h7qflcM;wu7uZec8Ha5ZrdN7+Fc?qh`5gCcr| zHW3HSkQ>j()>UN1)#hpjAc(>Q7&nT(UUrrP?u)RmpXeQL1gmfXe$3WZuyVt&A_!b( z-(+W!B(?ZzV~Qh^7J4HhfI5DpFoWlqoU3}dXg=yc<2bF>hD!mKEEfXFW)-hTYLc3J zT=Q}yTe#F2C)OlSYKnR{KUPhdYYVt^xw}1hBEt*=qVVWoRIy&H(;bl&MCLN!A*BZ0 zd^||x)z`VDH^-ht^Y>UkdGSquk)WCGQgWz`$}|cd{K`CWSh-X=wNKl-eVF>ZtI&D- zP)n+1OWzq@P?tTpD8U9B-BKjxD85`T6Bg0H0@@)6`=SYn8;H`eS*^um$FFtZbw4@BfEtDFfr?w z-$WL^u_Q9rc$=-!yt&njr^|9~=$3bLP3Hkg*UcqD)^p0yb7;p7EZpjQ*6A^WNg6tV z2J3k}N&Y9xk#RtTOU1iY^Gj2lza}#&Phsqv`fog)Rxi|E4Sp|ZynoZ!v)NefO&brp z%2A2Ity|ohvLCV2o?BCJ>vNX%w=pkL=qUTvd>4s!sT=--ck$VjqS)h3k#AB*sK4nc zd*@h~!W`c%s>EQOuG56z=O?}uPmK>7Pc>sZl~NmBM@{vRK!(U&e9j-Xiob5<)D2)+ z-0;n#2zoiS`Q^?_N{UaD_-dpzHnH^8snO%xoOmBts1$-T#2?+_{!=9IB%hMPqtVV| zZqA=we9Dqt)$GxxL~Q;B{&O2V`E;Rj+g-^o;T zBmF=JIvH0IDV5FYA1myDw4AGu1fkaD6;BvXgNZwuF*7S%09?L~NYz;(17PapiAn+SL z&-4WP>U#0^;ORI9<<`*%hq$6yKayW7l-B^Lgl8bTGvqY7ahB|&5~M?gR5rP>AG<~|JOE7$4YT5+jvRR89f_C%pjF{b6>jGtLf_NI=_B{2P38ijF!ece z?SA4k-8+h}_&vxk1BMz(1O9VwB#zOB%j{MT=i-I9`VvBFr`w*-Mj~5;w88J;j#BNn z2fqHada=iPcB3L@(9g-|TiQ(=*hJ0UV8qUEzOWSmAkXCa2p{iLstf5&rInza-`NKq zG`bP|7b8|L8q)9N(d6v@`d+W1kY=M@@$<*sne9>1dI8HhP9)Bl_vUvpteqj z5G1KDE=S&35JjK-sF;2)L(#3h$2fENt=qCZ+2>Tq9gOphS-Wu(Q9bORaoG;ZhA~}5 zn!gOZk@8$oCv07dhc!ROhQ71(^UD+O9hLt;T#O~Rp22*Vg*~#c<$I9kIJu@`HRxTFX%Ca>v^7LqyYL z)+sCelruzW1tWVj;AXquePY926$S|`zc-yCmVENuMi7MJXDu%556^bi91Rz4;r(w+PxB+X<3)MQ@0hm5v2kB&o%71x+lf@-}p?);!`qF&VRQ^oUlAK^nI)$e4>D!tzXy=Sk2rfPbb2i)n*6!3AT;ik@=DeS#lzp1%R2C#_^Iy)(;9z|Qd$(+P5JBs<^P3oUsIEft&NBe~18-#14&6e+ST$I~bo_ckXV zOfws+B?_u1Rv`){QYV_WCj>Zz6TeYlWC=(gO$upvQa>8|)PCEB_wQ&CBR8Yx z@KN2>p~(|>Xw(@@Qa-=(gS^efj1j#EpNaUc6r9;7#)svSIbaS`8F+ZS_u|6}t~cXd zo|nnEgRJW5{f!SH$~0`wL~4m_I2Uvl&+Wr7qj7oN=IIZBat@te zEnV1qcE3uhr|eTUjP#Z*zoI%bK=iK(5-cCIZbrwMD@j%5*}PVRN>+0|9^T$kOVp*v zpf_jS6bg!w!jycnyyTu zl8j|VQHT{QsIHJDY&6Q-p?x-DOVZ^sXR4B$lRHr<<2GQx;)8Z;6}+{t_vNeTUhW4& z#O0k$)#J!9^52kbT+*)?)aO&`GOK7lii%me;7j_;+IK#=b4}?~mw6TwHterGqo#ES zHCU7Ui%s&_{30-v=v#@i#Yr#rBr+{-F%PNCd4!Wz%LF@fDoSUm~O2 z)fJ+At#bruy|0Irn||+8naj&)*%ps|g8S6vBTq$gYn0dKgI-v3 zRco#2O3dVq`2_vamp zX8-g%Y$oD+B;{E`Y3~`T3szoGy}4mBOhjE$$;g9#1F$*%BF)ZF$|;Sj61E@kR!f#Y zIEcu$-M*Q!&3%)fuoS9RP-Y0Oh1u_XK+fDj`a23keC<&D&E~zVF#k)Bnr8+#&~5wXGwWHi~vi^|j>q<|V=ms<{^= z5|h)v?7#M+TU=Q9V`V6`Za@8UMQfKPsNJab5nJ{zzRsfd#IWg=0@n!jVwDdBu_6Hr zA>B<=-mGqM7OzaT&S?1mESRi4Vk>H=qccdXrE4jcr=o~g8tScj7veS^zv;Pj#O@@u zJa^ClMD@$@B~#b@Hcu2i3O?7)XQlPVDLzT+Hb}>#y6f|6TQ%iF%8^$ce8KCFTXVVr zU5LB~4;OE`&#yz(l-v{-@4B)$ywCHrcNYI#h+4HghbQjgJckz?MBQ~NK{R%pGt)%A z@@*|vX^y$yIMSQ?B_?dkp@j>RbtBHA?v5PhCICl8b@Yhs4f7xyXDwl3ond-Mi_wu4 z`GWs&Zz^@IsTbW>YSs;6K_*DaDL=kL(}KCO-X|d~V9pdyst`(;Z`d4UDpBBbqm?2) z;3RZ3@wf~8f&E>A;B%o3;^6afGEsw$F^0B~?v8WJo)40DeR|Hp%gFh6{Zf$#2M3@O z@ob#GwCiJT$^inr9Qjzs)yUPxbaz}}ZeP-q9yyILk{*?fD1~&-w=fE7!=95hk?etu zH}|d@o6aSvHehiUm+68M3x;mF+v?wK*XlW09^A4V|11~@kDb4G%{odvdfu#PpE#MLw!zIBAjkB;PjTYqa4G&6dQRy(J@4Q!Jz%a&ayZN-r zuVQBq*6de%9m{&RpoOKLCOj&{LvF)S*S~wUw}Y& z`UFc97AE{u7M>?2Vzxa`)Qo5`>E=Al*>E6);#0pC40Zt@wA#27de>PTu*B|j4j-0;$F{_ z6^zhF3o|hQcZr}dxC%T;f8m#q4e97kE0n*XaUqPHFkFz*9LgK4xkQE6H-AoTLi?C$3;Yp%pz+2hx?H`7Kg6$DR)^JfX7Dv}=kwt^v~uUWlh1b^ z0kTyXxxK^f4(-EhiL_2Q{a9TuGe|V=b23O(`S={hjNW39$`u{`l<)R^@T+a`FaE@j zG;g+xv;Hi^MFdK}w})Sr7gS^9wz(X>{W4B=iEQoWpHgBObsr$7jg}_Tp3B#~75Wl) zw3m1+VPjW$xYi{5t(Ly4#)%5|nbV%GftWzt${WY`7efo4yrw$&7hU_0rpjXrjSiL6 z38*5AXAS0#J<$c2S5&E|B-JZMxl0;)YA$x&kmy&hED2t5$H$l7KttoWbA6b2{P!^7 z2)>B)25*Lf6LRuByz2CoLpF=UQ(^ToT~%Q(4;JdSA>TcW7c2)ylMhN%D&Nc0VSN>S z%c%3@32Eo=iyf)$x=i(?n6`=yg*Qb}3{j48^eH3Tvw+R)1HByEg+;EOE|VJ9*?|df z;9`SYpxErFP&CtW@mY`wQ142t;H0CF)A9dfaU zl4ZJg?-zJPz0l8*)ksN>FryG#-kqAQzpdC)y+rlE`xCRecHG4q3}7w$feLs}@xdi> z-szc5UU!W9wW?Vc6&Fpq-h}VmJiV9*4wYgXMmo)Nf*E1i9tnJFkn;|gg#AOIX@L{V zWJ!~oH9e7~_ZwIok`aFV(ApV7&jZI3xyxvuh}q7S8&1X3%vj&a7`ygqXU?!Z%p3D# zVg7XsnH>fL$5h+?xWJ8{z-JDh8_9zNDn|$LhZ?Szah>B?7pFpY+g+El)}wSI+pkM; zn{VrM`#Divmc4^N_?-+P`WRGO+K@jz$x=wRYBtC3hx0x~zLRdh*)XTwzDk0-b$03K zC{g#m1b0{oL!{+2>Mg4$9Zu8HQZkJjuPRxp5+m@dM=3*5g3{%=n#MZ6|AT-KK$JgYLw(6hClf!_1lfN^``#H%{N9ek4UV_ z?^%uDj%ayV8;qg7%&Qo6D}9%X!*6Ybni{0toy_m=GGc9NiD%NlGVi zk{NTju>5`yPW*~?DX{8WKThe~K2vCl(Vg;P-0#h~057mGP(nlfNFzLgwdxm7o(?}t z>4V@wDac_$M3Ok18Lc36apd8UcV+eEu~Nbl_P$15M~$IJitl3lz$r?mlp zQIOiIL~hN;)_^%CBe&rWPnMb8x8GS>HIzZTgt`Y zg{16OIuP`=Sn&qs&^;X|vXm|~;}8jNE=*OLF;(JCHP68kV++1;-+Xc9LEI`Do*wfK zfK2BXW3Do8F5_!5CfDd|t)v~aUCOfu$SC)1^^K$EAk>W!lh)!BrD*`~YvCv5q+Bt%XO zChbRlJW{nzMUhT4`EkunY;7Mc!sq?-v5fJXu{Aq{h$zlKI$&jlNv6AmTngeFb4Wc_ zu3X`BJ`yT<6hO9ilM^HOMvz(&LAD>!PqiTHRNG$5qTpw#7HV0wtxu(wgeyz?T=%^1(+U!b0>X{RdztnS{;z0--rA2>xZPX4&$ywJ|LkhG zrS^`ZCTM6yaEzY3Yb1@V#6>dDXk1M*ef$sIk}U&2N*!HxEj_gZImL zt8L3UQA+n2e1DW1w^U0|u-$aQSZ8n;>Y?P{jU|i53cEM~d@i?!XJ-M#{`}z1EUe+( z!S4C+#q6y2`C0Q0aE3TSp3R;Bx(2ZG{iCfNF&KPn5ZKv)0r27zLj&XmF%k~*K8aLH zL7p#-p6tLHKHu~~?!z|>VLtH1Nddctx{D)tTcu&c*=JOcG`JFJ2kQjjmvI7y zh|^2NRG4a9INIS7hgeUF%WUq+HyYr z2lN`?gG>AN-tcAU&d_t@N%IBp4tR(}<`<_RPK!@q@8D~2I~d-j&hlvS$k*K!r4&TX zYvjSoj-gnACM>OM$CC`PvZ5&lLoRL2`dpmDMB$4-9db9$5Y|Z#J}-P@ssVmx7`X$h z1MiW-GfO!5WS~|FhKG69tH~%T*WZ4}SK3>t35uJHoDF@U3$6T^lX zu>#2kpQCL%FpTq4q9H6LGFMJFdlmh`pr^n1)Gl<`XFAh5i0clVy!) zw4DDyRpcF{s45KuL@~S?SAqY-Wv!uBkX=z6RJXb_g@&rLaFAeBx9Zl~`EOo@#kvA2 zS4DUY@m=J00AZ=;BtQilx6Kp11Lm;-K406Lg4lbhkvvt-4bv3VG`%EbBJ5j2U98&vB zV~GT&;)%OuZ{fm&Zupu-{!m2M8XG_Y6A32nT17n;w5z=9HQGe* z!Q;5I)8-6ha}=@}eik=kRu{3ydVn*>ZF+uIY~;ZUxhrN1Xi;rC>;yq4e^1X5WqE!5 z?C}l}P`$oC$B>*u;_M)B5Z~V=yZGA}VXDNukzLwOdH5MIk4xolip0m1^G6vYLqt|zYBo3Fs)kKGM_a@` z>)ey+Tw5uRqvOvH7>(9#q3-zNKI^?#G{?6Pm}CmeF;XjeesPu-fb>6 zWKRd*CN$d1kY)a?<2P#4H$sMb;opE^Zu40AvxU%JGPvuFJ{DIhF|W?Rdo`c@es%`S zxKW_5i%{y_h4LvtPUyo;s8UCDh~*8scAMh3P+(F7+jvf(&sFx*tZ4KjbQ`Gt_gV4$ zYLd78v&<9-b{Y{0YBWeW{VS|0;wAZKlg65a?tO0)QYo+`)Bf; zc)q2-4xjsrz<>~GviIo5XXH`1A1G2W^}F zW83=LHhs}-7wN362H%%w#j~QC2_!kETlUafIqsLOHMI+s%_LF`#xlW%f`YqLA2G{) z7=wy6^H%LsSM8CZp#&kb5VtS<;^g#{FnWej{zd-)jX|u6Rr_}DCLm)~xp*a~(GDuy zop3t@5;_Zs+?Zfl4ThYg@s+mb+@_$1kkfAi4oXd{mCf{T6iB3?8UK!XfXdDjI<_ZM z$OVPD>wfPITDa>q=FS!<%=_mPj2tG7sp%uYxSXqq0~w4nw@NslfMK8b13J!vndy>J z88WyT&7XcqhJfoP;#ml9hCqmQ6v&3so9|H2bI>S|NJE)ypr9v`LS%ieV-)lZ&l=o34x~XgOU?7V%*)oC_74k;a0WxfPtEjw)AVV2@SYY(qR61nO`{%*&i#0#+ zk}+YZg^XWFK~cG#g|Pnb5uWLiUGypbdLdt&T2wxt@?LC}*vATnK+I9Or~nlDV%Unz zLgY|!h+@xIHjmpuF9MI*Kcu7nLh<|XIW$&S6gzLVMA^9t*=hrQbOi*}f~(-*UnIQ5 zA3V{MDNFtQqSIVg|^}96+@k?B8L$M_P&=V{$S7);RJWWAm%8_pia=c~UpvD%(H*m*V~N zR}^;^%mz~#fOib5+S*-50s8dk9#!qAA>5TZeRUEXWQNg2|McgVf3lK43qVc?3h~lc zQNuydRj+FS(x&E|Yr!W@O>Y2qtunMgu@1a>4TzUQ9~r&Q_9=O0dh@6BW;nO)o%=q* zQ^q4$D$Z4>Tf0?7HvY-0eU6|SfCCyp;_k7ezLMy?zXQTmrToyCTyo#w%7lf#nsZew zB~bgib9ZuHV)Bj@^g_7@>o0kh4V1wjouHhUBKT27;WgReJK^%Fek@Q5(!2K& zR7i4^YG{M}P21^oe^O)>1W4l)E~_f%3n!wi?6H4npntiMnqN7~UCx4=-rO`hn}eeH zUlOZ13xYT!u~Yp0XcSyQNg+8QBK8q}T4eP#mG#L#E1^V30F+IzTB&}z3O@a(UJ24D z>93-yB1vDhcTYv}3-D$$$C!ZBrZ@l9q?cEP1Uh)wdsgp@BA_`2BRxZ|xw)qp8()rY zC{~Wzyr-Of_{p}r}5~2V;q2`-8;jCj_ z_21=P$NJl^@aKb-0EPE&a_=p`L6^eCdy_|a`gRe`jfrpXhFq_~C|_2~%(AGfHO`cx zXSfJ-tq~{WCmi~-!Bl=B-n6;ez&EE9%Q`cyrpEu(!c6Yv4zTAoDx)skttfDs@R+b% z{S2_!yoOEvcV6zxes{O#+>j>%#{^r>8K^&2Yc5cc>ZtMOq;p6uI)lA6eAm6-PIE(w zYOf(xA5~M!viP!%pgQ4EmH7pEG$?|2ox!o*o{9=}#QA}eR_)c0L|bZgm6KMVv?SY) z;`F%}{=okXiqmR1AL`iY6IM&3##X(rSe1B8Nhg z?HiD8i&wMVfRtK37${iYP)0iYzMCKAr%-37*+Kbg-h%R#Ts>U$+doO2{Z@p6N^p7? zOp5p>)x?^#%CM{>JGnaj6~C^*xQeu``FgfW8>YV7b;kag%=0aMI|wcTpqxl}rzV9W z-tV=M^l!|lwXr5I z0{u^~@>Oqxx(XEI-}Pfrsk-t`;HOU-fC^4U;Q#7gY5ME@3i|(=yiG}0T^LeB_?IR% zgnwx=QF-ls4z0BMkV=W6MGmc$dRgSRe_2$K`7eubt|tR;k5wrCmw6QKIgNi8&q4b? zdNu#{>U;keaJn4dUR{^GO}Ss87H8hkfdos8Ul=lTyEIb9v)Pr4jPyNujY;T~!%#q>?+w zP)$6^o36}Fz=2>QZV_4DTtJkr+%?)DMn76%vn$_a3$YH+xpa|hH4OO$tlSQRQJ!?3 z4Em&1h?4_n3nwVSB}#5C{6X|qeEb1fG(6YhJYq$vo>6nG%dN6$v|Mbfxsi2!4iAVZ z;CR%$B1C2bcPB8(Z*7&0r9$GF?xQVF^3mqr9QeK!R`x9QUZwU$A6c zwr1%4t~~mbcdtLP65ye!@zB1cc(XE3v3FwJv%E+5=dfEcdV(ya0hpRAm$0=}a#u@C z3gLu!dNQnUfUF8_&kZ)8lGo6os=w_$#S*qEv5N;hGwM6f33(QsWZesF-c_|VBG>W(# zQCf)}?tzX}sy&Jh-W3sLp0?Ac$lr8-ngP!Rv1vme;6Shk2k~b)iU7m)%mZ-JYrHFf z6M$wIeg7Wjj%}%7#GgrKcH~iF+U9j29YLVdGopAZgtymjsx?1k7 zU-I#J&K7}hpy^!r#y!JC2da*~TNiH)?gaOY#ckogKpR@CuNvj@O!GP#u9P62&gU+p z@I=cU^a32d=pRZz*D87g83ZF2x?Tq|psgPo=owMf_hFx}YotNBK4Q0vG@i-M+sTyp z58B4V-0QgzX`=^bIX@Zeleu@JMTXG7z_5qTXoGhd5NUVa_gpd~<0#DOl8VRP-9_7j z-lVxSoUyGvm9eXAr3%6a+-n~+V5y!8qa9TG-T;tPh9j-uTc!^h22@WoxDWVaelnsr z7@bG>-asaPB?v4J<(?)-tS-O%l({SOtZ^2D=F*9QN3Dsgff5{#bEqB(jz_k;QW42wdD#-Dd$nPyIGf z^E+9rKC(!#d6tR>AHc%8e305CwgR~Io3+i3KI%LOK#Xca@PU<759H`BbZiqGK4vT3XKRMgrw!T zq%_oIz3i_)$A3HzECc9$b14U~THYeSryW@&cyM|8nGg7{j)KC)9nRSnRAAxpSAl_` z)+4tQ%9F*44V{Y{Eab1&1XCS9nG6?Gt9a1xcx$h8Ve>!|F^cYv#6e+-+nXn(i5MNVLl9Uc$e5kk|0i}P_QfIvKW&GKpQ$y%D_OG zM|2OXZ3#C#UxvMeqyV0ZU-XUvDIO~$j?Pgc1j z#t#4;819Et;KUoyc+v45oE?3+}K! zEm-x*tp07%#g$K?85)U8y&ET+a4PBRM1@3xTn01SoU)NdLLwpt^6Z1GYvF7=GC~id z0*v$ET*M0*c$4P%Dy?BX2tDAaeBnM|05ji#@kk`WK6z|@2Xfa19n%Iw$}TP8cW=A< zpnXhyL& zDPk4y_W1k{|ITLhnfoSFM!7*dFwo8=HyWq_2mx{?I`5e3ycj&NBHoQ0#xd{k-$&f@T0F_RjwvZ ziq-2(FPeb>*ZF{9hFw={NaBjp4ve#BcjcTD>v^vdXys=1hNsWZ6T>2y4z%LZ1DSY~BfGaMdLfjrPL-t)eINy7uc^!Dh2q@8i1HUrS0v0dLSp~QcAdkLTMqbs*2=_G} zt9k#0$KOb_U_!{+uBhsxt}CEdj=YvZ=TO=ROdtJv3L^ZU073SUzR~YhS_QyJ=tuVd z4i17lA>1^voQ_Xky)O0X2VDg5M@a(Br|%3G(1h1aUlqB(rKq7#(ri7qEzj;;1J` z?>;C}Hq%ri@P|vJi(nGZOpy)$kFGC|hqC?RCJ!x|w22Uvlq4#9VJwxRLI|Z%sjOKm zOSs#N%2t-7EFn>1NQEpD6O(=4N;LMR>|;0cp8Fp4^!(oU{l`bwT-UkI`JV4N=X=ld zn3>%b7O$<0*I#G=h9%vW!<+`v7+*?S%eoCo@|K&;2#b+Ik!~=5HE(zuF+|XfuL%K+ za~EmIB!m0rz_|2|3gOqAHVwMox$!Fb(Ew?^Wg`jSFkQml%vfeMqMOGoWzW8)M?FF} zhPusTUW1^*nPC?8E|b8`2J`+j>G>V6$!K-La_4oIc~Ry8{e`eqi0#Y`<{;Y|rWEr) zlBeO+?DrpxnV2Mow$o$s6nPcY`54)`(V>#@h#3W|z&Fe|`C2v57G4r|O!EfAC$Ub{ zwZNx^IkPHOxZ$9O;RBiZSBz5jt#ht3=1ON3r{)hbT;pbUv64E*@Dr8&iNts?H(gH` z_r%OQJ;syT*D?J>VZ_9~5@rgnIDXs^5la;RHtjyvTdk@DAkjh%C4#}es-SCf*w1+}b{@yM&$ z=-_E`EHhyiKIv27*YD)#ygqVi+LzJfXHYWBIkg`y z;y5^;(}wsOU6!EWJy#P&@xHgXRr~<1hsNsFj|C_gQhu>(D$fLkvt}H;sugG zIXxG`RH-8ut{IrqJ;AhDMkj5@Fx4Gw;=bscCbM^^Y_G+#5A9>cX|ZXonfChw zB(Bg*M#1||yBS&nW4cO9 z$w>I8F5MXA$~alVD(nZ8#%uE0y@W2^(eVfdZy?(DAq8)(n2CTwkMPXzVCP+C5o66H z1Wi|mKa*~G2Fvh7zd26As)0Fwch)!ruQ9Fua~Wz`Js7)klXh>Vf3a}7WK zc{{zZ1_V#`a8)d$;o!gM)Qs1`-fD@_`MV6rE(H7kh!y#bG0UGP`BP~cZ^W?wyiUAS+Yk8OjKtAkhxH)!e9g79Y44W_g=2slQGG9Sq z6(chSt7A}Mk%-74NzaYQ3oL-I!kC{QMiJASGFMtiR;SrPXJo;%YGPl(7gV8O>z`v# zw*J(e{TFpNZw-{+90TSUHPAlwtd1Q)YmRo?-Jrg7@9~q>b znG9;E4XK(SIo_QekAeF%z}_H9ug#`oHd$t2*Fpki36>g(@S@2?y5HETx&So91~yQ} zt#b}Z2qNdSz*~Bz!VJ0g5|Lv~retT+Hik@-d2DXOyjnY{5^h5k!WbE>fGCN}Z8%2d zT4gzF46U!K8|4E~>d->+%&mFpCASwcbeT4K>dB1h9rfg=(2wb)%ln1&kj#GaELcKw z9MpzbLW_1!jz9)c^PwhHjEFMkYqJe1cr(Oj)>vi}yW-}}9^SKP8HxRbLak)2N6jj1 z#wI)pE(9Ba1>3V2Y+$bzXUgm^kpXjv$7k%+xX)s+vy2EV8CCeADo7|Q9&Yz81=b=; zOo;Y#3}$BgLNX0l&W@?~-!=e;C`gRgtnnRiC7RhcH(pLR7I%;fVT3X4>kv9tEl_n{ zNHhf7opL#qyuXfo@`B2oZYo291;OuCfkgzG@v{tN@S+r1L_XoO$IqBDCJ{o%a6dL{ zOaUe?`O}cVDvDR7Nd2v+gPDNvBBTGhvetY6DjobRi~ubR<(ADDIL6dQUirdP0bn}{ z66W`+4Vzl$Ox27zf)a6p0mN90lMR!yuzNgl${d{UpD$o%SD$YL9zv-w8H?Crer`cC zv0#ceE($7#PzSMm0$rkGTIWcmmuki-FnJNVx|us1EWPmhxe+`<%zzxN* z_Chs7-dq+M77HMfX@q1;_P}TXilUMsjmheLVJ76?9zw2JA`I(IsLq6{fJIh+kc<*#dL!_=mMj33yjri@ z94IIlIWtF3hDTg<8jgVIy@R}FyoPxq({H}Ba%>77Ot&)5&I*cYCL-?(S{U9767ZxJ zHh^_}Bc>T@qIH}MZ4ktNa}e11-nFO+dX-pWIJ-LhJ+uM* zT2KCn9(l6>qP)+X21;co^9*!}T@7&S2u#1F_o8Ed8=9Ec!^{)N)tiMzhdr3PVd!ll zUvccI8swWrNQOuP$NLy&>M&dZPDa3kAdet_lO56}u7T4>G4iC`r*mi+=gJJS-$0dQGgKF?U!C)=^L1D|k z!=R_Vfq7;T*_r~L7)R1T32?I4%>EijCsmwd2mBipDfW;8 zJ~ZR$j5CI;e(jFJ(*Nf+?Ih$HsH7s(xj6>s(q+*itG~SdW)AIi0j31Jl6-sC*q9}s zev24b*pH+=#~?t^Sv|#owk*NIWWD8Ywbef7aDw?-JhD+5Oa2a~-xAZs`6vPN4rS+n zHr;r?o(uEV8i7HDDTd&H`Po;D*DTBEa5QFQc1@7v6~D#IOJlETFSYsh8>RbrNH0>U z%rpd|JX(PFBS3YeBZp_&Awb^HOq3HK66fYoH-Li>#mUI`&^R7uu9Xud;qQyqH~sxm z_ix?wBc_!3AZp1%$*w4T5MZkYIUtuW;i4{8-z{tgtIyebh z4@+ctq=`Vj>wv z%ju-ltBmKMFEACks4xD|fibaQ^OxnsMfzgVfg(Z`3d(i_!w7w!bq@OP+heD=v1yKWhU|IZ^?OIO7w>+77@@rjp7^m5 z%#B@W18H2ktPy)7;58xztk&q|kr=wPAcbiqA5{APwlQFiphi~zR%Z_iz2-l#Y-5`f z$n`X`A;!vCLGS@)h{mjOH!3y)dUt@tmGVQ?BxiTZ224G`lL&}&W9SQ~k1(~JE-%1a z7MPU(5tEFpqLW}34BMhX^Y1z_xke==XRaWQ-pYOB>t7r1&d=5Eqvz$l7BXTEa5p4x zNR8HTdR>%kygV;I+`#CWcD3K<2tKJmjbE>d{0v~xwJLJbP+#%8S#9*mNYexPlSljL zVe;KC5*`#r2zv==bSD+*=q%4utx7nlcmJ8-wMwZMLPmQ0HltxW8l>T(Jv&w!tv}I- zbQW%__d2aO%yqLkKYaW^>`1vlNGU7XAEws`pVYiH^xEm%H+5&1 z4&2-C{QCGInx~7k^>gvMj%4Cpg1NrliO^Sf@v&O@VpeYx;c0z+xAf}S^7F5K6T>xb0Dge-)iBkFF)D>UZ=INit?9?${ji zlTL)Q=G-nehYry$s-!+v-y2tCT(&GvmGo$xs6;G(O<~cVB)NBPd*gCe)zjcTgVUN~ z^#Z4}8aWg0ZXn5Ro0!c#d_p_v?nw>q@VC!TR(I%_VzKncFcQ{CaPBsHbz4Ktk7S6& z66S@);v=3kp5eA-GZsqL4t41Xfvc6L)i=fzHAP@Ihm7uAkr?1}(R01!hfC&%w_=wh zB#K8O{WZ3V4@M;OwGZ~u-El?@M_XH~Z5`Jvv-v5RzwBV2`r1;-D1{jOLZ|O=7oGs$ zL3ORf`lp@aTVd;;;+3st=ABz6o-a?=mfjI-ps_s4XWP~Fmi^i5YrnG(OgNh-Y4}9? zoDkn7elufw1uoVykGL!mnd%wFdrtL4&5N{}86ofbkx32qNFVM!dhM4-Ir%lJJOa4# z%)EEhXPRc^FX^`3KynbBc%C0;pJz6^J(Ogc<+-H6dV{n%EP9bnNQXx)hkvF9s*Oez zCD$!eNeWD=D-$!<7>)4p6VW?!d9;W}gXifmc$0T6_CtB$dz|>DjOnjjvA!KL4Pnoa z;J}@+SIY|%xRX|9xb^d62o8v)rymTP;Wpm>e59;n*Sfoe@FsqjLTSOsNC949@k%$G z^t`j{&94~>uk~~?>GFzoH3bV#ZgU)|9-I3{3m!r;;!85Q$&$%;Bv zOAS})WfEXt?8VZ6lap}N&HAc)fWFv?wYwBbZCk}fNfZGORZ(e$%raYlrGgOL35D>r zL%;X!O|*Pl5Fsp$b6lYiqsuo)cMpg(D@k&Esiniwt!=M*)*ETMMJPXWRzOKEc(0*o zw!XZX(_~L=t(si${yf9<7XAkTtw-z*IuV60Q8qn4Ax%%+OFX?*p_I6*vNk^9*6FR+ zJd{Xlw0&B|1y$qLehGL>Tcwv6?$N}rDfUqC5{1_?MT=musgLtqestlDp(pERn}57> z?td;;Wa^PC`^mPxA4zDFE7qfS9&T|g+UOCAbG^AguRf=kzw|1YOjXng3g>bQ09WKa zR~jkWhvJMQ6SUZQORpOCcOR55*1L!uH1&8VtEQlDrU(3UWz@r z?xIR5F(_#hc#*{cA-vdv6zd6epuw9CK5A04z6YTaELMhzEQU(p2ou5FSbrT{@-+LC z2=Mhg5%cv*R>Zl5?@vo}4yZ*DDsAt+T?y$4O8V%C-cjG*oqHJjefr*OZg^pFQ``z{ zQ-mY(@2&{Pcp2Nn^~e5=J@g>!(#zc^f5Ty@j4mB4x`V+1WpA~Ic$*6&#Oa`1t`!34 zjl@#HhgAsxv&cp8^m-?ZNWDP(y!LjXU+}54N$`@0|}a z6vD#~xARH-`ZcU8boV41YE7Jz6=h2JxWM^DCY)bv0g|(F?MLw|;Z*`83%^mmCk%ZKh<=Gy@{Tv%K6koE?zvOw7qun`DU734868@}r zlxmyCT(;2R&pI5f+GuvIGCy)_bvLZ`sX85b$alF>{zsa?H=pm3?FIP_*97dcr*bmiSR$knvhIl6oF(e|1^T$%Pga zj69kKFzKB)_s#Ib#^LQx2662_uDU1*u0mgU%*FOPif)mr;0ZnQv_SRj?g=aF2|6(- zyKMwl3BRLJRBGwOlN3D5=|l&|IBJWd)xrjkF1c9`3Kgz}&iqdHIsHsuO>N&G)W1s} zO)#?mQ4?SiOVx=_E_1-ny`<`J?!W>-wW6 zaDCD9(b`Y0xJu&G9}L{ApEv!mb2E3C#-KX}E!5+$4JRfP1y`lCJ3p0@4p1c_XufzW zVXUBs6eoyHncb}1_&Hfwzsc%6bd0S_j;;E6_?!mszvOw?#HMzKFvM+CF9>|r;W$n1 zPP#ZIz-Col<`w(EgVNp9FDG=G%&Dfs!G`n5mNwLP$eQ238wZ&H-m}T}b?56H%A<`9 zA}FeQ4%5r>Xs{1TNl@xvUljVf#{}SHb!WmY!kr9SwP4%x@G_Jk&Yu;eaq}8QEslLS zhiYJr)h;D>2ok6{(wk62_pvEOlmD_eoY>*t^xRHy$?L{v&RC{r5@KPn-oX7M+n11A zjJ!zcI#wl(E6S_R(Szd0dF&+ZwceGT=o)L61w(mQZZ*U{CSU-L`F^`WLeEMso`s`! zDg=Qaa#EqVrdz8R*jb3`!oQ0i=pFyv_j~Ce^uY%*NEHm9HPu^_p};shtLW2QIiE zL=fncgXWyVLH~IJraqk*&V7lJ$ZPpVtHtpj**DOG|K#c|Z5>dl|G(Z=*P^6>hYJAY zoh(EFQUj^2z1cRx1zqT#2c<|6t;`%VxP<+=I@&_fM#2i@`(k@;+$}}#V(sPO zp|L_#=Xij=u$Kb(^cuvTylXk2?r?1%%JzI)Kn$7s(f&OA25PpuO<#=@x*+r?BTYH$ z4A(-B!P~ zEcB;>^JpRRH>S==|J^TZU>DqTyKUg&G^i85&u&35mUmpG^uc2f$7}c!?t|L~~ z5LSb&73?NF4~1f4=ba#O-)xghbI--p23mAjlWZAT{--tbfqWX_=DkGOVJ8gJVzFzY zg${O`l?jPhGEnMx-fnY5C&jqH*Pl@)0u&6D}#JuSOB77J1qcr zXa4C61n7Kd3;5%9xcLqeHji$uSX@I;*q~<;Kt8RL4`R*8#UAk7Zu;(@A%k*l2iiW+ zt`%F+w!oTDaMU~r_;MaV^ne+#a{$N3>hCa!p=~C%F8_(jb~-3lMY#c-mfH7MkQru0 z0E=!&nt~^*S-z-fTkcVlQ~U{p08RwhiDXjHt+xpise2veg>F!m4&Y+IBub2GzkEGh zyN>DfoG7rIH@cg?*0O&QMVr@z?WRUwUcI22KZuL&`AJ1-`zv!DZ2 zYoND&Pw&N*HGq&pI7=P1!B{pCfJO{!`?}zb1W*=_#~A7Huop4nrE2E z@`NeCYkAT;6zaRdww$E}J=GHa8rDLSM86f}kgdk8+$wAQuWR=&v#Qo{4?vWD;`k1o zi?cKrd(aoRHZRpR!1P&Oj^=ILkVEPb-L)z=B(ti=cj7mF>8dA0ubRHMw->FpV^w5Z z@ya$cbMf0Ziz|-12cTw@1m6mK#;(=p`Iy~I(ti(+?d9hkvaATJRot2$_FRv%WXBDH z8~{&r?nu?#k-}RWY(qRu;6p4Hw_d%yMkOgW*j^~kH!M>QZD(LMoVZk%rxGW9((PA2 zt)Rmw@iCB)(&qT;ikQb3t?Z2%CKd$!U)2pz z?l@nx$;w0v63E%FTv3n1->pV!G)d|$j+>HtdtSE5^`t47<>S|?OlydlpSQ9$QS0pK z$t8XW4uR1yo!e1fiz+Dr^yvT&pNo3KvN%Bmp_U6RLTXL`GdHsFDOHfQ3-g11hT%FU zFw{EowCM|-SasgP4V^dT8K4`Ge?S!tDg))fbB!ybKS0Q1H2CkmpL8U=la14^uzhAMl26>97? z9g5op^9&yFcN?Hjji@y1O;gByQsRI<&cg$TnS)z}Z5OOU%gN4$=R$>C5GL^c;W|KmRZIXy!09JP~5!@JTekTzS}(fn1}Z=DrL;BWMT^!#c=c z#!xl7c;P#5KYE{BE1lT%25rogwvj?~c1uU%Tp@UmSEb*S08oETcbp=Ky7hW!^~5~; zYo~~kATk7qqFs5Ub>tD&FrDRFqXePVj|o@pW2X#3LQ*d$1Z zUyR~^{eW=~8=%`N38LOkIRDq%Mf+~{|Fdh+i)m)>&z0fZvI9itC03~1%#!(e;~6w6SX7fxm4#Ud@23Mm4=kZ>jCe9Or3I>*cCGKZjQn6V44EPNe-U7B+{shBt%o9vV%P3N#6sKnv-`84C~(i`3x z?X}=_Ce7ropZyS@_GhF*PTn&UyBFMjNmG*dB+=pUr3qP_C3-k=Mb8aMIGyv~3sM}W zjZ)(i4eqq%e#bx=Pp?os3aj@2H!wtpr^I!$0mh#`%Pm2%I%8{sSw?pXj(j5Ob~iK% zJVwFAZUoF_+)=N>;hQ}VhOa)yE*HLqz`lXY;=sGinE3GH=h!zQ>)ca{iRRs7ceHCq z2veTiRw1&H+%K2j_<-V*oSW6ycP&0QYh~|kpWI+u*)pO-FmdW*qVj|Z&t`r;$*wT7 zcvE?y-Sr%$^@E4q*WB!8?fa%6q*8iFSl_#EtyH|i25etTKFw;0)RggfjJoh;XYd3Or8g*ZYu?6MXC5pKiZulDI&Y@aIsV7yf0)lOD z`c$FQM3#f%)0yIDI-J}n8SNB35c&h<3zVAc#$5rdH7`odZsV>sf`QlHZ4J_0AK^WP za?bHxJg@stfncJ-fM7m<-ctZx=$F|c;T+-%T7ZC`bXS8JGO>Ii*tzVTtaGrdBsrZ{0j5khc008@UJdZ)*&y)*nX<8S1Eij6 zJW$@R|Bsj8p*EAWhiI)3<9Ek@v1ocIo4ZCie{lsL$6D#0C1##(A4yi0+E#N@uPfd5 zh(Mck=(M`gUl1WY5=SZ7=bT(@(I~Ixht&L!vGHv3Yo=3 zg))Q~U+~x;!*N05elH;a=kOSZgvsVM;o^5#EAmMmCVgmxM4dib(uW1$>_s`_n^!lS zZq_~aeVu%6Qvei?Xr^Yv`Qh8Sz9mV@PPofx`W>?KX&AF5bQ8JIG%aXEywb-I;|}ti z`kf}^ubGJo{ppkUknpHaw=sr)D5vD2(1M`q3u>%u;L6n5eY}wRFwyKyvIK4iluB`qEt0+b9iNu(%F3dQFxi0jTc&0PPsW>;@@*s9^!M)md$Nc$c5UcM*At3 z$~oT7{!*4A$D-*faX$BVnm(e1hX|FwPcF&APX5^7u7rlrhSDY^{SYFY0#8=&zmz4= zFi@WOmz$v-nM$kL>d;#FH0LnJ2&xYJaId;T*+M&p5&;ShT2@*CSrna<8b@SpZrwdb+s&_+@z4(Fbf@UpNkx{O(Cr> zrG4FI@mOr0O&BgU5@XJ2F6LdT;L6)Z_EI^-mo$`Llr~Ox`;=RndT1y3cd1bh?Z84* zx6+D=?8N}~Mq>e}Kh-Ay#)E0D-V=a;3$pLOM}tPpge9L6Wds97MK4WY*8&BIkH5eG zX>k-v5NEk^J6CIE+}LM1fW*{it8``~%8KZ3v4#3~$G&&I|H~J9-xa>>50nYERszwB z9P0&mzD8r=E94EdQ#=uIKd4&>t3q-%kRw8-#s$c=S8A(t zuK-H83|kyVH>I6_P&^Azp*U<^cWEh* zN|{Q`Ty=x5%M^Zx`a4@Ug1LZI_aDcn0b!D}yQB_ukm6^8iClcgka7_@`FROr_Zm5m z@8Z%QxzGXY766ka=LIcqXeW=57vh%YSfD}Z-}D+*KXu)CMgOQzxQattREpfHGU6Rg zKKD>tww>WMI@!hgC=%3R;d@SxvIV#O#vLL^G%2E; zr`L=l>8-!;FFp1R8{A*X&SQ*n!KpzxIR|XFc4Ov{7oJuiXirk^6*!J|sq;PB0+pQO z5oatYJaF~pfOx7Gr62^NnI-C8Uml1`h_ZT^P0*xw7>H7dA}sY3@=EV)i1qUSJq%cVT%0hi2!616fcO^Jp1XPqkxs)Fkxqt zqNL!e{hEidiRm3%-WS$90?7nK2?~MG_ghcLQ`&rnqtC*;_I7M{e8{#>&e=8q4YlPx z0+Vd%6poraxm7xhD6&XlKdjPlF?F&rHz{_ku?4L?A^^sa9nNjB>)f&Z&YFwph!MQF4r8lYN9 z+e+$xYywR*=d(7b8wlK-Pjd@9@>@JTLO^uEHtF_z7`=FIQ~6{vKWJWR8QE?^w$l+m7>{)B-|uj5fQ z?lduS;U+pS;exmh?woX>I?4iZC zDj-4!N}OF>ey2;YXrD(Y(IWZO9{{MQu7pzU6yV9CN{v=kek;sdbp=F6|?8X_Uh%r-IZ3grKK|>vlTY3k7Zx z$*lI$2pt>)}C;#h-uuGrQ%h!AT6n^@^g*oDrfBMt;El!eM z2SvX57I&`|3VI_PzcDd4chwn%SvUF-KcJ9jd zRWc7p;lg{7&(QehDc9HGWkoG7%vbwI-XHbJe~L6;@9-sdwVn_P5{nR7?<$FInuJYa zmY3(NLn9+tn}{90#a$}{EabmT*EBX5wwuNmlblUsbWXGlMypS3QBvY-<(t)JI9)F_ zqZiQ;Es`L;sNL8st=4!fsLr|5cUyPf&?}yJ-XUqeHxps=o$r1qa)~N4J-#PN5B+p5 z&^9l@pU?^H47#s+8u@__8I6DAIl8cGhHCxoL8tj4ks0dF^X}y8aj{sR{9xnrbJNMA@+B=@OyaxfD4A!B-{yF2*PKmWYT z!U@q~+=79)n#tbyZ$MqEkLT1!CcX`P%(^k&xd^Lj{ z{Y4?Gh{^Td4nq;<>P-CH^JK5G_kO(d4AnIL3+NJ69edCvbGsM?n~Hm@$dx|53zQ38 ziU0KOxVD-(8Ttd;OFZP3gXMfyQT!;KZmQl{3E2yYlSocZ}cBA1j(}XcT!Yh8I)8FXsjO6JWm+ ztbMbZ51kg$wVP!e^{iw?AUm^jMrq|8ddd8A%zcx{`OtZxz(Tk%>0AQo10zitcFY`2 z`8>J+0Gc87H^=Ja1@U5d@L)b{9xNl6=__z<{$d>bG+Pn9%gO`cXf!=dZn@rR=}*N^ zlm&M3ZTKRRaPB3kIF!=&eO#%yQv~IMB%7*sfuZ>o=4+Y0u{nw2&T6fhnT;HFecYS| zD8hy_8#|r);^*i6+2tpk3Py@1oekNzy6S8`vRBwwbux(moTdn0IUNWe+zmd(2DOp*TinEXneAyZ{ziUl_1}xk zpfV-Tco(|~&AKi8Yp=N&jVCs!No4OQqN>!Bf#jNQWO~cbXz9Je%<4fd<~{aFstH&e z=kW`VK`;K`3m2Q$;%z)I%gI*xS#xY-`yGOoS^?M-BUUx zVDJ4Id}$WG04^V8ChhG>yi{I=BJd5-T$vUt-7g~dMQGO+1@He{y6H>$>WtaK$=ws_ zDxcW|XM-6v*`tN??`O2oD1L3>YOW54qOkNnT{-VRI_*nPnAX~shcCYU3aM9fd9&@; z09-IraK(H7S0RMZ zOSR$=UnX7M!Pq`UvdNn1cO3sER@})?t`XLIJ}x@NXfW-pAUQ{ftl8n4Un7h>*X`BX zhll^X(0s&cTy(4pwK>s0f25~Zu0!a+?o%=4JWEPrb$gbs>mB!uB}Q7rQ_&LsqBMcB zzGyyWZ*StDRz5^EuSuHgAd5eoQP-Q*Hs8&3tX5*=PA}ct4NC>pGaZb^Ns`dDK)f_V zT~BGnMejY=@~e%JZ{&f{kILp-jRNP&fO|iK%+fxR-!JTK)JIim?!_N23@~LMHAbjuvAu;TW_&3@MSc`2AhU;;Weu-FN~qCT10$8pFrj{85Or zL&QHux)=sXAS{K?sJkhx_>2#ppE2#MA~}x+-3#wzyah+*METwfIaJ_|L8$v4pEwg1eF}CAMb*V8H^Jw@7*@S?1`khs5KkmM#1h<=#Hm@oVP6>noFEfqIG}s>*+npn13U;6P_n# zu%+r9j7MEnYtEiiTQSu%WNz(^oN!YD2)50PXK-|LdTnQZifICuV`toh@pxOWQj&8X zc|RV8Jib@8+iym{tZEaIpJ(L_$5wPr83p6DCJg2nrp)U3$Pwp0Y)YI?9;+MeogVKH zxf>p@)~f|k&O_ub^X?JY%DiYvOw9Ys-NxDFJQYaQa%o@H(V%UJcjLz}^X@p^ahHy& zOumY$SLa6O-ZiGqU!4aUy}>V&*1A=WZJUK{`@Q$Uimz&f2o|6uxzs48l4p{qqAFxw zDUMn@UNzdwFFeXqSf&r8&t@dOm&7kRK943X>(WeXyNybjE<%mztQwsELHAw6YByko z!Uqws!4P6NXdqbB_0dt z2%2W4ow@%bhU1kduc}jN2<5ts@ocTf7U=ORqOM{qRSj{UK++ zPsogKvSU4e;;|$X8%dw7a6YVcn-O`1R=}vGF}k*qTWUTj$faj{$*hs0jjYS|-rZS- z)=p!mqy@yzl2 zJwhNUkQ%9@Z9m#~z1()-V*Ynzn+*?d@{O~18l29DKW^RX&!|?+58w>gZ<$4#nV4E7 zWi+u->y3lL(N+>S&(!IyQ+nw_)VL}|n@s|pqMFZ*Ny z?b_{w%gy)XWlK~?nCf{~)~jcp%zcoA^_*04e@rMIyuxYgVz{&18` ztFG7Rw>ORYn~<-mmfP~sgbv8G8hRz9ga0?d{~wy7c}uQ`EW;a04qpRLIC&sn_nc9X zGmXsyQ0JEOpzeMIcZoONkYv$RjOaaA)qHnAqC9dV$1}`Z(T-RI;=Jc-_(Un>yFxPk z43+P@Uck5GCl`_(pERuL>Jw)4kWsnrHoA%o)=Z120!zoT{+7 zsVtwLQgx&d;SB^N9hXiP<)+flQDY#~olKx@y%Ob0v#|iA`N+(#?MLylZ>x^fi%6Vu zd5Lh9br#CUJbK5J5GvO1V4%eTj4QVgYOuU_Ps^ur<4|e-$EHIuPW8&`ld4wp2Ca~> ze5-1}(d%@_PF1u7thd=>D|dQF6TydBgm;yI7=wqmY#7Bso&3EE$0mL*=8-X*M$t)& zy)jM|U(t-TDTFk!J>QE!P98FduBG2S4j-9KcFb)8=3CBPAT*uxn71C3N#Au~a`N6| z>XAX9bVFV$JAJxtNabdZJI~EWv*=H#d%wYrIt}d=H`x3e+BuV{)J^Lm6N=-iOx`l= z+c?g>V@O%4$OeuqoCJR)&ms!L?0X0ZU#_q~284n9bUNQF<2o+Pwr1kn+0}D{CtrDG z2wV)}J`j`rY>JIPgA6~DF1V8byZt#1=*IX-SM^_`P8ov{0(L>%IrQ?gR&&WCGb_p5 z_5f+83CGZAu>W`j=HeXu++5Py>9ApZqt18CN9^a(Az{qzHUwQe*oYcd3(oT`{vm^> z9hlfW#hCiw#iWQZ#}ERRLTHvSZWohi-k&GwTyZ9!bi9$YJns$tIXYfa#j zo1@v&bb^Wm(~@oP^RB06l#>d}`Kc7P+6Tz@{Wc17*M_M}|0((yMxk;@f_1ag>1T|7 z)$UlUIfYsuZzh2+NJ4K*2*>q|_GtqD`oXtPgI1gPj~aVKtLU5yCxr8VRB&1OpkaJk z@0L#oX(HE~|JHo!p1Fi!AN6z(;V8|tkz8;4Pa{2svp4KibZ4(!@K5PIYMz=by@#&C z(5}kZvHIs_@>JeKYO`d`wD|3!%#K|uRnbS&bgJ}MM$vP#Ud*}izAT>J6<+NHZ#@sE zt7M)F&wup;_olZNc{T; z-JOmu@OO^N?2fh{eRyYrKWE-X!Cjrn;nYxHzBVRE1q+CPmr@rxINNlg557w*=40}n z@i+IDZh1j%P8~niR>Qm*nC^iHiv*7u+>{VAHe{${kY&!S;Vp=Sn-(t{xO@*8CE~^md*y(=vO#Fr1x^|14 zN*VXMxiu@#`!|gDtt1xJT~WLcyNfVHSQy8>b20y*U%lm?{Ppa%ste7CH?!hfV-wkX zhPqHjrU~crsxp67^|U*3=g-ro1{VaGXPO5E0xwVhs-joh3au$nb5m2E2z4-uywA$mT51{z>G{QC`Y{hx#2ZdEp^_%ER_1J5=Ln!lsE- z*PB*JIkF}GycEUHJfrU@@QKBa-=bWtLzc5!gc2*d(o(%W@9D+n2%4o&udXsWKcuN> znX4mx{D@G7yyv|%M=yBwyy`zjlB%EUWL-oGC0CCI7-zg#w?*&#wp!aQlt<@B%f_yj zL>_$BcvM%&hbqEGi&MQVMkbaaJmM@8n_MB_0T8kYK}?mj_0!=v(~4@#QW(N5+lyoR${4 z{Ib^8%qfP!rdepX|5MNFa9`g-+dRim@dH22(t}Mp3)5~{Y3Vh82paxDni9#ACc+xtjBi0fa$n0tgezxfL>3U5 z6qDL(4qw>NKFl0W)NN;WuPdAj$N%`oY^sVuyqI{C2cF~j7=%&9aLu1X*s*VQOpKGS z657SihJUmI`^pL>>?njkgn2nC;BLU*xD5d=7JRXgp|G)qBQs3K^Io4-LgI=LVUx<^;xM_h9=l zlAkj-DY?}%AED3pI<$MwFpB)o7iS(jGR}ob_X-z)!>$=V|UA&hY{B>g)d_Tm;x%m_>*gN_?^9z&F%R_E$ zN8-FZ+Sd)$<&Y32Rhl`;fUlm|`WZ4YKl005tZ&>BK9PkPgUro$59W}){mFANl=-2B z-PdPC)-vjRr_9N%$V~q?*EK_jjvF$2%KXaw?oG^g2Z?k@yYWw2nh$$>(C2k2Q%Hnv z-Q;}HVECnbj4I!p_90j1LQAGJc^;X{iGeSg80w@ho#`H%Z=r0Pr znkmLm=l3~Zn%i|I)BX`tHnL~@Z3<6;`Mj_fv)zH*eB)k#<*~f67E1~6FQ9S!{xAzFib*jD1 z+wDjX&z)mUn@6i`AC9}0U4KgSHE-K!kzafdXs>R$qhLArkCqIVS)6l4 z`kkLe>GBY>fjwQTCF5uJf8= zqsExAJ0>UXAB?0tkkwpy(S99Ika^DBph(+xZ#S@Wr9bJ2%nP;Tol$Np`@u%*<*W}0 z@mniab41i`EPOa?AZb&QzFSz&I#{SQw5r;qUqttszRu$drVYrWNmsKkCl8fb%kj!w z^c?h!do20wDLd~))2O~z?r&b&5R0Q%6$eLNxH9SWft6UpM zaotzu3IZT6afi-Ww4b4F(3JAeb@v0#n$eX#bafwhsqnpu z79QTXH#9jqbjtrCKlV==oH^Mh6MWw6g@;G3uLf?1vC7WjjRkv%A*cmMaF9pPsp*<7 z^_ppYz|_jb4<2fq2c&t(CK?d~5hvRW>eqgRP}Covv!Ik1R)r#C(J0~rfaCHunXKbQ zJG)g5?KUkvb*70R*xbD53G2|6$C_tUp5IRYXSl^-7ydi#n0wVf#4XQi9Mm~YFNmWq zM10yqRDYdFy`hNt`&nmCp4Uo1wv7_&KXq*9@J^d-sRVF&sb&Bc!J{dE^i>3Xxg1^| zxGqU;yrGuRK#4s@M;B~L-eQh+sl>mER>Hjc(7++_B{Gm&m-qP}CD5 zyFd?E5IR-frINvdbLzEhw+i>}QB<)c6JRpEB8+RAd+ttuGJ(%?zd<2|7VEYn^<^xq`AU$7@V_xMtL%0R^yd^-Ks zE_tcpQ!!s>t!pRSGJ?;)!94t|_tK*=bZY&3|4V2JB};C!n%kWI-W}TInaxIU$>*|;J z>!6_!oh@Qvhk(IVI^BO ziHcy&hyf)Q*?^s#rnjg3!P`YTwgDa2=2~90#Gz+wN=|yL^QaU!C+^z#BN76(&j`)n zf}(lhVsCFbg04K4d^VYw2}$UWeD-alGT4RBH!N%10#$T-DsqEy=gwiJJLml=7JaoL zlN%rtclYlu-cp4c->8$lj{fF`c)hjLcP-c!a(-nHhvTNQ=qZ);0~ZfGJlW=QYf2?P zQi?sSQqgCBc2oh%)6((110NjQ*8&cDpQUX*PIXB2}cQZvBiTY=^RR+-#b2_2tYx)ptu5In_KCfM$49l7_b;S{ zeB0!|t~Y``#d%{*IrQac<`YnxQyju@Wj-F7)f*~V3N`qZ4t88;56wOmaN>zP`w`EcZ2rrZGS znsx!P#@%q$<2|c8&e^@PeDvz{#&T6o!Ru$ZbV+qWd$uqxxM@6cso53}k(l|`={0jM zH0_LCRs6jyZ1CDwpW{j79QWo;X5j`auMh1{xE31Ok&1>jCXO`q8=8bK2#OoEsg4g5 zIKLOa>pjB3C3xNMZO{ISl=x*g_LN49vtPU#6|8l9=oKk#<=Up5zeau$%)S>JUJBjm zUfG!OK79MvxaJET<^?!(-k??vCES#gW?*S{d1b^GWY%(6YtuYHI%qzsbP}y zEAf`WK@Ev>Y3HYw%^+8gx#;=aN?Or5l9>~lyu#c7>#9dfSITGECv913lH^=s*lcq49w#ig@MyAcooG+E_jb<^ zA*-$UU0M9D}7us50f27ZpN{>dSBd~HO`}XUU=I+L@elQo^XDEb-30Rhk~eE z{LY_zB*F&`lf2Xnp6>;u4lG@h_x@F)s)m?x^<(OqFtX@fX%}idWV_Bij&lR`FKj+SprongI zl$!+zmyXqLD<4MA`bYeSpT|rJ1>N&qbGC0)bnVk`gQ9l}vko*m3f4&lX$apDd%r-t>lbI$Dv11kvq zu-7b;Wh!Bw$WfBD{A8Q-maHC4KSGO8DI+XGQh_heJUA!GOgVvArx=TGL~{}!af(&t z)4(<6=Op&kvyDn?TK29>J=J@p6HKvpHJe?Y4UglU>t1TBQ*_+Rj#37g47ZCcOv~H4 zo&m6&-RApcg}XKP3OlwNoqPE$9_xiv#hGgl$viKQ$O#+nWT_TiY_%Q9Zw*S~(byxc!w;%FM-d$oW z`yW>;s$I`te9?L${LPp}Qp7@mqL;`{{s39^#~%-E`rxJavVKB+BiA8r-ESF*%iiUJ zowzN1#v1~HuJ$^skMa(m#9k)dVdJ{%VxFJZ>9rr5vd&p_eomTD~spVICQu;scNUd^jpCk~8Dq#2L$GFg{B zx=w5VrSdxqqj`An!seOBv-!mChQt{Df$K_X1LW3;ux~JvL-{n?LhvgLnhCTXeoHo1 zyW#b9!|pNxBbqh-nx`I|>)ytOU1q&`mCJ?I`}ZnENzSzn@0?62ZC=OL=<4`sU>)6? z?P+}$^MIqTlp&h+bnCg(A};A|;->XZ9Lu#_vq5BCH*u(G z^&yc{INoXVb%KJ2%+}Mr;r?)_bKF6DlMtxV;(j8`n3DzlG!?BGq#o!&Nlma3h`^;PH90>LYqcQ9}r zI!dIi8?$uXwW{u}f^L<(=E2Y#ujX&donf-Blo21~+MxfgbU4>&z)fMiO3iFW9Sca(#p~&S7-xE*nkF8PM=YRP0hMnG{k=MG;9bLWuj#5-{p>V(Fc1Tb*Jm{eO zBJ1?cyT#3Vb6azrN%V#N$(tR`{P|-J&CUGelIU_jh1YPO*M&5%6^*hQ z`XwjRzb!r&YFf@vn0WHQmPRWkxhJi;i)q1Ug4`g0+vX>pvL)f~n8m2j!&erHc zIMQzskxV;pZN8yNDacJWZJpq)v%Su@j;jXIYrF~0JkO)1Vxi9QNxJ0uR-5F8U9B$L zltmjN-7XpLHn_@tu~2)I_q}FYMqOdZBH4PI_>dHfzK})t?AP$X=cI*{Kvnv;qLOJ3 zJ9a1dqdY&{=rcOF`C#;s!2Si_x_Os+hoNc_o zlXdd>LpgUX*iUK@Mg)~^Or%$UE7YcxO0j_OjzRmIK-qCjHrFiorNMLb2!S8BGrM;; z)$Bz3<<0WNjxTM;8Zz=h(`;`~Jw?X2hT?7wKn}!zM;o4NGjZ`A$5k0^l2zoIB4rz# z9fN#VhGlqsqZ}^IoQQNEd3k|H<=`RBsyHt8cKOSZO9vU%drMXfy{Z`|_I^o8x&RM~ z5wN<$GcS<_cu#Bki@k5s4E#@I$exkJ(lVMo946u9w1>eU&U2A=PJPHFm-PJIF2&Hc zo6D3uKj`zNGHHVi#Y_qC<>(+2_vwa|fRoQb0Irm--RK}oMtTrp8Ob-Rx<7%R6Bj+uoTz|KJJb4=ejmzoisb|BL)uo`ads|X&&w#u?gnM7jP9nj7AkgKB`0n-%!lK4$CFSxoYJw40CY{DU zXom8OI&(xJsYny)NGRjLMbX#M2h6GN|q z4HTe$xxhoqrCumJip_DeLrADKL3KUSVNGXk99O$}Wh%j{)Z9DfeILx4L0;QOy30Dz zsI>0D#kgyfp%Agu>t-Dk(7b!=`7-X(#faL)KRwx>=U$su{+gK)WgPTMeq~SBWBS$g z_SWnCPw$r8P2Y3COSUazyjfD?+Y8dQuImqI{DwqRDWi39=3Ao5mG1=~3see?C6<3v z6op#y_vg(Ov|Dd&*5y{yq`eHH)Il`4{y@YpCBu4i>}PaGB(r2@iM zZirCiP*W+?zF*<;UDPjSWfQL~;Rx~rRvwW{?niG8Hs5)zW+yC725(xL6O_5tP;slT z2`GPQ$cq0aTj-nEaMcp3h?yQnH8iJbMR#rWwg0ghHp5=JPIY^swiHv(SJr{%w#20K zB-r1!ty)HbzHqgv#Tr%er*R^d3HFDsfU-85KbHtapv#ecPa5Czs#K9dA6yVhIjkgw zVc~(mDr0r7wE)Nbpav+3RYf)&FyHWkuAUd5S9UqBnjEMs#JY=v9-@Y9gM$gE>lu4$ z*CwdKtpe=zCNhQb!L9gV#tYH~g7n{+IDDm;rXWpjL6-Q&%dOUkEg=`MWQlKS$<|)7 zp@G&(CMUXHy+rETS}Tav)v017z+b#eZMnY@*V-K~cy-Kg`7c&EXrR3r={}WtlXjGCflMo-5S`6b(@}v`cX;`@DZ^ zEk#VELxQ5j^$Fz1TJ!)#q%?^upRm$2KONl$CxMSfGqwhEOQl3+Zp}Kh)%Pv9{eqLh z)kC_jo=Zxa{6!M1P_QsD`h1?W<2+9^XklkcSDgeuIQmxQ^D1X%YmwlEAqWmp)#T+i zkq{paZY6xJ!791Qj>xhHvE0zu6edkz5S{DOTQapiGWAAiK_^q7cM4Yp=b*qa}f0F5BDVE}UreWU=X04$*<0Vq1A=dewAx&P(J za(P$?EGY|K95?!~A$9gd2zQ)yz%yFg*A<*#CfLPdlq^0%Rt~deWO(v&Us1=V1aby1 z0>yJuPll#4az?0{z~r{5E|K8ZB`;g^%8Kcc=p=`yK;S*dFEGzeIdyjanwWZFKjB8I zKRt^hE5wNB&_$KiP4~oR1&YGAC&-x>JpjET_HqH>qfp61%)A`^sgo~eutGhc=1vubhVAYx!yEbNj${e{9U z53oEd)mHW$2zyK#Ec7q`i30AN^_tS$m6b+sv+TAxH+Isks|V#AZR zH8{DU$Ho&Y3t*NQxAOdH0`=b3Q@nSM9YqNoNtvk$L10pXB^UW)CT|V-u^5Xk3KpUZ z6r?}Dy9jm3u24V7^T{;F*S|X4lmZ~ie9p)MKswdz(fhLv?|HLM0@C=Q zFDD^r<7hcZMxG6^U4r0uwdO{eIkT8h z<&8vZuXI+kz@W7K>lylBJr2u^JaEulrl`qP@jV66x|h4P!_(wsYdDa4I^B1z?}OjjtTymFRW&* zwn0?KtH4&tvu7S?OR=yF@Z!iX5cg426DmkwY6a(=L^ z6}Wck(sn(9O1PJ?aH!y=LxCI@c&zaWQs>BcZ^*8Xarum@$L|?iZEygE_6G_eSOjor z09lW)F;aEDz%w%GAmoPZSQm!~5;~l`= z{ph} zx+z8`iY-T)G(h>!*xN^));BG$zmps)_Ff(tgaC^$S92#YLdns|`ROglrF2K@jHcCt zwM!MO(v9D8qz{^cRdKOU_TM|sfSd{S8HK`=DKx4FDDBBL<6GGtc~QzzEWnqsFdY!E z+ij4i0d<_}9#qDLe0V}cG-5%YyVQ~cGL;{!*if%sb zq@24VLI5KveQ3O9juLr->AwxFLMi3(62yvKJrSaipsE5sb!JCI9=e`+i50K0@m?|NpGTDG|QktvRe}LlqT|uSdT%?#{j&t zeKTzagZ9d}+aa!uq?paN8tbCI5Oo{~o~wgBw~V#)#$LM*N(bH5L9~8zE*&+1R?vK1 zzAQ#J>&7pE6~b}(>6E1%58fu9$_3-wElG@*tYaV&zbp#EyA(L8-as;y`2P8hRj zDo#e9vH$c>%n+3AmuA5+D2-mOWuAtvE8oFG7y)Z1bx<^?8ek)8Z&C+NDInJCz$9IeEebb$vXTE1TYHy5ff$JLvBSH7u~-rhvi6u9p)?T>$( zQOD{_0StE-UuOd#q2#96fh;M30a@f*jH~~;-}%Io&xDTjrLJ6^FNk8h|9n|b8ES`- zovBUy6Rnq%(VBg^mJq+`6uFtQ5RGul0~ExH6jT#uc#P7c6NUX$)5`(UfRI3nMk+fw z7=C6!9+h3FjfO~Qjdg)K5u4ZJXyNr4x?hn=14SX^2MddD;#R6e-6eQ?klU4*WHFYB z_>&irUpXc=NJAj>0&sNv4}cy;5N9zqC=q=$Qi=s)Jhtgl_ssFB0zn~i5{|(!UxS#B z8COZ-(IO9JsX)XyBk#*wxbi$=%>)HlP@SD8?OT9|inZr2hP8)ENUWy`X`sEgZ7Iu5 zA@F*|9m5l~E@BH%Zi>)DuO3HV>B#xg~22_AxaqGH#~K7o{U*G!0xJWVwy zA-r+M5d?yoVq(>Z5*3-iUqDzd)aEFXxp8@h0>tsLNt4a{3X{I`(x}xq<764j*O}K7 zK-@Y*0RU(dkp+3rZpXa!O%+xXgkbq(lVGJAFBWV&`R4>(D8h8)+AG zbf9Vj<$FxkjRKlhZa@SZ(CHZWM5bZR@Qp`w&x5xct`hENZ-kkV^n`tL#`Aq7;eoRDON(t}s`D{p_j{?qkkqtlujrj>#r&I*k+@rEbf)x^gOJ{RKdtqb`x zFRf)zZ_bb$H2x;7a$r)n>qz6)XmcLHTK>Eh;Rn)4W0sO47YzeqFFej<97EK~HvQuG z*!_aap=3T?qsFTc?p^p@vtOLzv*tdWL!_|LLytY*8`)RWc#7{@pt=RWurGAD<}y)Y z{jjjmx7oBuGOQPjxvoK=Nf{|SQPaA*82*9bol-(hWGyr5(9<1<;;VHUeNqkSXQ78D z^<+Z9U}CyH+MKoX5RKj^$2861j8gkw4X|mIPEJ__Pw}YUCOx2i2;H~xK`*KDo$NUOpPB(g49V~qwdHnB|jRF5bhA{zdfmmDy_s0@=3 ziP;*BiUjDJq1(P3Sxu%N!3}ZtQ%XbZ!e6M!+=dgfK3bf(kk+XM)XB^|e}&NsZC+Y; zF6cuZ>2?LEU)BSSwYpRX;nugOCU7rjIBVBs)Iy zTQaRXZVh*AoM18Wl70ou)2=+|m!y!IIijj{1c6^_&rMNNVf7t{?#a=ZYgo^JpN=J&Y56)Gc=vO+6A5!K{|0iCOebRaEBFU&OgVi$cn z!mD-kF3T(+C0MCHc;F&4r#*W#8mSbBcg*RQS9Fj2NuqmXwGE(C+B^K47_HP*1zooE z9!c9DLi`bvW|6IR*TUtrm+*_$V=E9D*ok@Oabl^|1mq)}dMGiXg@qP}O)hJNwf z#b&AZSOXyz(uNkK4Zl>wl^XdJW5b`nKx;VwQL%g$Rzk$@*7Nofnw}ZJjfQYH&l_t` zT^k}#mJ%@Xz>4@fTuel_=Oj4w#!$G9LxTUi5{6N6hpJ%!0BaR^#W&uLAFLUzCzZog z$4y*}JJJ*%AOajXYy=SKvZi>S>JW-)cLL;A7mI~~VV}mYY^nR`_)R(u+P}Xuzqx2i z8mTTje+`;b$E2^IhY@M|cS_MjzrZ1?q}9zZo0*8%OpW!HdJTHB^O)i)5o6I+gb8Q= zM7o>}N)8RJ5}x2z&N1BKHKqQlUT}GvPeM1H=<8SyFFD*tI|i9j9CmS9kOP`S`NQ7) zk3JhKf661R`pOeM1Fsl>t|z|nLSpetU3pdPRmCL|RvTqNlpk}X=r|B#^GM4a??L*b z2&R3BK4rIS40j0jsFOfuAoepD(5Dv(i<}1K!IkZ`>tE)0A;!_V-w+zO?crIYgL*4L z<%d7sK$51%xq*26{DD+pQmGc45xX!v-~jUn(3O;++aeq_G{Ief{?k~WZecd-%HrY? zP2nma(O{z)LI8pzLyRg8h6wjz4|@>YxWG|XS}VLS8q5QpLLMU<83H=M1Ba&jwf%SI zPpnzfM^Jh-S=(OcPx5^VuTJq*g`5Vi63(e36NPtBnmL+gPmmyUthC-z8NE?ss`3jt_swM>?O-tN|Ne?BxG~ufmO@E*T+hKPHpOtcTGVsBz~r0eP_S&OjNV$C z-0(?gm&&rdRhuDn6|hFRdngb1!$umLYOm?N`CwMDm^VluF@rPLZBk>fP$%7Nomk!4 zy5iQ>TJ!AzwLCTSs4Lg{#LusqZ+OEze|+zc4nHNtk)i;hn!hrXzpVm3UGnQ%ZpEy~ zOhM~X-i>TH4U%s9@@|YrGb|{O|8D?=g8Lc0#9J=1;G^h=UnMSOqc=Hbmv)!=$Kk`| zQo<+3)@QQPgU;o%>z=gdiuhV})H|3D0gS_TN`U1t{9RbYC;=-7F^4Dx(pacv@>BCK$EG1*)^a5t#Il_19+7sH~s&tvX3$Yg7nsMTRs~9 z-$yj7bnH;-SUY!=x6=$S1mE@WqHJ!VUPsf%V;xEsThP&emkU8uQS=qbd-cRk!t^Z4 zs^MowF~6GFpa)s+q6O2V0-P#JwGOk|zj~em*nwWy)>bYH6UdoxvC1xvs9TDI4BzmD za17@K;_l%LFO<%Z&^9B)ZGq1B2uie5u~^}4()@~917uya9U^K8(_c)YwhnN1oa8Pc z2p-de-x+f0Z*F}HNe-p;&6RIa4(bWm&`DR%rCX)L3^DsfMrPOU@ERTzv(Lj#E5vLp zfQbFtjxfZAQ^SUi@2K8Vgu`CUrQh(-7`45yeGp-KK;@Nj`orK`wJGXtA4lP{Mrm7c zL)6vQF=o5Bpq|WyA9^xDWg0znjX()O!k+Yz;*!9i;dE`oiAx^YtfPXKc*?(GYoem) z1;ohQsk3-xbPwt8Cbe+q8|=T#>WFc=vJf;hUR0@BuPV(o)u;#BWe9XuN3jBJu6I% z(#{b4#5x2;R7UIbZgh-6_Y?r%PfeORaAI`14JkR4&zukPmN?2=^*ATy@E%o;2uHb; zn=SV!D1i&tTT3Vqi7J=BV{nw>yb#^53j}56P&FsU0!Qxq=_R>d^`j+$C{^gl#XaxS zbG?~d@JR(XgA8v#!Z~Yv25Lx_&T1y=%`P__t}ES{0y~5sfDi9kA>HoL6VMuIU@mS+ za#ud&oTAEtzA|F@;I8^e$IGIxiPk>QEeU`?eQe-J4dG>A1d2z&d#){}S|bOfY}0;ivNKUdnZ0&~?T$3N$h1WxfiD#R&?@-PR_ z!hwlE>@X6THNdxxl7OY%C*>fImv>Q4>jxK;ABMpV(_AVh$aEvrWJlJ+x4?m zZWxN7UC0k{_kmcNNbw>GJVN!%@j+~(Z+~k(L`Ngs43KFFTyJBF0}KLMEIaq$q#UJw zgyJ2!*t9$a;bRf1UB>nJ!+i^m*0k{C0`m(PUX)q^Le$*Ku3qhn?jB%A7mev2=k6JK zxIfj(McDoJHbv+I8Okukvdp!0nDhN6*i=EMiHn7(`Hs_p_Zda#4avK};lK1hBH>}q zW@_n#NFwNRqoi1DmN+g%*eLBi`5$YHtE~$>O;ymwXa72Ycn^3p1%2ZO%>>+VQpnl2 zi%vh0R7WVc?APIU@)yE{F)1*EW1i(6GP7td~qBlDdQM z0uMtOx_`*2iIZ9dy*T2G0O7!%zh~;8+yS&KWEkhABl79rN&7M%s3rA z_>usk5#EjTN9}B?0d<~51ngA30XP~ws;Fi~k17Z*_LJ!(3R7I8jt>dx{KMxo%rF1D zqr*1z6r(!I+VmZT?i~P>Vq3lY>H5j-{vsCMy3onzZ?O3wNTu1~V)jxVd;bHd z$dMIM28Aa-m-0%W32oAK&wZdGcRW6ve?A57Vb@Ch#}xxj0V#Av{C{+EC#MxZtW}~( z;7cULFvE}lKiud3Fns)78{S6+@&~+y*Ct9|&G1DdL`a7$a$^Y zfoDS~&B$f6+x$i?C-gA&MPPdUcgG?Tsg9mmLDiDrA0)-{dE3?jiL?=Ugf9nVHRf|qAh6r1NN_QR`)FGoQM#QrmgRb_5 z*oE8Je9w}7N87Np&WRf~gDHTH{wl591P{5GIP4JNx(7eRY3uJhsScD89{iTk*KzZ~ z9N-yf;_ysJQ#R&1Fb3h;D%ot7#pDFyMeWB|5ma}<6zd~y^tNlM_j%?Gg~1>h-$0y& zI}ptDY@zx<5arPKk)Ru!l#W_|x~)aIXam4|a*2H=0p;2G8_ znG!q#JQ=a{QtO%bk#>2!IFxW_li(?zqdlTA;X(Q<EbWvp|Po#XlVySwP&TOE>$w zh&eJo41NoY$GX%a&R`8dj^r@7Iio z(ZO!8?!Rx`uoRRxZhO-pz?2}Aq)q&S_fBh{-=Ok^zwID!BAmeEyW4WRp%$PMhG=eXO(MvkGWdCa`t8J*izI&Cwg2K0VVo;*1cQRgqsWDBn&?6fHq}h*9mR43#6d#DBEKa+LU*-D z{pgk%*J${@6=IJvhTM`pp4PQE^Sc8l5Bxjj0#<3j0_a&vW;1)OIS7}lA*txm^$YYo z2iS}%w=Z)Z2M@tk`M}Yu6){st>>q}kbuV)wDg~#4@4Q$VJcZR_1l_)@ydoHg?-ncq zmhKj=2wK7G4fJY>`2UEEY7oHj(d~ z2r(kEXB0q$)Zs!CKPpC`tK6Sjxkzx{|DWKc8vd#TzB{5E7~D{Z^2`!)AxgDz-4DJ! zN=CZH%_`1?KA6wP(8DHjJf>sE6nFQ*a zUzBtx4xBkh_6qSWBXC+nk$WlwlAksFZUF~;8~6`O@{Rl73*JO@DSIRvx+j%<2#lX;1Nz@qw(6Y%vG}c{Qj z(=5-FCH^W^%mE2}%^pn&e9edcvFmUD2=ztbKJLROf&DmooKH53S2}BAb7d254kg8K zi?vJ8*ZvpN6+7EmFUfqE2>n|Vh3gFg`dU>GkJzZIw)gQ2?MFRioQF{(&G~EAoIOM) z6nc52&yab0Vh&QeUAZRc)(*teOS0ld=Uc`f?XIrz$KgBcf9m^OraAISxL#SC?s(Dh z*V}V8Hb*TVTPZL+{wdD-_+8>4@GoT5*@x& zPX1W4PwCHP^_~8HPdO&`2-0U>`3UZabkx-?@V#vXIuUl;eg>f&f`q{yy*gPw4+rMqUd9hyqOj(mGP~0Vhb*`FqaA zX~eR`rq?{q`yW9EBdK34Ob-Xt8jEK6rm_(Ww-(ZSq$m4-iV=dfi=psTS)K{n$w;^h z7)3}ZW5I?8d^}0cOKh;x1Myj+KWv8{7keu^(ZVpWMSjD+bn0MoDkqtj0L z%_P|s+0*>j_-MeA!a7*dO%VQW;cX09Nh$o2>|oAX%K@N-i1eg^{v;hh#~Ogpg;J~8 zU!GtDv;2B|)LZE=dF9wCy~Qa$UqhxP4SmNpm>z~p2pKsrGblX0?T{!F=vK7hUEB)_ zwh+tbsLl@b8R+qqZmAeX=;zBo_Xwqk3M#*`9&ROKJoHv+c-8VOEiIsq%!`*cCU?m* zU1C{?p<*wKstLNo$qDKz6xu&`3SlaMHe6{xJgM0uSo@==;~X!j@%Aac>%Yn`?TvKpZT(^+J~9?H0T;kDNkES+JHE{_@3xGYYJ7HMO&nqOm=d5CyAs zNcPdsLC>Jmrunf%e`bvfD+HB;C>{*N&p8i@(H!~N+pBbr=GzwpnX*SGpDvsp)=&Yz z)XPaI4aCl{3(f|<%PNrWfOZOy(4Zik|Cm-EQCz{SL4IiTcNLes-i2kMU()%$^2`c* z$pvO9OeFhX5b2R&LEG*0cjRB-4Sl8y{9OeSve!$JtYyWCC77S?3xEw>pXx+n4adR_ zLb+HNMydc}|8}H@lJQq?G-ScR1apFj)M$mHDGYW@rX!{7N7TsTKFZ2~Gw_!?=JAt* zXyJh)urR>;T0oR;*=%8d%2n7LIcvbdj*<20coIO7H8pQV=o?vBs4y9jm!Qe~(^(nu zS|gEqGX)}r$sEWkwZr0&Knbm3eU1seg0J~qu`P(`Ng2`ZKdPp0VS7yPy@eRy;iWUD zc-HT+$cfu!y7g6c)>?d&$UO!e%2+@^(>&<&?4MG&@O_0!AOZe)xvbNLgVVRja9$`R zT&@6|XDm2i`@_nJP5>}&AMEN$4s+vD6ep6xSxS77@I!o3^j-&dYqwboKH%+0B(s)&$R=g zTJKxf1)l3ChlcSa@Ji_t4t5)J0_TJQ-WRB03T%*K2|0w~pP~vJvp3U{66@g&7G##s z!&Alm`V|qQcp-r12uf59ysrF45PLvgA2AV76ncVCToEWXMYFHw_bw>SAWt>RwMjvARBIP-~9Ned6! zani$6Dax#2)V||1Oz={~j-_-5A%S8dgB{waKl6sFsb-L(B~a2BdiDoO(Nd^+(l>F* zGQofQru2dk>8#&BhP|^)0zVx?$AQzNYN_6SEf%@a=32l{gG+LvO*IhT)m4h5SoG`) zAAEJAe2LQ<0D%Z`WRJSQ!$A|;S&0hG<7BAyMfpE!%F=LQY$q`CA4{q*CL5_NQ$&Y` zb=F=xrkP7I!!K!Vq`diQIHJesOZYd%Lu00>h?P=qsu`A=SgcRFzyq1$HEQGn6LeId zeO7%Q$L9DGG;utEk>Gy>{Rj?PXqxq+=uL426$(l6K(Mezjl(-{G78U@ zgJ9#6Dpm>pw0$iB;m{)dMbBCqwYLBJurXk}_79pz^Brvs^d5ys=aCG6c)N5pP~M|~ zmzZOEz}=y8ma}=?LdUQD#-Tf@HO-i8O<~=!!WfXK|EuHwk zE#a4!6nzJT2ijiX$>@|=I_(93j}+4_@JEVr;Uq~F$bpC@+^-$b#8E4Z;>3Wlzv@2P zF6)ep#N@O}oA2*48-#K4ofD33i_MF&qh~Mh5E-!q#WhM$t+S_TIcxSB_Oj#x4-)VQnh4WL@>cL_4dVuW zF&T&uw@A{fh{y&TNuK$8`j6)-|F~b-joqvykm^ELb{mA9Efnz$l%_jtde+oxpZ4|? zc!Y;t(MogodrcygIbnkhiYp}$SAf+wuW(BC@r1GeS$Pl0x>7(*j~ibe{&sXG5~Ai@6( z1pE4`&yBF^&=ke7!iO2!8v^sW7%skxix$M?(K2(9BUZ>w8V zA&${xxW5R+9(ds>ZG7H6=!`(h9Xup63hnj2!`L&ALSjO;1G30q%EY3(8>WBw<^6u) zhz~^vJ5fMHztD`qThbGyzN{!nBG@?!fZvn8pwvi-7L$Ygj`j~FAr7(Y{Yglt{s1DG zB7Cc$jR%H{h_eg|x1ivk+(TzIXGkIV8JIj}u^}oFvPNH^z<5JUgwf{18z7CcpgfQ^ zB-YwjHB(ff21vt>ZiU2;Ibr(!VHEjj&hxgM3~6$p&=J|04!NXIo}=m20R97ScSI<(-97PP zZvQ(y{UD)vIW*@u%psgQUMK1uYyYB}g;vt0A^SPxpKEwfuu_pM#9JPH*6l7VJsD|g zMZOxfN}7?xL_gBJXIA^C{zm(U4fLVBX`f144{j^1<=~I7&=+SaNdGN;&R4}t+DXGz z;AEY_;t+Xs|9!P*Y4B{AZ+@spBPIo$QGp2ja=1z znK6#mS?W=wRqjG|)^#Hlr+{In3&a&V_qX7%RG~h#aSDz(w+MCee%zxe#T?p_P)HKCvyLm)gHat@2_v3sBEYbq{NULo4)X3}86$8WiYC)Ol4t<`s0Gqz&VqOJ}&ez-T`@mW! zMHovy7|q!fzsNm5`7;Yk!G5AI#w+-?8CN#P_Ob@itICU`yf1ys(AkZKN^7!gW380( zW3_}8+^mdNS%7FAyJOuy8^9hr!fSW#ya`)8A>a&s=KA7|qRB=H@mDJ99$mcm17_ws zyNaoEShKI+lXj#q$M@l--jgXs1X zch)2^J`}!K)0ef`nw^Gk_VAaDuSw0rg^UuI;v`MGjNrwX$okV zVE7TR`NXS&jYA)PetwYM=o}s;D{HY_O1Y$6?D@tK7_7Z-Y{fp7+(0*OzM-3b^s))<=Ji)d15smQr*NwJy?CsqWCtS zYg0Krv5WwRR=fEIMK2LXv8*QqN=|bW!0+CzH^@WjK@greQWlkVt~yH zUHUGx=F`0`6=P{eZx5QcDR8)#jPc7H5OH(hd#Salz@-1&3By1~*y-JN;@CG+qqi5c zw`6*ho{27MW_ztbyb^VNoibQCYb944X?3vf(%Z$KaWtgW{a(lP2`i)5dlpSxT0M+b zg&~XPJI~3f|2}K__M(OnPh=pNv{NU#M21s;#vpnIi(nJDNALOf*DpJ}`(LifsqIvr z?bV5iX%=lz`8=|sfw-c2e5T@;w1r*CF7xL*YhZ;W8(I-DJA>o;s|y1&*dvaL-FDvM zu>GZ-&2jz3BH_^>@Pp8$F;^IKe%^^TpN3DbpLijWe$MO7*HzM+w>%n;lI{JrKIdbv#h-amCh12Sb2|v* zNt3SCb61qcVmV50(r)XiwH8~@S4eTuY-eWZxJ-ZDOZuV4;F<;bNBmoEn{mvK=1$&S z;BC$~E^V0%@e}h@UHs0=Pk+-(`q3(*GYdbn?0&d!CCjGyrLFzaDP%k`x1xr1+kgw9V&bX1@o2h_bz7Q5I?YJ5uV;9FR$pD(p9J*>X^SN4&uBFb?`qh8+JQMPHYPOK}%A@3(bAlZ|Ee z%drW&h(*7cR^A(Cv~F7l7=dN~N6%cB>hjI&m4}SxkQJP!Y9!ZK>k(m_#np>+CA-f~ zTnipIca1+%#JoobEa}rpIjG5I1FLGi9Zz3e8M(c{(Py1?pxo_c9Ly5c`6H`dWTd;= zNwzf7w&L>M9YK*`#$}hV@qSJ`qhsDsvwTX$`tGGj_{?iUcfsuWR=zEfwl@J%mz?<8 zH@bUI5LbzvDH`tLcP`WD`GC>87^+6-wAl`~Hk*28+|o{&x*{4HJQhB2XvL|bd0&?^ z4<4yy1wkSe1S43VSeYHa^ z+QT$nHEH{Oc-!^)J-Kl!IX>}Pr>>zuOiecqtA2>W|L}bKe z45X2-l5S)gZ(+QrBd5|AY}}pQrBcZHr}S_~W!;63Ke+{#ZUZ|$ipn$RFVtWQ zH+sgA;!rK*sAea8>Qv|<_$T#QHfI@Fe#}0MZ+RH=;*5+pku0a?m&srj;noq;lg+wr z|5ju5B7NP}H+G@ZyxYjf?|3>!=g50l%0~3*r0wVHm2(%bAKc*w%S2B66~WnT13JhP zI7mLA^G0*gRWRD-`kX5v^e`ToJ<>x}cGGG5LQ)ksxIaeHgi13)W zE&6-LW0TsBAModO{KxqP&pS$#D(#Gmni3h2P}vl=bN0~-68GWjCMpI4H}8FXQ~ORb z-gbM0B{xrfPUPAaeU` zM#mhV_MLQhaxYeX-cS6o`6=1cKKEpA`wb0Ifnkfb@j&qO@;y3spUwkzNHc$hrZ-#z zz~LK(DV<>MV&#B>gf9B%7xDsQ7H#&O$`bzNdqjQh!tYi-_i2$=^LuS<7JKFN-h_iv z_02a4<0Il%Bl3*Lt`%l(Y&p!69MRaYz_qQ%SMU3t>-0mbKEtN83Mzd~y}sqQCPfks z%GWo)v<&TUSF1}|l{pm8oWAa;=(M@P(ZG8aWqAhQjj!vf@v^(+3%GI}u5;PmKDKIV zL~k(Mw$Jm)6sL)Y=`bfD`{!x@Z=GDvnUAj|hY7Y6w_lSf8WF#J#C>j&-juv8_*FRQ zAU6z-d~14l&h~aoTIPCrfy>@br(^PX+J_c;O#dv-_5Yq1p84~8oLEfiC$j&1=lp$t zUgGAP1i7Cy20AX{28wkq`OjXFmjx)Xcc*fGh%5)IakMR$$P6aSl)ew!6{=?IlzQqi z?KUDrNaAr4>c})-7_MwlrGi0m233hl~Lbvg7Q0@>Dq<|vY$CBgiI;$jI zp9=Do-4cKp(#ABPZK!=d;+^Fk&JU!gr1QBigA-=I;AXd@Oh4H+(=`(}M{XUs0S0jwJZ%uL7 z!E@&}vDUO}weEPcY2^oAUu2$%mFPom*E%R0@{E08MjaAr09L$owK{)@N1!MM(@Ol_TbV)z$i$w zmQC$z&#D6&L#^vSj`|ca?%=b2SmRGdp zk_H;MH^K9C&N$UQbj>(-U`a_Bjj_Gwih@bltHOFk zykLrhg{WeA!P%JOD|f`LR4GW{knK;&cHeuOxpTmJ&X%H~WY7?b1t22n^LbIltUc+U z2j{*>%-PaN{%j7B^d5CStzq8GPhW$X<@*Pvc(*n^KXDzw#m*nF0EJr7G z6--v{;QLWHffNuLtV+ZP9hvuh0(-6xv?Q0V0KWr&(33IadUluPnHo%LE3bQZj%DSJ zsl`iRe_sWu+ZGG?&{yL%*ivGAs98kw^U^FuiWFPc<9;+ zb}RvjD4pY?GY-m?^I|@=lOh#}4qny2k@3HQadYo@vMJ_<05Au&Vabl-WnC9{wMv)T-q&bZ7GMeI71IJc1%iY== z&gjJXZpt9x%jxf8(;ejiRW;QVjnabA3dN1Pr5~=c?}3$6`jX~s?+KJSWVVaXHVcja zo2+X6*Nj)$hXE*49Edv5cS-88;)z3LU(33|!hiFX7DT*RTlKlW`O0>~%JCMHBj~d_ zN-jwF^6%0{ZWm|v`9O`3hF96NrT3T4OP%|VTk?J)%S!R&J$vQhm9sI>&WTZ_fVU5_ zLm(kkr3UGEKf=GbPZXSYYv0Go%8qOXl+Ob1J#N{@KKN)Qzyc?qgfHhsk7n_~r{kIo zcIOK<_V|P~`kC-}_m1t}hC(Tn*J<6$gx8lj((d;T9zU4%)APv(CBFzS9W1vExB!gc z?VO!pI|B5pCf*++=?B=|1YaG73OsWN+>~Wep1pMO(nkeSf6VhD1*Uir^K6DG1BG|V zS5{}${gH>=L&Ci|S`_F6*NMw!XsZUkHnlqJ=i+aoGr3Z{LxV{$@&1wI7{P`PHs>v8 zBfjja;C%43<*sqSflp^qrQ&p^<#ygi!Vvlkk&G)rNbSd$jWLdHZPB=H5`Axo>FD80 z696ew+f&RO4_WdBD(zlD%wOk?*LiPwhfS~Ic}7nha~qSHw&CYc6Vd68H~JL}!BcJUH@bQ6cA-*4MF$OVNz>~0;C zEhV6f@ezmp{7lA192lMKFlttX2(In+?_@2lW5(6Kw&5YRdQD0k#rx|byHg$H;my4e zg0TT1_}E;

iZqK*;A1MEs2H0DX!V6>5xMy}o>lE5uaEBM?F?8H|I7+%hdWWPA7& zMed{JAm{gGs}HNhc;3J%I_h+HRy7Qvzh`@Vh8A3deCjK68`WVg9aZ0kG zXp7D>p5H#9P!(a0_XC;+_d8?DhFq>((6$`*}%0! zytLHdY?T_5-5%4phFnwI_a>{kb}WF4moV_iYS&H1 zY_pa<^ckn5HnZWc^@_VgQ5@Kk$#6bmEwU^e{N)!W|1g}a_yY4ZsHeL8#bhUP`u;Wugb2k#42xBg9#2B&2^vacfZkGi~gqGZD*$g-e0jFP5vx=)e zbs=zZlUvJQyr|&svv8^N0Rxd{ zZRY1(+^2(635TL}JNK5V&p{mvu2GDN0Oqfu9{(I5ZSym=W2x>WA>xEQJ?dxA-Sojb z;d3MZnI59VM2ubpahwzo=CN=~pTwE%gi}*W93e1*4x8OAig4gqkJKR7GD~!|>j4Zh zOv)`9)2KGkqCixjjF5o32w_hjl_>RBS3AtEvZUCl$?e4QC4bZn!ut$C-i727BFWht zIv{!KT3AjY0-fmZ-!sLG8s~&^oL$V+@mk>Xq!p)jE{P!f0y$wq8KiNfj>D(&>T`eR z0x>{9<%qTX_aJ=jzfg*VgWz9M)0j+i9eoCs*d|$Gav6ablh>9z7XoLP_R3v_F3@Tq2`wg8jijgg>{?>jsAbiR=Z%lVg5BQUn3`+K&9#^o z3>ibHDAc52t6Lm%!3pkd+LYvaFNP!;f1BBnK@EjrYi+}u-rKYopx1^BhN^bT2vo;C zgUshChlQ+Ne(!PDUUn@>n%jw`6ij($`ewQ`YvpP{5?%$>H#JYQsOS)@1~&y->X+8h z;vE*IqEY!NT6)VC)sQQ95^Ng=hYAo0RI;D0>n}u)>lCz`g4Hdf@ zvI1*dW+6_#sBl0yum7cbC2iY5ck3Q5R@_AP6SGLV>+u&?OgRt?QLtx)44CU$MYfJ zH_d)zT_Kae{Lr9Byd8?ZsX5`yq5hC!2orZJJ#CIcFvN-ewjwk-AFQi;%ZE+wGw!(S z#yLL~fUQ*2TK;IVBpV7G^`h3*zH=rmpRQh?Cb~9*jooOwP_El-Oq3Z=_J(LgscC0F z?t#Moik6N&(AdNdyEHbb0(O<&<)*YnrRI9OohV zC!FV?IzA*EaX=RfX4R3ei>+%=hC(BP*mn(rQj1do;0}!nK4Hw8DEZU4b6N0wvI~mC z@=i(+dk1NY^1q{kMOvt_erW>Ti&6rV4DSUTa~@x;~I0wi)f+6h&leF49e>;D3&M<7Y^_sctMBN)FexFhj$Lb z;Eeh{cR`8~U=OZs!9r~UWlM+|*Eo0cDz*u9OHlu0^iB7+v%EkpoyR2w6Y}Fi)OU@z z`863IQQ$DX7S>5I`Ql9d9o){U6}buL$&9VVJ~JX|v(5O3z$3^bRB`964v#~Fd-TC( z=s$4yckaFK5?`zg{XG>tsNz8TMHv&gupl^rd5+6M_aXR+8!x zuNsY;T{U68MoCQ&^j) z>TKRh!d;OM$WmY5dF}l&vhe80xVPwrtt(l|Ep;oN!Jpo)s26BsAQRd&1Ute9iblfu|@y&wc*r($ao6=6?o@EkLU$v+m=NCHlf7 z$O)GMdy2$SN7Ya>3WY)wv;Ro5%Ji&JP9Mf)Dei+O!_3FF5m1-OJjnYyyAK<@+u z@%t#_-DZXsZT92+6({c{*&Y(UXwXChlp^le1>2dvua4(LA@gr+p_R4lM@0^bnDx-v zJ(4+LyL?9%B8erUq1;17Mj7H=)3-c$UEWP4%?MO}LCIv_4)rcI>-vP{;18iF)xhjf zmCHX3Z1YTb>(uPRo*EeamxP}Ch?Vd_hFln!{=V2E_U$HIOyy##6@S68L=}SK_tR!);9Xx6G)|ZD}?|f zsPD~6taxuM0W8-&u8&`P{|{SV9*|S|#h)#rWHKm5LTScQYJ`zgjFb?mUP)!iGB3%} zrsQfuW-O(UHK9^=KIggjjqmUG`;Xgw?|q);SG6H+D}TU2Bla zZu{--S%@6oCzhD9fLu4{LF4pJ`nq2_9z-~%KZ7YY}N=gStW{VOj&pc;64)zu}^Ohk4_K`IF!)!O6Z zcK`0PeAqs@^f!c|S=`>{T}?LmhGZ?|0S@ZbK3NigJ%8^CwA{B1aVP<}z;@t7u`d`! z63>y<>71XDfA=*Cj~sJdGl#il+%W$E{y7&`mod!h%V3+J4nKr_!?fV#UU-x0P;e-o zwrSX?HiflNhk!)J!0~2Iozn!k&xcN!i8l8@>(qC7lTq-&!Cly>`^pILfHYz%x(;EgraBhD@RDqZ=?UXwS$y6|Culk zBX?U!*QMc|x3!ymiJt6`%J(q1x9^<^C$7qGZ z+mi^2TVJ<*c0#@A;+<1Z3t+VBXeTgu>sa04?X&+rYuU(!z%Lj17*qair@iWWcL%frX5O z43ZjMefmcwt+LleB*Ph}I9=($DN&9Y~s+ocoD=p@H;a zM&YpGx2KxIVrfT6tG@}ZMQf$)l=zby`kN*E4U-%N#rf~-zDxy|StD#f5Ws{jYuA4= zl&Cal&<%5F=Og`CWDzVK$e8krArWSDL`6B5b?Gz|VtcY?3&SgAf!xBhnb>*k}_ zQ~sSj@2sT7z$E)D1klg8q>GZm^dn0((*PtpmHdLh8SwME4H!n8JLWfu)GE-#7+~MV z9y#gO@XGBu1v7o1C1>`|a^ASBeQGiY&_ z=9zU2!8|B#Zu6e0rcCS~A+p5&)n^xy1MU2tS>DaeI1h-_`^E9ABM-om_NbLsd2Q!e z7LI6L#!vkBU#`xCl-l!sQ{9>VG}B5OjTcrv7GY!xh5! z6EvgxA7wED>_K2-$ln)$OsXvnb(-FUXgfZl0weXwfrY?GBS!iB!x@(hBy~F~0P1$r z-v|-`4zMSQ((b*W$j^?G<8DADPdpP=!(SmUvBym1_c{Vm@D3O(!~Y8zL@v+xs6^*r z*b%cI?8riJ2J2*orq8UyFvh}D=GEK!_^qB?<@w{2t`cFV?)Va?$F`Ka4$mNOsqXNx zMwOTr_>`E4iyZK(F@&Yek!N^S?QGpIr-!*!=$`c@M0tb$FI>l_@nz7j#5#hxNe*Y$ zO676yf7R#7n)<{%ZJjb)QD^g{9S7C{$9^IJACB(H&KfgRbIjOF%mX(Ms`9JKCa-ltU_Dc4 z6i~>t{lfoQ*LB@TUL|acoQIZje4ft1cN(BKSmM89TbBRLE!7N#1~7e+_+IC_IWP*a z40`_KRhWJ2eP*7Oe48UfkEC78d3}aQpIuu0kYYL6O=n4($P2wB4Cwx5e&LIHIL?*l zBm6&ynu!SFhQ9d3m}HGA7m<|)XUd!&riJ@?B#ha*jG<1JZY6zH%{MsgSgM&klOq=8 zPHEP*(j?i0!-#e5jCuJ*x&qI@T{>+|{6e7PE<8<%ADWBCEfSE4A&kC7v~Xoud~nSZ z(TUSx+|@DBW>b!(MUwWJo)GBS#cUIOuGY;l2gqGg|1KZIh9LjOyqWTEm?}0Si)B4V z(^qC01X|V{jPK>HkRi&^$#Z%L#xS_%w9EuE#@B}ZYMY4T-C|4aV8k&%RA%T}$>&QB z>_3Gp0vM3P;+-1;bwU0>SwK9!ic^AX@`=zF43Wm(H}1new_S5*KMgf)7DwKE0tl`) zyAZ;Y>s-t8@W=}*9}r@60t`JfR|IA=tZFB>Aux(8H*?~6=Y(WqdPefRjpm~9y}Y{G zW5VA#UrK9oVK1|syS_PeKcZO*$$0h_pz*k6X~7f;>~v9PfiBBJ%aJ3mUu53=pi{;G z)xM@n+z;e9q_eH78baT)zK>ZV35g`a_Tl+tW!OTgfh-2~Fg+owu(r8;U&n{9yHl1= zYd_+Yn!GLj_(y{a>fA33H5hQy=-cEqo6nOj{fYwIo_})4`HGMuGjoQIgwCee5IvjIWD3Y?s0_05{A*Ls(H3O}FuKs< zqO;Z8CXLGBggC>1^j~FB7mH_9F=Ei%>@KDVDY=7WD1*S(1^En*7z*N( zbQA-(2&s0_R?VrsJi!SgV-9^q0fpqZx1JX)Q-Oqc`uo$PXaEe6ucf&Dt?4=9A|e14 zer_pem*PGDheE6YnSF2EpZJxKqEOSR5gEncON@q^W3gnY2R9^pM1;mmQ5D^)Gk)R@9@;Xa5X#)`Y1AjODMOg3c;IM-iudZb-9?k9NWAXKhELt8o z7HFPoPT$}IAk+ldldf1~BrnP0UKi2OPf)rJxQ`8wC)UX+=hyR@!myK+U6ilfrZuXL z=>P^IvEg5m@S&JbY!ETaQ1M<-zBLhSficul#7&z-so8xg?DQ0mOIb1%6P)=eN;`n@ zehdZrw@jUzrnWTR6E|Kc{A>nx`51$VExMdqP*XYxQQ*@}1NyeTgasO(Efn=_E!0gHz{?CT9Svd8qCZaz!9>g(G@S zh%Eiv_JP-8@z*q-PG9k$PKrQrIdi_7$`5@@q}*Aaqg;J;0yuU`c*r=$SO@Xh8Nh*v zA|XFU<+s*HNY+9;W>$R1Oa6k02ggP{62`68&y3rY8s_vq-hbif9I6;S(YmW z=){3DRml9k-`+Rdrg&^QNr07MMb*$1ECfBdRI>%y$|OZ&(%2OYoh|Uqt1?EKL|a$J zhBIkVFxzCTcg|^ZGGn6=Ok zMwrz}L|UF;Ya#Q;#XTozde^D!eS@%q?dN^SV^|i`#U(P+ri%Ekd{bJ~q2q&H-2aOA zobu}1HvI|pCMtVx!P7CF=A%#91r`Q*Pl~i0Gp;`zm*hY~B4I!og~JY~^>m<4L+!r}40ES?=$VbnddH2Den0F841`%MLN(N?F4Aef?d6o!Z z4g#n~I8CCvU*H|cAEFc=@(y5RK@waD)DDng^!SX8A=96QI`WwjoShsj6Mm&{5>V(D z>U;$QCF~f|lM&gkX+kQE2@E1g)inH&as_J+%S3Lxbo*@U)zXer35gbmf3XPpWc#b1 z+@qV$8Ya{1y-JK8PG--JkN)HJEI=ougOJ(gn4pI zpO+8VG|e)JTd2EMb}4gNF*z*+du}c=>lIKp!^mm)` zWV~nRXR{=np2dMa=|&Xij+Lh$K3X1Oljydnh5Uan<|(g-j+t{sop-OG9*}D3dFdL% zL-T>Ze6(SR6dO03j|Iwlm(~K`u3hfWl7$jrg0@`!@58oPR7df`^4k!AQJC>D9vvFH zA#pX)iMT788LF`xKG6XGJ}~uA-GX0zzlfHmEqe7XnPCB2z)ri7OWI@oHp$M_xQSzT zwZ5yd{%w0K@3fV!m<|cyMD9_u|NaQUG+tOOW6-zU9o$FA7;Dzg~(m**x91`6@x zAo*_=bqs4}wZ{Czaep@7y&Da!mn|EH(6=Miyo7(GsnTiEavB#jAm~T zLm!?*dd^kwPK6E-IiLDEJBxDttWVTN=W^`Ada=!~d3J&8$)Z@3e*v~n^<^qfMT`006 z$!*B>PEuuQ5JNeQk+%64_-n(e8k+kLM$yW3^Zgc&X^@{kaXN9bb+PBo|Gt*f^z<^j zfWi^kk!~8tksI;;e$Cg|f#GCPmP{L)k)<#Rfof6M`_I^#T}uKJ`*>+6Lv?Q)qP=YU z;jOaaz5qtaQ9S}U-wQ0Zy&KpsoFt1z+}sm+P&Dx+d1;re1`~fquWOtd z7{Kzs2Bg4;0AnQgg;z9#N=&w0$TmDZJgnce>W20$zrPiU=KeE#Q<2^<+n|=bwhLUg z;lcQZ=TeuBZ0C-T_1u@XWbRw$Bd^2POEa_6s$$ONgu^M%nb#OHgF*J#%EPplDXL_= znV)HPpk?KuOOBAYppfzM|2S>>)pxYKGAG$_x~^Gw(;4CJ}p zmo{l*$cU<&TqsBl_)BaffBy|rt#+^-GoPK$moDjo=nukCplzf%x#%b1-LTq3F;BXv zy;Ad%W&Bvs6>r+k(Qq8bP3^qvIPDtR$Ge?2js3c^k9)f8!uE;Q^CP&9Z`r;b;TSev zkSzT-c-YCAf$iH;h_Jq^Q#q|Md(8B0Yr^_^A&s`Y{o7ia?q-MBUSC+r&suCadYo(0 zYNS2+*eh;YJc8|ttFd-FzHQ*?(L1#duus0k9v+Y~V8O8Iizp1pkLo(fA*e-h8Hb2> zk7-Gl5c2<^sYbjB+~e{zAhbCi6E1}aQqcP7%T>-6{+ z!0OyE5AQzm584$cfQi2JNncIgM(c87LYZNrz4~~euIJnP1BDA5u2}tj;Fm!gT3d7E znBeiwU(@hWJRQJPb+qRVOBcPnVX@k9WgU-Qc3X6cLXq2W5KS!U(O+T#Q!7y3vvauu zd(1Y;%GF8Q*h+Jm#hZ4^aoX&T?$-wmH@1Y{{{_xi`9y0a?haHs)IGI+TbZ{s-L$XWmCC)l&uN%xcYJIpyTKKRu|IJD)b0qqbvSKR>F z(2<`)`F?u~DJd6w)^`_dQI@fn7iD$6szKcc%=&QS*?z6^CrpUQQt z{PyGcC6g+^>74qCqWzGm#Au>!E+{J}IO1pNs=rEg;(NI%C-gJ>hyoGPkCa))#=k)? z*NbrejfQ)=^eI|L%2orm4GQw?-PVLP-jKR=MkSwi?9%i!*jWY2N`AZw&7ig12&RIM zBba1a%lSHRZ{YgxY7ZA%bxxs~pBAMN%c(7snb zO0k}v%$^bOEUvV0sWA?*^|8p27OSL&^a>9UuVA^N1h{ zk7=n1N+Vfx_WgHcWteH&g5ZFEGKEQ-ZkYUi1n|_x3VX^!rq2UsL>uNY_Gpp6CX^%a zZT@A5JnzMw|foSiKjNG)K6tE42RiF;Y1>b(im+KWV|i^DV@bMF(8>+Qaaf^^GCUCYCW>3G1XXU<# zUM0baftL?w@&M|i;B`$kh2OtkG9cG@vEmHQilw=5tHRvjckSo3z4bm!0NJeV-m?gz zx3b5Ac$3lXmNYUt zYU1K9Z3v(UJXKBpJ2{cHU8VDf_~f86oq#n;?nm_2-+q(DC5e(R;R z6nOn1XJ(x^CV8fL_FC+$Z+3ki!)9PZlk?mqb+IDzB{p^li4(cr!@ic=8v1X5Hf3gX zi#`X!*C$=9-LD`j5rD^?6ci@eB{q3W=V|b~xE?arh0rvnP3|JY#ZN)*FSRwq04_@7 zrwzmUKxeP$p-S=ncJ?qsDi|sEtbqY&>jJ~He<9cLkkU6B_?5=m6e#BwNIBYDYtpOu z2vu%mbP_A&lUZcEQrNdAscM@RE90W0UpHhg%O->B6f#SC>)%sCdNqxTr$flF1GjLC z^Xy7uQ{x7UoE0Z7L;IhhVpJzIAM5$}2kV1%*i1kv_QHxezQ4?Uk)jsjEBcThLDHpV4C5siK2*tx~vy31Xi!&>x{->>I? zN^hh{j6ob=8%lO|IHmclp^yfby#ETR&d6XwzqgVa2TFPk{BFuKNCcV{gPldc>Uey@$l`K?21Y@}O4V;an@vk#H z36sC}kU2$dyR}$2C~<2{DLAl|JyPYQ0f)`uTE(XZ30*r z57(tiWU^L7v9JQgz4g7Aqs~wzUHMd}*QNi3gKN~g7MNmDsV;qC(mvp&j^A$DznliS z`Evv}|BmEeJpw&)Ovi`d&d8hjNYy}a+>bNcbi&6z?W?@XcXufOoGhQMT1X!yXVIRj8;c=FcU#ano1zT}mjN~>;58(g(iFCwnySghU0iYs?5bv?QI z)dtVVr@!ixK6v8j9^RF=>)NjLVr^B@##!Gq>#<%p<7LMA!MJi#s*@CLoGFq1_r$(7 zYEW8>%?##qhKdc=9Td}Tr2|dj;#zOFYGQfInh5CgRX>b9n8pJOvE;i?t zt`@ON2gP+)%$2wyhq|UWE^m2saeC*o8s$II(+z|1L*^CAk31@I==$x}PpLht$Zi$6 z9vD246(qmN{UyuGxxD>jRR1aeNHwRLOc$0wOPPwWLUWCr$~{*x z5Agm{&6NR<#K+-(S9rr3Io?~oUhlwl^Lski%txK}MGF&VIF90qeAKaABQ&?c?jjgr zo_9{$)iLft35BWS{!WeYoZzNmsZQl|_*wd$+I0q<@Y|f}Ex)E6vr8w3;@o2Sk5oLHuR^u=oNOWG#D$R|W{L zaG6H!p4GHyLs_iVIJ~aw?v#^KeN~J6orwiaexF(j zT+a=r0apdFE!ecIqP6LBa`8KRr904JXbZ(9E#!RboScKWLUwCw`Jv(uGk!t+jmx=2 z$zQkELJFXod@c>8JvMsNZ5_n=6i6hlUpR~kVM!I#@qBFz$R_mR_}OfDMcaX zVQgU4$bzx%%20B!SEPhK5Ux|598#a}n(5E&Xy6s+AQXw9T}Q5wch zuYG5^W?MX(D_!@_RFALO#Vm;xzfqyAXU=M&c$AIq*@Owem2ejZSNp6~*?4-3_r5~! zI_?Jj6c?#9d#roV3pn5h#sBXl04qaXY|FplmGou$1aD(ClRyVVnfptY2-3uUyDxud z1FY4`@gWJOt4Y`GUyZG_E{0u*9>u-_YcCOS;GmLsH~VRCxL3r`yJ`3tIYGSAKFDtx zD3h;xQc&x1hnO>c41NfXFU-6JGK{gd_tt+>(yZ9Z!D=x}z%REtU&}_4`oYna9_5Wd z=?|aH8M(b4)2Gu7JmeMQ&s1>fz?`L;T+@rQiM)cZy!fuVfn+zr#-Wiwcvj==g1J~m zU#W2Y2_hvMJO05BiXN>rgn)m2U0QdF=9yw`_c8ZJw3y=#=&9U;YoSpQ7 zSM&op()4CT(XipbU@BFpN0bvu)RK_3H1Ub+fzw&TigZteixAV+gv2dA18n)>;OY2E zlC7d4y7fUY=N5phxcFaCt(hLIpnee!Q0g;0d{vpgN9I^AG68w_dkI&!w z);5=z>^JUs&pDU2WJ|2(*vBYkJcy%P(X?o*QHlGFnO_4>oz5!c>rNPco#B7+U0#|w`9qXAH*9F?mvIYsc?H&-3aHRZ{Ad8@j_a%X7{kl&y&_n+ z#QIjKJU+*wi#2bCYVe`0-$BF(H#R*DwPM8%v%Ay`dHx%fC-`}?0tvWU%{@1vX9N@} zUm!u$?VC`2P9<{U6U$X^*V?@3Wj}!-c9f`8CEsN&(b{BGmR2{M3)K&Kz;dSm2J}=r z)b-`0iyqly_9&bQdqBj%L_|W7b?K^0XL@*{M@iYdFM|bGmjxY@dM!@#S=@DKoMSFP zJdd8$r=nFZ0(Zi1IRvTXk^mlNUG{#m*ZInX@QaiMAdu zl@rsd|3V)eA;3t1#n}4A?&Gv^;B3JROu8u5)mXx3x{(c!I_7tCaq&w}JUMVs-CCL(rtdOzkGeWrhDA8elT$t*MVezZb zD)8?E4}?oiDwb1^Q?v{Bl@fs548Hbz|FvAI)lS4LJ%4ZE5fBDTj+eBjpITBpG@;)p z)=x=*4QRBoPEBRYw>QLW&80kU^ee(|!6y#l1c>XQ7C#O z_kCV&`!sy)C=R8ok6DnkDr_mZW2ZysSj{UQ_yaM3HcVI%jiEa7s_}y#G0GKffL5`X zNPxJli#0S@uLhp1h)J7~B7LRwX47eltW(ItA}TYk0aT{6c=+W$(O1y@W^ZA>_#j6N zc5jO64CjswJNv4oW@45E+Ndd8($k)dojtNRiC~H;v8HvO?C>xE9m22WE2&`us+cf%Ehr@3BqRIQ)E|B{1(%A~5N zPA*xhG<~5f--$^`Jc=38{bk0|otZCq$1lI0kS!88#u2lv4XQMHeLokG&t4?&<=G>< z0*d5Aj$A40b49H9|JBt9jlx))Bd)X0QD={fIc%7e=OjRPXyb*BMwD~{K$n>NrZW-R zJl`sCPO_d%GL|6HXTdeT1r*!bCqX7DX|i5UHd!;iFcJ|Y<<@Q%<2mZh)gS(#Fjs20 zC1kp>#vSyoq%oRijQ;tbzD%9twbAW;%rRD#vcPQMRPh4OH{KF>rOt;k>-6IdvpK%m z6P~e%&#L}^Zu$Q_19&yX7z2UyKK{4FO+MFl)c74jr zvd3+}9D6@c9Mu0$U3>Hly5pLDWIK5mP?Y~vXzd~FhqPkz0+l?=81-QT`T8(?qiM5I zhink90YLme3*FNVV!fAnB`_E$hgd*aPt2tP_yl8+!2QZHR-pw*?c=$9J_t@1f<18B z33AS7Ep(5XBo8PnwApL>`@a=e4I5kBbcx4)NF~CBV(H!ymn{R+Y)9X@lajSxAq zkwWq9UA=0j`xlJulk{W`#8Txcs+~e(;{6kMw_}kVe8D_lcm{;BLxs_`@)lnbBwQ((39n~E%0ry{U zv74Tja)zsGvmSfYjbI5*6fZO@tt~T3Kr#*q>WZQ}%S}}OfkD}ccnI;r<4VK}!saFZ zIc83vkcl8*wpG)AfBD^oU>xz)j_pXOal96qHLx&>qgH<=4arwLA+e&#vq=?uuQ9kipyeh zX4ad^0|02`vz;LLM~(wj@~a4%bSgKv-Sx=nFuw84nsi|5VxyIM8>?=|6_K~Fyeq*) z@y8bIVEs2q!BXv7llNv~J&wYVf=v!ZO3&?oHWDu!gZbR$yN&Q^TWstCz1*BFS@m;% z0r0ehwUnjV)`^08U z+6mL7o}|rqGzZ&`{3e@jYZP>mxs*sum28Z%Z}7b}6)Nzq+@*I>N*msSHkiIOc9# zIPrNx)~&32Rwn_w3avhv&K7iMBtB{C8P)d~!#H`CL^&T_f^7D1 z`$}5jeJ$A^lN{EDZvpQmhFA(BE=u`Y$+o=05h%@NvOccjG&y+rXQelUmVe z;D^~}Y`y7M>JCqii8A{kNN6QZAt#O5#H2?Nw<8cZQ`6I`kMVwWyQp;sx;p(1;}&@= zURZCI$_B=p8f?TIF9!Zg%gJkq69_z-?8r>fK7q9X&uHzGDoo^sEf-4+_BrG_0VObnH`6$BbyF zAs^oGB(LMKbobxWxuM43b>}pOd~Db}x7~iNwX&;#5QXZiq$gR5LQWS7Xc`6b|DY*{JwU29VsHv4DzGlAw z3>k0c@M_%00*zPIxMI;%usy$X%#=xr26-3xv?-P!$DSha-`Fs#pCJDCs*4lYw?#&=_C< zuIR#(pQrmpI{cpqy1FX2j51spyDVKBaOGGgE4~)88Jh~e>q#blO$B6t!ASGb4FK#U z(@tKToN#;#7u5go>9De=viPSqFUrE1%9PnWgv1wzbkG<9EbFoDdXY zyTOthQa5Qv<`L<5)y837ih0NTFS(`3tlr9DAAY>(b<6GG0V%feO5SzrL&W%Uj8(R+ z-}?h6i^Ndl5;UNZ#oyRX>$r4`c(7KV9+IMr-5f1O^{_DGo~tIBB#-r zX2xjp?;VH8*Pe$OIMVEBT~w9x#8)2}dC5R~==2ldc^3JDD6P5@P8p&jXTv0Xy67#odgTE)-p|KWgZbe9|5#=U}FPS2Df=?^s z-1gYK-@ie!AjYw7*j8gT88 z7@NOT5#4#`2Z>G^PETu;xBj0{^zcH?nb{0ogjA@7H8S#KiT@@!fqSj1x$TDIS|#Aizej>z!Z{-8EeTo%jLXJ%29FqM zcqYtd;rNrq@5=h#ksMyb@>zSV8QG-q6xphebe^E~(2(bR^P|>0nJOlAj)6Uknq#jB zBLG&6W0_GsE@=Atzmw9T1n?m!)yN`A{>iYrJEx1%Vq{D*fF6tDD+|&dDsLR`WVD7M zMmy2hDDu2kuHY|}jj@afc}6Y`I+))q4r6Id^uoYtj*9&6?zGvVCsl=3)1^OaCoV+( zB`Rwu7Z+nsqQVEHpHe{|CGgs#l~nv87owKo3=DaW;9(E|gu&hUjsg^JvgD&pRrSV5 zZu}u)#x6!_Fds1sUOVzVge+b}?=Hhtb9l6c6U1@g_clTNL-E=9qF#YnXPs6SjQi6^ zds!}gY`#mIQ1OgnO8qY&lg+GSO@AH56W#R-jnL_t8kSKh@YJ-%;g6V&!EU5(J&fQ( z&OP$aF&5A03Eo-$)JlYzSa$771z!eGwbYe}n?l6HM6XEOzb2HyxJ_EusFbkH6~0~t;l=RBdg)lq!~$Hd#xTcy9+hd=>$ScrOy$iILt-H znD7F6B{IgSGrtfdU%V3jLFM}uvN#FUGf1byJKotPaz+}mh`8jLtQVAi8l_hWyN?#p zzcajnN@dNw044t@krH#_Tk&F6>@e)h)BF%a-Xgz8XIk38MX@5#`eg zVOjA0n47bjseYp{s^90}2RW!!F4Ixmj1u9&@x61uoz>*_UJvygvB!*f+SO>1wD`5X$Ecib{ecxR zROY9E@kqjJU7r%(7_5;5JP2J?kv7;z@AJxkRzpWp(*LnBCR*2To3QFIyn;v*Su!oMTZ6(pNdkU(M-#86Bu(zp+93QFU}!k_37klvC3E{O0Cve;{{B zyT5tT4Dy$md)8;660ylt?;J9~-F8|9Neen)^fel1P^mSh;vP~5VShllr~Tql>b8hd zxCnJ+4UlB1On%%2^w#nLzFsq}ZqYvD)p=!h-R@bC3W^LvIUztu}gbuxeZ`l zCRo-D9agG2ls(PY+VK6y_L%Z%LLzfHR>cEAf^K0#!!p68Ie#v!qA*yEgBn5CAE3NQ8m6drTQ+@M1MB*AH#F%+r$qZPeT41Yg<<@p#Nl!Jdwmr z&3^H#3;VS*sU1nd#up3<>g8BtIbO%G^04`-*#%JWarb({wh~=}RXaN+91s=r z+pCe3^E~ccZaeN%P43^H#RjY)TezYRC&c5ht4B5aprbKHFC;TkA{w@6PWNr~R9p7h z1?cB9VYGWp|F6|2Y%7AKVs=VC<mkL5C*uahKM zM)W;H(8nx$G-R_;Ny`Js_Y!w0||ZQA6pw+b8@@QvRnPL{Sp8LF~cny7o$Ew zVgV9(U^gCi9;9`-Pm~<1E92S*22vVzjP7h%@XL-bf?K~wrC?{*WK2j%t%be8O@n$D zLAs%>IRcstCDPmIK$PLn$|D6Jda0(=qPw+gsLjZs#%f4mYTJIX&sGqU_O+Y(cQh3Z z<$22`G138v^wXj@N^c0(djyEi-0^Q5nj{pd&}U~#UNmwI$`AefzM!raMoxa*!&NQM zxY8LYh{6`Gx#5ioR1L9{(Z>7H>cTll6p<$LErx}DGaexkT)4+?!L|Y; zl(*R*Y~CX|#|UQRCFx~(7*{o@D?c0%5%%Cy#=aJ+Xmi>a+pCE$SNn(xwv*iRw+C)| zR_48VJL&mjT?Y?+1(7oK$hebY+>yir2WoTLEHwc z0KRI_fxX5txVmQ4@ekOPc1+Br<;u~TOM)qBn|DPESfcI3<>;b5MyeoD>V^mkMkX9 z^xMcbtC>>oodW~H51V8ovGJkGW7cu0<(F?HpnxQOFh*yEXtQ94G9tdK^|Ytg}%p+%z# zma&{nar*ScG0%RLfum()6N1jO>Q$zsG1wUG`txag#%ZOc}EmG^AmInCs$-Y9_vNNpF35Pq2Upbm5-ua#D9effYBh?6wJ-CGpqVS9$Tx zz)UQweh+1d>l2YVj;;!DYC$+_IVNj^fyMX|7<~;r{v7SASm{zl*f^@Gl7;sT|4#El zy8u~uPb+~0k8m0M;+FJ*7)ehq%6A=XDl240K9}hnBpst0hAIxrfz<<=V_==*v`2Q4 zR}IX@p*`Uxe-v4;5@g2EGmMOSM=x*X$8xa3;=Kwv$!yr|SMDk(vD7Ur5*EGwqI_y<{R(F? z0Jn5bNIfw>xsj~snmkvqH&D`@$vr#3zhdXDrJfx#(ilg!*YayIQGPWs3}nTsFa+fhbaH}sZy$w~KT#<$k&Le(3qs$hv4$f$wX9P@aVS1T1;|?+GP*Lc4|FCxD>*(=8KR~hpb-rRh#N@PK1Fkk%!BgMi3?9|Mvhuh#6%itj_dx4mx9|ntIK>lQ6erC9Zb`^{IY4_2$~c}u+MKJuaB`r2RaGqOtM$T zvu~&Z`tQ3{i9v6hgF>oWRs2Q|{@Us=nwVKSkPvWgD-PYGQ*cyUUZ8~$)rEh}#Myw< z{sN316nU~#ok}QH>Y2v{^94zScz~Hwf*O| zNK$V(8J;dnBmzv#(t2972%YA2F-yoAT8E#Flc$Cq-jagU2uQD}5ZKCT-E06Sf3~Yvg)u$4v&lH&R&u zlv)rI=Xt9(5`x6~eN^?Iv6&8yD8FhMN7W52S|=3W5c0l}Gdzn+Ry5xuI#&Tdnib7U z1?1B#79L%xPLGCGiz6b`O7Wqi2SvWG2WZ^aP0E$__0FNT>_G$2P7!h z=g=dDMg)Kt?UH{t$=ir0vyMXc${CSkR&S3i$N5*+_-4XrcR5em{<+n-<6C)sN7MUZ z^=`WOyYOdgzvXM{V$iDLDTTn#rc-lceYH24cY05mhYZ#H{?D7X`!_zmyUQu>kgfy& zI~pDg2}(FvbYRY*3mdiPA8}TK-UjMu!L=pTgxk8s2<^nin3#z-bhHJvw7JYre*ME+ zUoqpg3`eqUK|MEfVfpiNP7tU`{a&#q`{GguS4^fwqOP+xr&MQ)9F^SZ4tqLXL8`qg z&z5?~{aP}YcZ1QChF?WnE_MG&9#U|Zl5Ge@NikZ>I$~GHKYi5nsR*sFW9s+Li5qe8 zYt+D0WPLaxD%z$WA|FJY0N+NZbB<;&=mSuUWR0S;4eqc72uJEIJs)kTh_`foflfd_ z4%54CG>6FM1U@_%f=u1AiV!NVzU6x2wOrAgbLxCx8EVQp@Od9%M+mWjWn6i@c@R3S zuZgFED{K|Ditd1^N8*f3RBJekPg4u7D3Au)PZJebB|P@(ew~vhb?BCKx0jXtCX`aM z#<*P8*d*4N>xVUOyqZSP!x6ygu*)n`GsA*LX#MY+*FhmyLNWQ#scf{yQg-k}LrlSw zObS^55EX{u!=U%kHS|8pmCET`2To>3BH85@H)cC1gSX~{GY>|tzbVz|{5(_D-t^V1 z^w!UHf_-Q4sg|P$Q1K0^Z>UYUI`#Lv=6V1F7pCk;ZVWJ!wZ4?7T2{d-(b*5lt()Dlh*Bkr zk)*)AIJ!<7L_M3z%^k9XC#tNw(OE5#H>2bmVl0E$^blE2j25;a>nJ94`|jMN)FJu! z4|8KJlNVx$lX+`_E?OT@K$kPIk`C~TOf9*f(8?ja?LD%RRl$9Y+kAWLHv>O+gbfql zuAM)%{XMiQ&PQ-X_9>d{J*OHj+rQrq(<%#`%s?FiRq||8`4psBrO*E&DGAMN0iaXF zO|65bWRp^#H)x_4-y{#13JzAFD~My!9EsB!^TZM_3uc-H(*p9JbQ)(WXyuZ&LJP!{ zt4Q#iD2YcW)-e?^lb@!-f>EDuR(F;P3W2f4_)$&-JBZ=6?ae<(L*ZAj6|7e`cD;CE zXzgL-I|07B1Px!LN%lg#?+AH(0aV2N3UGl)aTMT z6hlMAx{u4Bmn_OWrC4RhO;x)~FCgnbae~@2DpLCwL?(1)93TgoK+VP}CZtUhSZR~J zsn^0Fk*jz_fAz1Dxdc&7@Ujq9rbgMhif_1A-X&E~S6{CfDRD3Ms1h&ie-7xzydkwM zq04xqv_3k6Tvi<9%E2t)umYIsXEAfuyBd%Eu0ESXLgp`9zQnTF=YaJg|6V=xGj2R zoSm!dQhjzX63&R=&CW+|1kZ$!h6mH+M814HpN{jCFFG!G=CZjZ*D`ezeYppYyS<(c zs~J#{OoHDCi& zE!=A{x3IsC!KNfz$J*UE0vQ&B9UoRuu$?XIR9*xtfN6n@XrNqP6!$!*LcTrFZk2bc zS5N9Pgl2x|sb>wM2#|2RW~MjnndcNnhxav3k=Z^*9E+u>XGkG|AU!=u39P zcPO+Wq|}KNRLDwaR>a3$VX8(;gyw4yj3cle;hE32hT|YqyrbIM@T9|%aH41n3UZ5hL61t;9gAHAw&UT!_?X+mjVSMm45^rYxj*MqK zE~YvS77kp|PsyR*jVL&-nP@$u&4*0s+q~cj@Pgq z{1&!e$UGbD0@g1WVoA|5PG;LJsw^0Ex0}354Vt4MTrQUqM$3zV6Xe+{*>Ku>MGhS! zqqTy zr9CHperrYeeRb~rQ#~^Cii%9rA)_Lq1uR5Yp%z=F{5mqH;>Nr6qRczH3%BUc&%Z)@q%m02adJWt zB9qsid0HZBNS*O!W@89PCo$l7%;RagmQ&dqv!*evJ_l#FWvbT?pu%Tpnr@>N&O;~S z+jqV&yVBbKxG~jP>mqg{aEb0{rqeVrIq%g})eXyA*erWj8;;$~{u8DT{mF$@vggFC zuPZ!LqmpX0*mezduZXWio48x9FT3BuT3vdK29ZmIAoKK`dKAyCM_>n6!h$~l?KKWS zTY~eY;c<0Mxxu`hn^C)PUf~URZoTiA!6dPO+ru0$yV+Qpj82;oos zu}KaOm-xpGegvbqZ8tm+Jn3uSk~#1JIM#-^X+WQKtmz${tsGbzBy#jfsNW^0wxyP= z(U5w@e(|FM$O-Bk*%KItOe!ZPU3%(R#?~d|@B^VE{rb#!>O%-J67qj7aWpFF(oI3# zg+=?k2CppWPbnIX-fP^Y9JH|D^T&trFpq>z=Y-2p71Mv(-MiH3`L(CI3-d*oA@Hwz z!d?qn&Q^4CjeB5w>PCVd)}VRiIraF|svVWQCa9|q^>?4t#y z9m4TG9P@Gx7cfLDZvf0J2~k~-1UzOl1cjP*ZZzB+cJB(>(RfG|@FBsc?=G~!+MST# z{o@_K#tAC2mdX+6LG4qRJ`7KLL;0ef*JgfobD{US{`5TrjMka@0cSRF%6ZFD!2=`h zCnoe^F*e{B?O+(Iy6NdLo|kDc2`3SG7~ot_W-+lU`*nU!VIPLYt_VOR^NzqK*^!6- zp#l*B1t9Q!C;qu9c^kqmbC_&e7DT#iq`$-Ek&ToS&Y2;rT{uE&tNjbqBJ&#dLgnW} zfeltkLDU5;YLl#fslPf!*$$DZRW4_tGy$n#tU{Q@kAi)!JSce*WI{Fx^kHX8!?-zm z+;}1^AT#!s<2cwNY}S#?b-<;IsBX8Q5?NdOtW1;jENEgnf|nEixHd8ZwpOP$VC`HH*C7qvaRX5X zMt(OilX;JG9#aokwXBX$&eaGenb3urW}>?|1vX^;L#ntg-IetTCwmGjfQ9w>x`WPQ zVp6B9PmfE6Z4OoNs&2T$d7m60dXVk>bXH5EI@;F#9MthgMP4LRfzk=PR|SQ4`Md8^ zEg!Un5zXD6kiWU&t+T0L59~|FV~wN)Bag{HsfZy@{^xoc5c%2A_?dJR8yOC9*PrLf zCtQCzATNk+DsR!v{Ky*^`O62sK8VZgIwhPhNMn$`@vO7c606ro3uZ>z{nrzUVuwR< z8>(j&?TY^;OE>g71q;#VOh39@aBqU<^wys*sBCtc0)h;-|5mk}kqu7b&t`!1r%@*P zMLkAa%$0}pmErQO-J^~_K&Z>1Nb)@MEPr)M`UG`@a~IGjiJXQ;c}kNo(AlY&yJO9sMWHVqrP$WQT4^`9L?pOc zPA#N>p{jvdAj8)a;q$SaFAIn!6-^ODw6E!0k%tS37L=6(g@k!6}# zZDS{cF8AiBYK&}hna|qk*E`RB3GAHZzprF2kIKK;r-EwYe-=Objx79TkqHjXfElK~ zV{-#|V1`xlA}x(%i#w@E)E+Z}bXxPeKxR0HQk1|VoP0FPnUoxGGhQyI(&?e$I;SYfP!uRhzC;qRDg{Hln1CbEjl0w9Fq)Jd+zodPox>PQNWgR zRpz0I(uweLV_zMc{t@FHjr1fWNWhF`@tEyi z9(9}0%W3049%h3)Vn3BxpJhi0rR;mLdHdlaX*nVn?iC$BHhQ~=gmNOmLQHU-`Eo~N z;97a51OHg6ky8=VN6Jg{kQ?SWYv-8U%*|dnC6!LnnUESO*|ix)^O)Su$~=WP6p6O^ zMIWeRV&D5ILaXS}-!l5EZ#3is0;q~PA}htUb^mgbeJLk-hdp|f$+A@UuF4GmXY@$!nyXIm7S_2SyM46PtMn z!=YA3FYrGOb2)DJ4RrMuyo(ehtx5*|Y5cU7z@qu9Zr?6xKQ=9Ovys#Fm(N5vO)N1G z9<#Ai)7X3MfAr1xW?wZ1G6V-QlUn9gZR~C}jln!oadO{}P{`yq-Ey7dnF~u+OH6^5 zW7B|$6CWy2?QXOzHhgATk=76p3_@%khrUNK**`sSqzBC!v@W+LyAX%9b48cd3S>T)b9KNQDs61G7vsvvK|UjQOi_CN2}sgbHXGxz0A z{e71YmgA--pr7ZK37NA*#sAIZhB(zQycM4Ryp3oL>NNP2_6(dhzOCb{2FlEQ8B)W} zF5tcq_(f+s(6PGiZ`Zf=<*`X8ViJNzdh1UWFgXGD!7&b1>1Wufk+i(EjC|IwU}ry5 zuuIP->nyA*vvTP0Tz)zZEzX#i!@kg7VICYHXZ8#L+&_G>nx+#h-)nEmzK6;<@OZ!) zW61-_>ILLy^Byjc8QDZ!CJ(s8m8k89B7^iW3P^p{EBJ64LywKW1-F#B!WhKWo^>r1 zIGVR#JfYDTxwa~ovjPqXqecXwkV(L3M`qxBet9CpcL*{C+@e0~pzI?EV<)(rcQe%E zeFmf`rjY z^+ftWtZN`ol`+{zGUymJZZ8V_lL z9~enPg}^5)^x2`-tg{7*1Prguh^f8=&ICs};f%aJPGKt!fVSq)H$MGI``-0LKg4vu zuS0Y92m#TTXK#J$Cemb|hB@hi}UMkykv;S zW)$}!srgOZJN75#J+Vw zwvMs0bhmW0zb)K@zEE2##DVQo)ON%->~CENa5wH9O{xM}saw*YNqrhaTI%mt9P9r) zBrwhst_yju93kxt>_;lo2LrL{;^T(TzOE)jFY(iiNFsd0 z(_T?1ou|}7?YyFJ_^bNfH*H*NnD))`Xa9Z4e&PRR3|ezF>8HME9em*?on;7|X%&3p zfVi+;Xz6r9=fEhdaXaJB4k4LTpWbr8{WzYBfOpvplIs-rC*IWxd? z-fixenr*ng+*F=g741}FI~=Ww%02UXkp3Jnk)us>B5MKkr%5(};x$g=(2?lWEbU-w zU&Df#?jN`Bx-1zwMrn%w)Qk^U7)aHoq=nj#ssqNdJ?H6xxkR>a9bM>&8s?-$_om$f z|GF`?%Llb$nq=#Xp83(DH!IzLSGCxwE$WZ9JUH)TDvg|DLoaWf()K?eMq}j4{#De% zt+gdSwCtJshbd}cw9vxLr?o@9_??pyeblej(`k+q(HU!Ka+$c_W3-RKdjFrYt^=IQ zul?InW>S$+p<$;;QA899$;eKLvdR|nByF2YAt6y_k-bAU4I^0@*+dyd_}}MzsebSO z_g>d~^?jV@JZIed{+#>3E%rm`&K=hmzrn`OXny>* zJiLaEkBXT!4tt?j*PkiQg`1}S%mi@>v<0($`ZV9SuF&@xw-%tL(Hn)G#lHkTf+{j% zAn-(fq1+a#@WquiX?7J+=bM|rBBJq9AMbnwk{#Ch4M`k_Y1jLtd-s$FxxZyUhER^Q z#M7LE>~C0)LaD|7M-Wr*3Q)#^>M^5~?9(=)@vOGu#h#&t$Sg7>M?4#QkEhSAF6%8~0+nTDF%_&5D(Uj3Wtn5C_dN~O;xP06 z^Wge)lrI&NWlZR??TtMHkDnhAeIdIBy-C2UtJNiUfbN(?UPo%hvY1^z&9;((J`a~c zKf0cJg3xhrpe5z@Umt?5;+ZUfgY>>AO$9qFjruT{PX*`fKkCJR^cT8T4F(?iUR8hr zB3dqm4TCd-{2L*RExfjRke@A*G}-_H(F9UP0u1&NP%02d>R|;y=WNzpQDEsQ&KgP- zD5LEd6Xw}qrE=xYW;;a^;!D6O6neffN{=e0jGDo#4>J5pDP+=uD>He=;EFti7oZ*N!kb3 z#jQk*k^6gn+76=GDUwqyq~l3U;&2^>XrT5Ocp64whUHC4?e%CIA?1V4wT8Y&5%mBl z$?8y+p0i*6910p=0E7~X8p92QBa;L-HsBp^=qc{!?C70MeR3Ba;dNdE89S0M>{x=1 zE{D-0eTVANqS(7393Mz@#G*Tv6fVgAoO8UXVYUNRBAy#*KQLw}`^VtN)rpmLXDnlT zpDDGd8lv7>pH+dc@|B7R21jl=CZv6Pm4(?#2+cNi1{Iry@F)&wfn^4o35-_SogB-a z0$2$@a6xA9B>*0Z?mhkfa@sWjxkboiCKG=HMDbWe3nyy(0GB&d_Gn4Q1)wK)k&nt1 zo#sLV`1@lx$AXPmKq2{SnC9YJr(vEbidGnHvRwh&jjvHgcmVco$Y4qWOadf`Y#BV^ zYC*a_${witf+K?s8v)gXElx0$WQ`BFq_b8=7agorJ8}sm(R_*$@|P2MwK5yw*zR!^ z0_As9(UqLs-&jy&gM>7aVwZ!WS#?b;0{`R#aJCz5Ymq-bQ1KKZBv3I+2^+q67Lbr| zhlN%8%R+C1Sj)emyJ`$ z2$y%!M+RL(S_o7FXY7%CjxIS9Ev)T;80bYFbom_eoj@Jz)jjgu8ZJsBQOL&SkUon5 zLIx$cx)pf6s`Q7Yqff#_2! zoNb1x!^3llafw+fmjJrJVdQSWhw0BPa0sl6WyJth?N=#jhDtd)HZ4d&>V|~s{p?G+ zVJ`yQRnpB4n>Q*yrXE5X-;|GZZv?Y%?99h7!uDg+X5;%z%iy|d>pdNDiHA@bt;jsY zaj`My!C=KzzcEJ_MeMFcEFvoLDG^MdW!7587O>--28`PrG8&9WHuPxc;#>2UpCHWz zTE8h^ctB7MADwH_BkTb3r2WzDlg@!1ivv*0e`#rEfM@BqLpb1;;5c`T79)7g2Qc`I`@(*$h zmZS!^l(0hr8_Mm0V}F(>CUhMURvov=b{v=Gd&+UPDtu=ER7?8F3P-0`zF?Zm41suj zlU&op>dpZ?jL`krdOfYYC}Ys1hEYhUt}6m6y|}3>mb;RT#^_V1Qy1-~G>K0WBs5+Qq)5gSoxf5IJ z!QP}y9Hl4KCRA#_NvDtxf#s%R0aZwz|6og;4EQWNL@R9w4$w}^>*0CJpT>B+DpY0h zzA^D#mB`=vu|yLk;4n?0v^6)Nq|sqhgcAFAPqD*?!x9|E@6F!rE=EDF6}%U&dq+!x z8=@cxVs~`&3MNa|WQBU6?ZT=@(9IAh6 zHKYij0W9FG8JQ7VwjO~Z8aF=0<|LYABIuWkE~@*%4R?Sd8U_UnsWWs$EVfYY!{G20 zKRjW&2PBB68BHz}?bc*?-Pe%n*r6%7`GOg%0&xH*GtY|y*uzORnd1}+iN_*faTg?@ z!Md6*ko+r^2rQNul0f;A5Twh3>Pcv+8q*5& zuN=5VsuJH4F)z{EN$_&HQ>XFH#`}W&_?Kdj>-;2{#r=h+C{zgV< zyF90zw5lIQ`q1bgnfgebM-eRb>p{NA`N81iQbB!7Qp^cL_u=xW{*wv5&H9!qAZ!6G z5J%GAT2RRkrUFhXOf&*A`B+OMP5GeH5UpL+pFp5HXvvNvi|Fg2ZE%wO)(`+`0o_ES0~f-( zR!TxONC?-{kn+{Vpxl--#fZWnUx0@7CtrYfo<;}n{9I1MCU&TnG>*c^|_`3sR$tFr^iMB0!WNVKtwGY)~TzDF}DJ$I>0WhGY6T zaC~x$2bxIF5Bg@1;KA{A;%REb0j1+bK%+yw|ruf z!ZXKm|DrE+Z-<12MDOq5&)C!0x7ITh-8!~u1J5JbzU^Qm(rfR9r8G# z+k_{rF}f*43Ek&~@;~lx03N$7CX^7uq8cuUz;{R=liSp~9?NR#O~Cgj5t8Z=y&KIZ zoFQMt59X|}c=rdiDg-sA+p4WW07E%I5Wo!bpr;XtwhGEG;o-c0rb%WHuopwAs-jFX z;qD29*~Y1eg`DDT1W9*b01;$q8WjJ53(+2kC9*uXx>dzsJ%^Dicp4760FCAU1C4!z zB0Lzd+h@5v3w}Hc#*a5pNF2>#Ze-B-701%^ghlQUAIKtipu^};Zjiv0B~cIzqhq@y zl`n2oKG43zfD3Q_1umf?rl_VPiod}(uKy`pi98{whl`jdt+5d&c`*V7Aj+g_j0cU+ zG$VvP&XuebssyS7fej!k!qoyqG*nJ|fo`h?1mgw-4O+4}e$?y4dT3ImFQ z5I>?_42;A{&-^`52Lq}fo&F;!70)Q9fm z3Dw6{ykURiKxsKj0Q?yM=;G{O+^W)Wx`1^MavubiHmNwJibG8J@D>cZADj4yR&fOU zpY6x6FJL(EgHTQy6iddX*5jZfR_c_J2psgi45;t4h!jF1rUxJyNXqu0C*Tc;yHqt@MG&xK z0Gk5od=ac9fQ#cZdyxRSUMu86p|_B^BA^!w8;@dWHhL7j?(_-lK?2c&SoJh8B~}F5 za$@?T;9sFi!dqpr#i?c~{(&_WHHzydE*eg>qfPx;CHIUB?E2|8NFpxFViI&ap-bnl zu*c_yYmrz_mBfh!l=GTJqf8@EoHebQuJ3jmc3Rx>_n|YRPMFd;jjo2bL+aksVC7^A zX!Mn1H?kXK@Kr3!h^#rA8-MU!e^JwVY5~);wlQ}X zopNE_jSH%hq~r1lqwkwT3iRy;!;xOX%LNDmd@Xc)y(SpuIEM~rC%!%-x!TL@AL8r_cF3hkj7X*JE~os)s^#UQMWBtOcd6)} z0_PW{!vU)~75oTm2vV*e%l@&l^Y|SCza$FR8o>xp4)1J zP(fEq>1OwGa)gkCq8#)K<=Y~W3iB7yP=n;S2+DDfl{t#b6ycL7I4Xr7?ZEZjR?dC! z@77Sxj7RssE@xSE-Ks=^o78+!0N|hGwwmvUrrmNYp*R$XP~JsRnCk7JcIps*6-OP= zbp9D?5I^{?hh98wlS#Yo+Em{_Iy|8{DS@2J{M7@tr6g{E`v);P5NENCGiYn-*&!;S zz2z2|pMMW(N$(=j6G{ePf6{Wh($KIm8s(MS(g!vY#$gcv-+5QFk|?c1cd0YkfluvY zv)?70r)RUVFf~rXZriAARPezue0w0|U?F!XLwNCRRGxe!(b4&=%2IusRd<|hCoU$s zl7@w72`)GpypnTW{@sE()FY4uu39J6mIO+{*>Yr8qT#4QbOJzue{!I}V38})r5Tg} zt%XB%1d7!FKu;7z87i)cO(!s>knukju=n4TI>e0j^1KWD;zox%g1Ai=Ib#P0I7iTn3*|cm|4h;%mRLS&|7yrO{wzARQ0ToIhvI&@;o8b6H560jrgGy}%P7 zfI-@}f+6w}F8o|suS8yiNce^-sYEi9LyY+{#T~J=suv?Mm3bdqIZA=^hGN066#YoW zBCG$vDf2hrJi|xqnfw~8uUkp%Sr zJb=(cgb<*y3=ZS-PZ!N%6RW-$CWnQ92W-3?g%h|0-o^tM<`f)X1?U)@zbZzN2>W71 zHG>)~?D@ad&}J45KbU%n%B`y7gK+bJa|Ow6YYviKH3ZHsL+uJ$Kww+x?oAgn+Cl9q z0H>2MHn=_`6oG+Slu;p8e6k8(5W42QDi)J*PzzNQ0)ZX1pp;$*jS)~=0z44N7C9dlX8hJ z9{UyC@!@vcBLrM92?SLlKNTF0iiZD_agP5^NIbx&`gVc6=4__d(Qw)!9t|9Uy`eBC zw%jqas?^cT9ugX8;Ljim1U&(+Ns||qeM_`8N179_%Cf;$5S#ntef#~qX*gQ}l_yDu zpgot*B47j>N#55Go0K$VzkgeF1(E)uVL${6mkf8Pb-HqAvFo_ zXoc?im5w4jV}F@pJ+=w~WQJ-p5>6RL4P@lv*N`iV&n-}I=56~UV8Cw!dmpC#Vhokv z_(S;Xfj!h!dlxza|2|8YXJ0;P43{u~=7m#0vY>fw4oj z3!Ah~vM0k&fp*3x4T+EvY`UYFAnyZ1nAN91Ai08SFnXdqW5g1Ac>N)9P#(nmUbR9J8)}CcMBr$9oXfc$U2b#f!6}5AL zNw)_=33e!+vImuXawGtEbrIE9(at^Mq&$)X!C$8H8%n5}Y(HH3)eS0cLlIGEi6GXumjR|o5TlaUFo+gE0^9T;<8@Xd^f-L; zrwIb|p##s$yy3B;z0WJC?qw@N#MK>B(dEvq$Myz`UjNokWFa3uiHsf#&MbF}5 zy&NJd3ly7TH$qp|bHf)LRFlI}!3Atl)!9c0aZsdXY+oEeE=BKEq2o4!;Y>a@+#X1( z{t4T2CG5cCIfm|SxSpY+l$HaTJJ@h^pb5l(4$GM@oDaH3BS#b&26IdIWCo!xK%v;yDQlj$-KNH zn_LcyP}p|p3h&{4uWjMBF+brDr!4)dY$ub9cfN-=a44tfW*pkRmP5Va%98e)M2<&6 zwd3Q_dA2hRJ*|qx$p%gGyVrJTMYm=U^Bn6c?1w&>&0g0IWq70Omk^fc{@U({u|%%% zhp&_4c^4{wdR_749xd3W&T=>!@(nY@)b)O{XoolcNE57pc*IM1i*pK7Y~HFI_ekS?1X)zlvO?mGL< zH@3VjeMH-a$EC0JSwi#I$wm)h59b#NIi&T`&JaPJM;m@l{PRRXH`!|IpY@2dJxgda z^xRz}b!PI!$YnN4$^(6A_`9oR;e!M8W=i6CxxbiRorHFlh3l&Ue}gxoE9vb}*d4t7Vrp1NOO#ZkQG%rr zw|ZU68;j5x!t&Nx-+`<6NLtyU>V+#e6iO*-%_h7S0)l@+deu$ zczpc*Tdp8g?c|!?7r*p(Y*5?0!DaS*uYcvU0{z*{O1$Qwx;Az$Om|Cl8S0MaW+}p= zgd2(T>a}+~^^+EZYPRor;M?*!8cplrRRX=6&^$(3sppnH|DBo(yvX?AR71Wr+K3^K zU<`8#<|y3q;hCy~MwegzIbvJ)hJEppx>A1D~^b z8$`4-YzY|&lQkw136`Wu_*^vr(j*c;+Zx*ovjTO(Zn#U_7Mw#flgvBKohE`CJ~Z0H zI|L2_`YeNSMwR;JEsVPJnDGIfc5L_V7ke@?~M-UwK0O_mOeaW`7f?^g6oyLBGB^z`C7+;bU4dHIGW@ALq7d z52}?zdw{o@H!-8JBhKyt>($v9)4KcDLPT1CxNLrk!io9Fq ze8Qc5b1uN51QbFY3~*Uy3lhC6+h!q#LTithPAsUzHMlJqXsYUQ?NQjYD5(dqcz@b3 zc9ld*cVli(Z#&>c4+|y0nDDud^u74h=??0?CSS9A6?xummAQsC2MhCMdZ$u7F0#DJ zE+T0BD%6>b!bZU~9p@hwrj@PemhNi%xEsn|%myEXk#(r*|CacXQ$$nVJsRw;{G{S! zYPR)psuVuA^Z6Ob8u)Y5qzW=arK}xtp)k{Ne&J4Tnl53l z8oC;g6yYlJvumdxJZ+us_z>kz=NC`-jCUk(<%YIb6`0u(40n66c*;;%Zj}qj_GJO^ zbBlkw>iXFh4W`^z3KF+N+HIRUjg+pj>e!3wwVNm$7^L|Ma^cC#@$oHpfP2PMqq!Zu z?dhlok*Fw$EjM9(G;gKBS!mg3`~mKbNAm(fL?qCNY!?cBIkre=HE0~uX&=bm4rj~J zj^iix+h>Ez7bJH0e+6!bJ#epjj7RZj561ajU;rtZ9I{0koM?(bUU={pXv1NO+dUEu zno`F3d0^v1E>vN*Nndm1!IQb|NqHBDqZ->l+}ODU%meF`-;o6I3aJCU^)RQm2^?WT zQ()`whE-dZuRJus5U^c;DFlu7V88}o!Yt0Zly5-8XeoZU{tv~>Y9rn?@HcM(2!4fq z)rBJx<@cI!Z%JK`&?x|sJ z)?BT0u`rd<+&tRySMVJpZbH4F z2jp-{sF1S>$j9%au+2nMT0&f>{hsBXhTN1xG0{8YbqbIiFCGnMS1y7;8F2bfD;8%Y zZCm+w1G~f<+jWC_GO$i?VTO6IYx&K+K&&22Da{xEGb6I41wI+=#Ns;o*8r*$3!B zIx|{q0IdeM=V0w$`bC@Jm=YrYf5(4tT+aNe)B*YeAH89=P=3@KqY3+y%P#QF!a_^F z`zcuy|0z%lAczRerX;0>*J;dj0vRWjrE=Q?K}!R5-11shF-YNKF`QpvV(#JuyWWe` z0A7bTtv3oj4`bEv$H1C?@I%)IH~Z%iZw{Kp*BEx?+05H+<-|EA%11#-nBZME!T_P3 zHzTr<3M`GAX6%mieV{YL4R55c>1xs;DSL1r+qQf(OaN8|i8b|KnrXf9&2prBvBaT{ zERO$o!j>=13n`=ptV`+eij{h>MtjWJH9Lh#!IeVUoZw5$bAL|zcp?3ih!zNu`1N+( zu(^2acvCs>BQ+db=}miH|DMQ)apM&G97RtE$^?%% zoqJbs{jH#@Oh)FKCq@F^{HZl0ppXZ&HG}nIpJz)v!Pz( zeo3izTvqKDJE0BLr$LWdN65pIJLx(ke*95C_xg*{^NtYfp{;=p7 z(gxY$aem7iw2!*`wQca1=X&v1vUKZ;tQm4c-?=J6Is$qDo+62TU3A0MEEs+E1qoh) zbmlbnqQ4r!+3HX=2Yu0jbqw$;fy8E?ahkD>gs0~t+78tnYF76?X@VtZ?nJSUD{1 zj64LhZM%b~-|=?mm=haGMiDmQVTM*WH;|0h$Uf&;WX9@uub8os`?HwI!Xe|tX9mWc4HzxH%VCF-+8dySh z0__wwyC1+Y?OYiwQ^9(gl_)l&`U+yUq!(G(H)!wFf^Xsf^$cy6EmC9Vz|?=G2GDmc z=pK?-mnWZ-G5&XDK=SJ#wO?RY2n)#uE{9vT^^9-i9>>#w1x3O9?kxRKZAaatUC^mI>DNe<%F^ zHeprvv`NOxgdj{BKagF)1`-oY^5;lHUqc#Nd467$Cn0W}uwlu_^pPAFUd+{XfE|2# z%c}=;Px6>N=ojQN%unv4ELXPurj6O9V?9_ZlH<3r?);|}*uDwifZRqbKScGtc=LgJ zm$qzPw1(Oez@uM37?VT_C@Uw#Wbnj><*)xyARN=|9BoL}-k32`!Lv9U&qMs2ed6ii zzVYph<=D5P{tgicfq~h)80Nxsy(PT;Rom7*$dgGPgKC~_Te1ASym62!4PA+YwMu9SN|NzPqX-6?{Bptmz+i_F1eMK0sO~ z+z?R1c0zc9mAFZW)%HN(IGEgHIgw~~AmM5f^)D~{SU*3A0gkd)hG49?XYiABtxO_( z{eufqRp<6Huy-Y9xQ18}E}M5^+tNr547xQBZzYX%n}68-O&+r^G{rAV<{@Q3+f2_K z&q(t6^@`07r(20owRYfoy!I1-GgS8(5+cC@9>ziOAwfBln~d%V7hHh(;@c{X9DLZO{0pzgP9(L(F* zyn!cIykzHDiQlaaVx2`1OQXLJsWSYmUrN%gotSe5OFLHj@6v>%$JJ0 z=D(q1jY7vyp#xe1o$3q~TE#EA``2$+v+*|kUQ_#UwG=(k-kx)&bwQ~Xc<)=S zV)m~7o9otmx&}>ZN*=D>LEE;yAvI6B@~2_`lS;oAS6OrF#(39@P44LL`I56M_L|Jz zO!dOIw_p(bEuQzzR;iqINTk+kWt9S)YcjO$8lrEu)#)Fmo)Gl-yR$K9*w2P0om4pKm*)+LNq>q@(HHYHd zeV>cu3?(*%w*Sg~>XCeyM?0hAVR3(7+G3;scNUk=Cv5#|Wqa$TtH)_WLmG-JKOW0z zR(6#jzFjkUnb>2-BNlaSlrl4%XI#F0VDZk+Dz?*yslR>>Ph~D)i-ND~U;R0~Xa0mx znYO?i!!_20TCNYgVaX>~zpoUP&uQ+Sqz;^ifmz+j?uwu@!K`*(Zm8qoSa z_BXzIAQid@3H&~GNqs3t{yJWPJL|e4&gslQi;asUn+P(wZXeHEy@u>dlOeRs9^t^Wai07fMkrD3%f*>b8Wuw(S zH`8b2YTxD>b*({i}o+aeIILI={(N$NP5osD`z(ay|rDxtGvMxEsYdv z8D{2BcwbL-T%Cg*hb^W%+(Fh)`sW?dj;rszvkO;GAG@5_;W)og(Vz&i$`r1Gr_eMr zMSEmjjqynTVXks*fi%NJ{~b|p4(+>}sAXnBF;eelOt1_PT{}`VgOaV9imvy+AtNLG zO)%q1SA-7g!g*ViE$^NUnM`r;q<{+RoUgHhiy;>*uQq_L%*iR9$;oSRJGgE4!St?e*{UI;Fm&`}XSU$NpzC?1&0& z*#7OSQ*%DL??@avGUWsGlN)%klS8jSW-AcT^|TG!wnM{QFP84)prpjL?OOWa^x;Q-wbWyise?5QZk{_@W{4ozf0;}py8F6pg^|gT z_3)E5bKeqacp2B-Z0d`Wm~~$OePx7nMi3`X-s~HaaU$+;yY7FXI@SN%$4&UKz?%aH zCr-XG>3lRiV9DNd*QBrU<7G1u85flsc0Y%Gnd=m@)u=m_1w35*47K)}MC=y}sJ$_8 z_{Ga_qJs7(t^jkhxo&?k!L}9sFde5tO>f*b)G`5)<>eB*+GNYt4NbZrc)vW3eN$MJ zRH;Zz!^BwOrI&4fX^ZNejVDEWfc?;e)LQ$g04>g(=PYc66&qd;ciPTYhltbxT#5)4FoDEPHC#8-xmXz z^OstmbS}2dN+l0p(O6xT{)Ae|-?OeR!+Lw~$OxeTPJ9Ri?j~;Ez zD*Za>GfH_wVrrh!h(Gp|1K){L_kG2*DUJEr3yb*(`o!SLMPVyz$sM}VLtAw(H#EUt z^(aq2Yn|Amyjh2zx3*dCl=961<*ly-*iCb3%2dQ6d){JIpp{!o!TDww_@hDx7J zT>gV4^);0TB9V%BUc>u(#5!hystF;L=h`sSm|_jo*_mYA865Y7&a81~8d_*9=SiJC zMV(zY&=wcba||>*wznFYgUxseCOTxybdKMsMhC zs1&T4a6EDyt!VC5<0|RZAB>zSm-g;tXsjD1a2F487sV#ZH{+#yUc*qEspV9~J>IXf)1F&hC783NRHT7!(_O)H z*R6Er683D0RNRtskH!4N=>)XWW%tG32(8w*pZ`t9N8XU1;Ehe~lcaCB>B9CjTT?09 znL0@&y<2Zxj|y7P6to2LhC5+t$aK)s+=gED)}g5gt+spSE9OHXfcN5sK=9>Ctvedg zd&{#r%d}u?g;u}3XAa*xqz%*Xp%6yR?j)dTth==HvWwe#{-gv^g)X>s-XP#4A-p&@ zS-X?_u3+c7E4pjWy(=gGrq=Yf!0qzs%lE-wEqa3$Y4?WjXW6FKI&4U`6VuJxs2FAc1M^;j;sH9z}uJ4LU|V0wc+wujHL=}k47kM(}s z@{8hQc#qz_m%u0w6}_@PSOYtVBnHEtkP#_pQ@r%>BH2CDI_IOLw`$(z5vJN4Olamn zwUVm+#S^#pw<_2*t#P-MmYj$qyZ5a1W%4ZgzL<}^^sYZUB0n$s=id}Z@UmwmaKFDK zyn6F}#D`yihs;lGeu2KrqD$ZptKdz{!Mk%xAo(@Wy#uEEVodi@iSlpn=el)R7kY9o z6eq(y1uFI;R+=`FJa+MQ{e62F{dC8In8s3+=uP`{Mym*W&Rd9nnyD96())+}rILHT zoS{v)c9xSOV;ik~pVjCZZrn1tORe?V=hecEe<=9DXGHvEJw6YgEGX6HmH?ZaN?Ut~Jn&@nSD`Tg% z1NV}ZeX#A?;74W6*6`Nr6NgH_+!;i@TQfnhd}h-Ss+v&b-C}^IPOMFrxO|aAkJBRH zJjjW+AFO}I1VtrVN&*4zd0+-Vo+snIsQBP@Pn3hM4X@Fhmhw$eju%g`(0KP;Mf^8e z2nR@)H~u=}VmB3|&PuP-J@@|Qv-=S~@ZI;m&ptc%?>yRHe01o@q)^x^E&Kh=MIu4u zCdu1~3g^$+y|cgE7b@Mcc}Z{bTK=YGV!ZfY0!slwh(M~2&NdZk;Q{%W^o z39rg%Q=dnj(kM*SFmJ8<|Lf4PzVn{g2>t`_$$?`aKloAKN-6b^d@qgtd3)OWy57A{ ziB-Qie(gV!&XT4JUx4wf(|tyyJ`P&_o#xMH1JZVD-l5OFEOEIj%^|U z(}8Z!q;9KlmOPW1&yu^StY@>=$ zQ{N|l`pDfN(D)x%+FM&Zb=EBpSevG`>6KOpLE5UoXP9nrn$D|qg(o>u8cx~tRGB`~6UiV`x(M#*}NZ|{r8u#z#T>ow+n zJqT`ZOduH`-u8x;1)BpF?7R-o;zw!m+7&=YMz zzCu3ZzFOj&UOE@BXTq2FCA=vW0@kT}`M4sxH{g8pySsM7ZG+|=0lw_6k zWbs6g=ln=&>XUu5OA8BaT{BD1OeVStuPiN&6+Kz{CTc?b3P>#~Sd=}GODxWe&Hq@+ zm(=@Jbg^h*U~%^M)Di_58QIbjC7FgQB~{38merwOu9MS~vxn|tC0|dmYfl!{4RS+j zhKw=CB~wZ=GHZG=GSc6OUE(6HHrDq-jT~ac*4_N(V!lKfGEZ@6(yC1D{^#-X`q9zR z3a9H)$Gl$hS%o zPw*J3C1hRs#r!Its%%@G=45nKW%bk6ESnO6w5rpc-&~Kz+)Os6_lQ(t>lI=F;cwFz z@uTt4emVWx-gV}iOKr9H(7hvABMVOZMwA;;52~vK{2px$p6nEx*(U4ZL)k}h?W3=f zegAr|emUJeH560(Z}QK_M@_7f8#pXO*bZ7{$jb@{#?iG}oGDK$x*+6C&XJud>rDIU z$B7@4+ocOXIOeei3cgFE*ySTDU(I`p@e@|;4>sra>blFm0!*H}>saBjb?s}PmE<)b=rfZaQc+~%y=d3RQxdER|Bk@rlG zdu7Ja)6A63-g;Wa^}}mYOC!oA|I2)VujT6366HnG0)b-Hbgv~!e^|>nx|fx`7fcox z;=3l)&nB(^^1i9?W#zt-s}{utk;Klxt(xc3H+~E5X`03USX&1)8KQw$XyWxM z`vJqoyAz-JEZp8-#b%kDj1+3JbdYVu9_77U)prxJP*?s2j2X{Mqm^@q zF1ZDu2cD63!+mt5XXZo93Xea_-d3@3jmQ+GsiN1oRVA3zCh{$ZDpX_PQP7mZEw@vN zxrSjvAD^YHnNBte7G6+Gu+hIH`1Fpz*VDc#Ep92o6=$CbO=#UHrP8`k*T$IOwz}nx zRq2HYv29@+^xPvC)ldBnIrNf^A>iV3&h5Z`dshGDzFmm>B6QkppNcVGF}bir{;Qy! zqAw;eL0P5k)_tAC0vYMkYqg4##`wm%zI~EYxuh9%rNmt7;BE(*v%8B3LHl00jSc77 zw^qCkI#m5|n_dpX`_w1zJE+(VzlfLY6IQ<6Nq1z{C)K3?NVV}Ve`ZrMg(`*DtTADF z>jPY3i;4DFww>LoDtcbj`Dw}Jf=ZWS*0be&{p@_2O-k@Yo!D6gsq< zeoAru?&=Ey$D-1Q<)$Ozn;R+O%4MoHQ|`2cO*(C6rHwMUQMoz3}q zD4>C_ZJg?!HxqkJnMKun*u=(lv=wn9s?87k<;c~aR+1mZLJ-V}bA9isyFct^A+G2S4k?+@&{wGSw&zA1mweaeIz3rC? z4#tg3(u}uHy&&tQy(K-#we-OH+D+=WH~F)*nV*xht@35KF~ZpQa`>^fV)|PO(SBcU zhC#JY6vn2lBlYyI=Wh6Z$n8&_hv%)OZ-__(+8t%thlHH2_ezcL zJFo36*UZXrRcRnXa4GyssGRonJi9 zJZRnZ^}vUrS@jy{o$%fTQ5P=9j=bNK8%K?<&3ATm9%3De8tLp7D2%pX)0ebq3s9{~ zvlN0Xg-}2k{|DDTb@?lDmElH@#itjHd79WdgD*a`Ne|w%Pg$tx3PVEroP5^thimk! z3=BJ~Hwk>vvF&o6a8ddq_Uiax!#&OSg-6xnmkP>dLnc|+7=HZzz1RXg)W!6dhs3Z3 z)2#^x4c4LF^qaE0@W$0|YxDGNa@}`npFH{F)Dd453Fe!J#}?;v=yrrr(Mr@cT}4VXAqkoD?>!{8lBGYT( zdYowIC+Gg%>``62_Pt89P%U#mK9u*f*M{|zh=y2j;L*|cH)5Ps!F)@4cvXXYAfSS_fEN&N_)sx z|IGNXQKiEBb~n?$$R38SQp>DcbK}hKh~_Xc?zh+8XU0(W?pZi#Di9Z3nkscVN$PDu zN#*njT7S=S^4?aa#wMnTQ{&Wc!%8x zdPt@KC2;po%EXq9(y#5{dy_A;{bt(EvNDy&t~%T0@ArPS?0I`-;#tQ08gfSK!D!W( z;w${F(Tv0Ho&^<~M&z10bIGil?~BtpX{0+nC$eXnsZXV+G@3m34omhXdz~dx9Ojhq z(n*8(#1mGdPT{@3NN)cw~kd0BvxCNGDBu;G?zE|S>!-KmA*<&SR>z2l-?rqk?!BtK>WcO% z{`j?CZ!ZSw3YxB=<z*Kr%j&JsvJA;BgyoQ zrPB9%@zLJ}bRsJp@_D;1z4F;@&Tl4|s-xkdczM>|eWLb)h=?Jt-HjN|l;ZwDDX3}kSY!%iVIp4_sv1CEpLO~!c`12TQV6*x_3AXIqrvQ8^q!;6 z680tEOisMF{VcZb%9Gc`#CJ8W+?23D-D><5eg`&E9L@dAj z(xoV=2{nCI8n&~d4oj-l5`t5$6;6?EB`oZ*FV^|)?>e`Kwf21C*;{XEX@b9OJDQ)% z_OgIQBtZUJxIx+(tvByjkLg-bO^VyV|6OJ$L=|8Ypy66Pj~5c ztmT>|t)~Ttx1?D%w;aqe6^@{q=QY;o)i)gKl(gBIp&h3s9$($|%A)+)#83va=~7(%P>YizMYIbqMW{2ov)s7kHCwFIwz= zc)TU~9>0AD<9m8*>DSi}Tf7tb&ZfY{x6UntQhB)ewaz|O+3BVFJ9GU9g?%-~U%2hK z*y+Aceo=d2(*NduM8 zTs0{1$~Ervj3T+nSI6jd?yX+yNaL+D^i{Do@pdRjW^R&P8>jEU(dxtbD(^}@3%vO> zL3z}iVn9Q!{l32VNTgeU;M)LeCMmwY)v7OvV`4RzD5nyGZo9>P;Z1XEQC!2!sX)H= zp2S0%b;M=i^A{F5&)>guvVX=fN9{`cPJ;Tb<5q92zlr;UD~Bqx!*c>h-ms{Mx2PXzd&#e|lPZUrBU0cPMsCblG-Q zSwr(JNBt_dt}YGTIP2hDb>qCWi?W<+iejS^_r3VmF{4bS0~fnbhTSkd3`bBF9$wUU zl534$e3I=b^`w5cTL<&N$sV$!ZST57cP>!jmCa%gB)>(uk(@%9Y#kX5*(&fsw~#qo z3&`h^labBQht`FYpCJDc$`e7(&G}`$alI)#rd~rv#sLlg{s=-e}PZPIVghHhHlvaKc>RTnM120;fV%2 zsSVE>a_Z2fNOES*jATpARrkoq#&*%bDF6NMGFRx+Nb+r*Y5bhFHQUI@BE`tbHvZdy zEd3R!w|$SvMJZl?BK;uX2W8@M^3Ye0$<-*6)$l(!LOCPJ_fWo6U;bqSg9%l6LQc=Z z{@)%o$V0zyk*}lJB@sFiPQH%QQSRZ(t5jrUZR^R%82;1rsaB}q6LOx=3ts=P7d5?= zUUuVNxSFSnXFpSuk$G~H{m&HM8j_lZx<4Uj;|hDW@y-s|CoR$cZP$DTw_^{bjUs2} z(iDC4=rs))nZTC+ZMVm2xj+9X=xylTf3m|2Nw{GRoyO+k@J$asC^{_|KA^qgiPwPFk1$xLp5fx}qDuh-=!=pLYB0>_z)?p{JwCMJV-o@D~KuQNs?Bk@3L)?!umrZ3X5c`#(rW@WlWC delta 59760 zcma%i1yohv_AZ^0(k6DP}?k?#r0qKUfkN)m`_r3A% z8~-u(aGbH$oZp(?oO69^xz8bT_Sr@k0)e6|EF2CL0u&My6x0i-DxB_(6lf?YLFDfQ zlrTWTpnNAgrsUO|dx=dJtHo11tDo@EG!)R}2EQzgr@ym|LLIKWda3wARZC5kGUavX ztE+T}Z}ntRJCRI!FS5{DumdaEP=50h9OTEldp7N*g~Pn{$kF+&7z&?B5Pf;|DLNeK zy?sru%+%`>ahWMDPLx5+_Ok)%Z&Fwyd4&-&z~~gtreQ0<=<*vb-E+z+Wc)V@?S8kC zgV4?_IrZpF`1t`J(Gpfer;9mfm^mCuE!hWxEt=dmv0vI@s_`AR8Wyfldka|A@#nM=9L%daG1f0 zIs?`zMi63dZm-5an{q!x`4$Abcu_Z$osw!D-zJEeKjORtwNk@lZ?Sc5I-KLvn^G~Q zyECffogw~O{tj*d)?3nAdnue5E|i(M6W2xU4GZZ_!S9`@ETM1$cBUp%;k$@fOhmjY zXgC^J6vnPYWqz<)q=;4Qhz!s`{EAf|J5J9rq8DQSL&VP+*PQS8#DUAUORyi^IhEz8 z>Fzcb*m%cqWqzRcN7~Exx%qmB>R$$zmqiM<8RXznS*FGy#f_QfSV=9*kGct9XKfX2 zma4b)LA^omJ{*38*RoxrjgyQ1tfJHxQvCzS#0mNsWnAK=Xq!8cw=okB#A<;*ee58+F&eYD(N+H9?HQR9M1uXaBcooAxj&F40cgPI9-R0%XSv3fzO z;rgA5_MCr+k$q?Yu?p>3)kXWa`7fLSwd+c!Qo}o(HQqSk;`bYsCVH|k84CM>{ji;z zdgc=}mWqzBTg6n?~u z&DC;&yprYGep&QCt9@Q7_HmP1k9Wsz>OA_!spRVgpp#x=hhuxtpZ=!bsH$0A#;!J$ zk)qzc2u0*jBaA%@5gf5?kXR>_HI=IWg83PZz>)jr-m*#A^D}+TZ%onT5S*C=sudnf z=z!#OMzQs`Wz|3?o}AE?T%o^N9#loZ9k>I2p$<^bQ%0Oiv#X|8;gqRrA;-9)X8Wsz z&+@=C$pz9*M7JRq;j7Kd#nWR^8m7+6p~(n-j>>Z?aALYt~m!wfbC_rdcth z$7H^0?_kk`tQSloS~*F_yB3wS-Q%~h>Pfnz5eB1UGh|rd;vG5*L(20N1+ z!36f4x34>Hxl2uI!q_bzE=+`kR4hx%*pYJmvR(Lrl=Y-czl)GHafPb3wQA$CrMkjm zv?6wIO0J^;L_sqsdMuC zN{6q=c$(Qn%TSW!2U0Uj2`c*v#Gms1-K%IS-l2=Vk@|j}5fK7hTmWJ0%Aba>qDOOw zNA;k3G9;#jf>LLKPF&G}CIDWsx__{VOVf5*c=IJ_g~#YAQ2f{!%WcBYBb!Ef**7U9 z@~~NO68i(wPi#``#-)ej+9D_v4?eX%Z$gE@P#Nzc82M~P-s|6^t?4cL_a5#ZK7zvf z`s&B(iTJ@gcN?7>XR`-`PdCSnKnWY0p2FQu@Wa){+1l;tap%F7hzRg_*Xnca;eGRP zv9M;}fW#u$s;BQOkmlRe+Thvzx^V8#O`DkzA!_Kk)U3t;cO2&fxQ&uwI*#z*l zkhP{R2W^-2z)laP6c4Le>}>=G_ljaZ{laGpW}8iHRXrBrTG~F{-v~a(zg_9=9Mw2| zVw1lcZ6$3XKT-$|9#cxh{|+lm9^Km8rr(*Tws;|P=#|L73W(^llA-Hg0^TAIvnM+M z30bSJK#)`e6i)rJ$bGX=({iwgg~hh+Qg^~p^oqpo?^b+;Xa|#zB7KkLFHbf)_ZBX; zZgrcFipnt7@G~&V^Ba5THn+MT$jkFLCZ8h3rl+Rn-UxAFKR)n1=rtGrjL(lWv!c2e zsCn5$Tr{0W2>j|Dm;dk)$mecA%kmI;zV{N2X}b?19*LNYhlZJQ;(a~IY)mI!or|LA~a z41~7NCa#U*cs_DH+Y=Ef6V`bklv;bhamb-6Dk|~-#tsQ^9;57rKW2VH{9vd!80gAg zup#Dlo74sEBQD*n)yn0B`>1XQREXL=1$M6<46-|~yjf@{?ppapf}_xJZQer4bH1k< zM*PFEQ{J{N_JcPi@!VRl@pp3HXDux@E9jfsP5vh#FYN^o(9YH}cq*D-vmF}5>>dlm zwPFFIfWl@0p(pR%;qJ?%tPCD@B)-aCiU8l`w#)r)`cGomq+1%he=KHy{ma6kWjRU= z?xD&5kPFF~fO=fXH%LAzIV+f{lvD`e)%h6$%6K@mn*ah9`0U7 zjnlhTwimkw_|oJ`^t<%E1teL%M|@!Uz8m3zr!efKl0}q*kAHlKL-T%VDcbxEm zRmDd=opPI2viM9=Cl-PgUMK@ic*dMwv`M?%RP>TNME1}%Ov~tHJShbP-)vE}poHKx zp!q#58!lW`m7oUi!%|j63SWqRZ+4qj(0QKtbO%LI&>>DuSHJ-5Fbs#8rl4fITu_*w z*wR-@A#&B$O!~j0T7XLAm%$5DOrzGcZ1>g@Q|Q2)DFRqRo-^|370E_tkrBIHC;k0L zoSL?P9BR~oBvXey-$-X5ra?p!VEIn5q+$Hbbf~hr(Xd zoYO^eE6r#*r2t92SS1{AoaZca+juDVj%(~8>oeC7$O>i~0}2)B`x6bCs(VZo#{z>@ zC#ml)Fo7k9eG+|yteD4p3_j8)z0&!j^ISuQ)}uQ zYt5E-N;+D7_5369S@dHx^i+g!-uv^pH*z8AUOAfm`@D~28CqlcSRYDx^Vp?|`SR%X zm`(X~JXe5^79C3cRYH%pYf#Dz~ob(_EEK@%8EiEmN~ZPn&|hb_WoMxs&Gqs{w1M=p0HTIuuFP1bEE^)Xt^75@Tx zRf{(7u2UPgpb_3Ebc#|WO|UmMZxBmlaga3fy(br7-53-oH_gN3G5=s~`Tm8L`sr}N)E5b%1i0Fh)rN3d^va!H z=6$>%5mt=_;SgnOKrDj8E>0&v#>~BPXr08kX?Pc#_4@XE3A+P z$zR*L^QNuHvMo~Eds6$pUM-cmiJP_YvzgqTm&tnNn=U*xd7~KJ(0RM}M*mQ02nZ)zdsveJv%Ps(21!x|^QTAvEADY!*z74Q`=hOx zpCOUI=^#}doM2Oxn1ank-K$4*%*{w<^hqRUZM-ZuOScHxS=x)ZS2cNMa{HfI&{dEG zwaMCP7K9Q%T-d*QwB3a#$-{d8Loh)0yI0xV{#UbmQi?a-J^#RVHSF-L>?@hwF9kq# za>5KINZaoL&Z90`LhTW)+L-@D#2R{3|C&b`fBl#!>vJ@W{ogoQU5@Jcc^vWRz%VNc zUyXvkg-)Z>^`D<3oVcL|$fbEeR!#FN8;NY?04HD;e zA=B9>$zcd+D#)98hNRfV1ulk|$lq%bMiG8El?>gUHzKI*OHn`NvAVw~qZ`tCz@*F+ z{(&UV3!FI_-mvtqUK5jz$ZMuxD=Oq#LPdcNtCOlIJX?jtg#~ObDq9Wv8K{`2vxvm# z>ST)DRGQE`pCc7B-zZupY|h0GT&-Y{zJXWp?9|S zwO4hOxVC2ilQUh7AsTLS(+YPPPg=*ETEh%m|Afgr{^LxQur^ekuv_J#eCb{mHF=+$ zp)3@qCYgb{IVzOKj^2I;(LmV|^l#uB(K(b{0%B6lJWN}SW{ZBSuEh9Zcf1=<5X%MB zgAfKgQx&`)lM@^2Ay=FZ8v7>}=rI!yKg~oID4oPDfwcuLoPUjK`bApTxJS?yEy@bL zDJ_hxODy)wtAK|}V8&RT*hHJ%)YFsNIM#~gf^vUWs$c{eR^9~AG)yjfobQ)lpwdNP zp_0MD@r@KTjdi_!(R*FkKAspiP**Us`%j@*X_oD2)Q_L{uCPEE&tdz$4dr2_i5lOe zR%gS?pP71F;sqsWg&@)Qt&2DjyVnAR!iAzH4|-GUlEJ1B@tsW5*Z4Vh4XhjnzlI2L zngl!CW95m1L4XD-7TZqes_$hoOkaNjSO?H_=*yOZ(JbldC#LV!Eb~1p?QfZj$N!?} zl=*4B2-y~fg4S9gVwA!t0*Rrr{5GfX*We+Jk4Zy_hsk|mtH4! zZaS>E(wj$6QB*VGSomnfA>79hd)sO&xmSJ-sAh|!lCV;Uq!)c@bxj%cHmx|`no%G~ z1!b!{=4X{+5>E0CQw062jcd(1W$E&)4D>Au%}OgW)d2ORpuT?xSC(#RopNz4ud-ig zhx6>81+Bm#onkixaL8!tqWi4l+uZa3%{)VDI=&X$>S2|R1Bq1J+ZvA+as4{LS%7zf zqgnAlUB&MRRn)K{bo=HMr^{ei@k#Av>UofN8vpg@tl2VRIm2oV;~Nwl;lp&D$!h@z zv=c!>AN9b4U-e1+qh$!9^aow93{%Uy9B#Q`d$vA&`y%~wx7lQ$wP2Z8>BkBJsvcC> zRXh)si9QDhCcQ;D)P6A(Egjc9kdxhnk!i=X_f2{&QeamJCsL45ysQqj6`Av3Z*LZ2Vj^FRlUc0kjINn}!#LG3ef(H?N2{~W-_ zgV|l+6oL*?xq`y!exZn|0d=8972BHv7jIiXO(HEi-X&g~t`y?~;Im3)Hp3K@8+^4{ zr!J`E%h*7oFEYgh0fkW3Q8HVS%}#w{GbeCslfjAP0?|x*bpL=lL5owns)JpVD_XH2 zyk&K##b+S9Xe>9AmD4fFLtIgx`0-76Ix)3&_FgPSRl*uD2!ArkUS+5YIq!E;4%n)= z&zwl0CF8LG7)b}DDK$bGD*oOvNj2FyijXoh)e(&_sjI zOI4L;jRZa(YZ>1!8wKT}pqNAEhf@^UA4hOWvtBP8u!@oK7fJGG54t+@k6v$a(77WE43?*nf@)2st z#Jx9|brIi>h$)9J*m4)*LZ)z8P!zGvJCRetp&ZV@m<0PL3U#+jvLJ4+QfJNj((O7z zoa17#@A2fn-y%9G+&FO(9`K18x~LQmSX>@ZW!mdQS(QY@&>4Vr1_;G+TGVe9Ka#;a zNxAFSFI!4qvdlIVfF-dTLE^uunIL%K7r;l=#0JHsE(IAb=SW_>+3bF!Cgnsz*if); z30?4=LmZOYVL~ysHuW-IbRm@Oh~F)ax!ME`Jp)MHkaA#gqT1w|i$VR(9T5}NlpeS` zp&WqVXS6Fb7yxyvUK5iQ&P2uKkLCnLD(L{PxRR<=O`J+zQa#X^72x}^l=BVJ#&e;~ zi51+{o5~Cv3vW|}XZbk$SguwI!W~jLyD#uF4Q?uNgy}kdL(9m&(BR93x+p+bqwHw@x;jN0oWaXV{skk63rlbFbNFnF!TaZM zBnadIu9=z$g~NTg4Piao9=3q~V_@Y4yv3pIrgp_n9ZmBpC?&#&+j)Vdr_u$P2L`D0 zW9!O3dXQvfxH=8CtAnp8KSqCVM`ZBp$XgQBPw&WITC}hDFr7b`xnZy{z~jke!iQ8O zmd>WIHfd|iGsl?o5#<(*5+%j;>@P-DyZSBfM=baZJHM6+OP0Z|_7!;E{XSCp%gZYDT(*i*3No;b7#dlG!=b#nms#A6b zA;i5vGPhX)wgIK*8gpqIc+zo)EekvR?;WVx)HUh8L6t5g8*z~7WP`on^H~t;a0lLv z%qEvb{Mv?2kM6~AB&hN@Kkkl9V0SZDua*X2vjctvlyYi8pcrhfmipPp#M+MnwSm2K z%v+c;dnnM@_Q)-XTnS7V-pA5P#ez)47yGFHVk&Xhrrr|jqdn|!rfO@Zf8)tLpD3&W zqu(fLDt?rbsK$Zs{EWX~`84tn3WatjE84JFZ-e%Z)i2w)Kk)WwIm_6PY2_Dsrh%hy zRr!$;XDCLI*_<93xc{g{J3G`{pvgp6tl&AE4IeV~WI(@jdMh@J{bH)jJJ1gY6lfJ_ zI2?HlC`FuLPn>R3F(14zTuu?2E#j?OYFmWiU&X><&o-dwBL)L+&9E~ijhI?BNk!X> zS-<*B!*UV?iz=KcHHwqt;I|TPhKgIewf*UO}PYIh$Rol{d8UPUTp5NPyuJiUs$o`@R(R z3ou3f>ca(b@&wiN#)gt<7j}L?V+WSL0F;7T7f*s<$OO%uv==hc5~cRdEP7@p$G|Uu zX{n^IWh(&sMps&~F7hTJK$D#D9xmDQ9`im2&v`2cGY;-U#YEoUElc$gT=QB3B2ciTG z5PHR8pxE260a3SP$YK~H>H^q94&X`a9qS8_Zi@=-7XcApit~(jvu{!%bLr`DfAPra zVI&W?ydViy7CUfx|bDQ}Nnf_KJQ8@E6r}lInjw z1szuOS*#4HsnpC)87AyXtys9CywFjMj_(b$cwCgGy+*&}UmMn1)J%gBq}ycl{R2f4 zeV9y<{)i2*OZcdE4f*@Hte|m*2u&}ig~Axg;82)yZZ6f&AxDX48oJ}2A*laKX8JWv zaCe0PS*SY^l|W|80Fq}mx}&Z>6nFwbN>t>o7~L^IkGk)b%>6a{R5CkI=NZ0edn)LN z_75mCcnSrO6$k2U5d58}afP|7`-}Jo@H@IAG`QIR0SK#gN21$nf1^H1p|P~|rH+Sm z_>c(@b4W$#cHr|U^vNqXu0x0yW~Yww%a$=y%*gHl?>i+Cl|uW;uZpq`4=6MkKaov4 zN!9yoAr{+{zyvu-X)4Z6Rul1eqC0x%Lrupk*@6)kvB9B$#K2}L__X~!P^X4a)WtMz zL8I(zFL={XA)M|(`=3EgsS~al_v^dp#w(G2u$h*~6Jy0d6DnfLS!}5+=yfQN7K&FobZQ{&bcwd| z82=jun0yG_uI&MMMiUWkRt}EkG;mNZ^!aROwg`XPzyz-@r#D+Oz!ia+ePmv zv&(o%p%G|NL$7%!&YQ)bXycUFn z1`}f92BN7yh{sBhex0BD5vZl2u--Qoqz1(6q!WEA`_2*I;Gqb59oiz+hw(qtWjBXJ z7~R3k>8u<7c~rUflWXlCr)@Iuv=KEVfeLb%C%e$xpXux2ex}Q{gv{*XbXU}fp9JgQ z!I!hxO@A}-^H?vF<%mMW!%Z7jR<|-zFJja4o;2!@j^0dwI?7K~1N;qf0jA)@lBjxj z7~}s69TuWri2GoR#gT&N1JchWP%69$8bAd)W}4mjb3ZrGX#wx&Sk>L6Q^~hP@Atoa zKozn|eHGCA1@S^nYV62W(R$z7piuUQl4AWkp>y!M`VU!BCq&>6+uxilRpnq0IP8)H zDNI)GK;$K_0pzPc>hR6LPhnj&`sWPcXARL+by^!c1Rns*`st zhn-cxIX3vHAZPl{-tk_o=I-ta1F*v=zY5+luy6FlKe`k4eZzLNI5n2+7E@ec_m%`2 zR1m;X=n;KK6mqo8pMWWO{t_%&x~?xW{j$bYfdhC2N8a&rPJhL5L0_abVxL|iiAp6pyU4WpONM)) zxqu-k?9-Xxm0SyNM{H-ng77>M@N~pR4>aRmKT=iX}{*|7kem!Q%HgZW_ix++FvH}D6gY;uYuJim|=pIwzGP>A?;n#@OKtIjaZ?1O%YnnD%P* z^Dj4_m&^Nx+68a4nWoY)+YgNvzax2(dKv7zSe|tSVhP8sZ+F5+-8jUBQhiiG->cV` zxH9ZAEFrIZu=nrO;IkK5mG^zL)s}c#D^oUt*%+%c(zu1`6*M*4kH(b0mGC`hv8Paz zCXu?>!RvxY&p2{YSS`Z_0?2t|EU3_P>drpGqeqvlOf3f0#b(%`l34u6j@1`Lon_i6 zK~Q+V`g_>iULRbcfZ3iRO^QTHXa^aUq-77~=-FcbaSS~Ax5<#sf*nCa|4ts__U4dA znFGX$J$cq!)QthiaC+yCl#Y`d2%uw~0y9r4|BuwUAO0A0{6M%TrzjG&Ob z$;S#-8ujRa3AXci%Sl3eo7EDdCLz5p@ACq+H|x;=Vm(c@NL5#?wuCMeiWPh!h6IUE z2xg77UAJ`Kbyp^WH^Ot|IUcXK0&jLLJE=yIZSZzy+O51g8YC+a07Qau{v^kO16JT1 z?_Xqug`(wK;v}XI$M*3Z2reK+xIPz5hJKEIQBy+Hfa11qt;vfX$&^shwl;aTdm+m= z<&DgV_SgN4M0jw8|C0*3TCD`RUK{j=DELDLFw5!EwYmdY=deFdT=xa!xFRG-n86g~ z?~K1oge>n2EJ%{{+&QKH#VnNN>pBbmfF|emuN)|h=HRk!Dc(XiI|^LXQ00;Y|-y5NuhHlMdtjmxuq z5*d+9FPr?9#W*76s}lpAlfUa7YYb$SHI9+sIS?HGDIFNL8uON-i@^C8$$xqUOfP!* zM+qO<;!k)LX}2i2Q4$+rG{B!E6V)lByDSBvmxpw^1Ai)awKMJ(?^w`4N>oLOo|FC$ zuRAqJE^n(`_qA2QT!Q|8+#8CO(S4SJ&JO+l1fIy!2+jtu{{O*nGFm$sLG~z!=;D#ij_p-?EpVkKJRu|_; z|KK;0msb6JZdwX)3Ww)!pWG(?p@5M8Zwj7dhj0JH05Ghx@Bb^WxVexV9$L_?Tws7( z1NgILKwO=;Km9=dpY1>@!>780J}mhk&9Ftc79$TMCbIfa?~NrA!Sru#I|>6?<&BD? z(7`8%!G`Su zzk#47`k;(nNX`Id-`7A2Zq7_(S;#jv+0nFXF?Q*8Dt@7zc_6{i&fFb2=ap|Hm9`4d zwCE{dIcd-n(|N|>V*$rE4{xB8C0g{!$~3q^QTYqtM!PjOt6Q++_rLwmEB^ZDJyz`f zNv5VI_sdjBF&@99dEa;?5^)UGLV&^kN0j-~j|12ab4R1Z31F-ZB6ioF9r7*e&2rEN zI{jB0_9SB%-~^=qccI_jO0;N^@y5uzoeuwEF9UZBb^@=rCs`>4LvX{9c=?+y!$uLi z_Z`^5U}H~GK^nU{;5FFT=3u;FWA}u|N$epyoBi6fo;1`Uyhx>Cb^x{GmhIntS+K(l zrU9%o_h(2~-!f)Df;}Po9$1HLHid5_T7OEK&j%@K6=YXI8$a(fkJ4)iYm$T365&L2 zR)D*0{~MMN+MmAKGem?4-9Mp%V-py=K6Axa%EUR+MqysE@Bd)4ek0j$KrKasG?C_C z28Aym44kDw2Ee~4_y#~IaFYC*_9~1VZ)5NN+7l0wEv48}oYmbG2>H9xErfzYjAP%; zC4v?{WM@|W&3KhaN7l0JhfHFF@@3g>hc_bb;*~MsrT8Ddgl72Yae~6=vn0tM38JuK zoAG)7@RtL{1QZxR&)2VW7mfZos4$*nq<8cXh1#3_L*ha|j0zbPR-tG!-#7_fw=5=# z^@`G9>(?EEkUB(@L0EA9lmP31|JTmd6GGyA;ouL6M7DoOppsdtHz)oSO%d!eY!U%& zA0VpdC=Ko|0A2StCYTw?znHY&Ap*JNMgLDkv4?O3UAo6DB2GIsq z>_1cw*XSYo1OOzUIDnWtkUj{dA^|-Se)fR?sw9Z}uAkXQA)y{g@lCnlH?+R^yFSGB z-1g7%+qQp~PlptyClcHaN#4uXPQ`j4-!@*(GWS2c>UFi*L<(CzWF8YkPKof39^fu< zYW&fn1b`A9{J%4}+rKhoP7u;1ww;{;Yop>f zv8U%GO3v5z;`s=y-)JJW2+y52a;^1&HhBI4yj_M(t zB>Nb8qMNXL|D_3-kbJ~Z&4{+``)7vt}ZVv)RT^r{!M zZ=5o#1UA$X?nf?%NnBlnnuY8rT?;)Y&9}=J_e`6-o5H|%Hxmw z1a03=UJ|mVt%UN4piW~ntSi^?i>lLP^k`JW{BmYRkFD9r&b9BK;@D264{AHts+Te@ z$wivT^yORAF7rFP2iFEKw&a>U0Q`}Hli-Dov(AmZlWV~z_vgOP%*Un|e91-b=K!I5 z>!;HT)03Nv^}99M-KXisF(0;Q{noUnr@d>c4`}9>I~#k>-uzFqwVjV^zp$p{`}bOmAg`UNes8aro$KpV-u9`J&b9{+^SvH{r^h4UF*;+N7mJ>_OXPTwx*xdj z-5K5Jj}&lPH(y&s6Rk(d`5L=Ax_j#(7_DPYv{Glwah4J7d%ZS&_H_eZzzCZ)U~?y} zmQ63xwTtriqfQ<9c@Dmvulx72qx?CqE0xouz}UK3!|MAzkJF?4ozt(rEqA@MbT{U$ z2zuB%f0f=Of^2m|?N zXIEJMPQJcQ@kxiB2dDL#<(~4@%J}R|*N(oAJUh20dz;$HSkI*LK6;gP38@+V8s6i_ z@n;g7c_EwR;_X7)Do{&K75H7BE|#594K?1t(XMo8z3= zrn030BRZS-LNteuDFPRH3se8lwL^$t? z(}`opZv^K=?#088}5=@{?> zCe1FEDjY)C9tBT;U$%gI8^o;L*L0T~jTQV$t|E@fDLfTEA z{_9H>%F%*%hLdn-5wBPb$ru@7gdK@cGMJ?^vo;w}G{wmh?7?zb#|!#oX8pd1h4bKO z!?K{SPs^9JFa085RR)Jfc|0DZ~9p2+C3vnPp}hR6V~|Ltg6h8V#Y(?T|!imK(u0WAGYt!<^QSv$==>3ik9q zw(Rsi^6RPWSNHDn>#KZ`or|Lx>{n;*Bh|qz86q#Jl`c_7zh1KQ4hcOWdyHaue;Rd{ zKif&K!3Te{zQR5sz*)0E5UsG+i{G_zPT%pm7d^(J>E1i^$3gG8hFnhSOZHQ~ASdCB zbiQq^{rd==kE@Mb%WB0jFAalp0HiTmXJl^)5*+P-_pu&l7``|$R?1lPX!%G8ucpu! zRbTCYFO-`yR{5Ga8hkYr5aHn~E-XTmp_invayK%Cdk2$EDc=ESR?=gW+_J8MyJI_rw2x-DS*-Gf}rLr zdy}1$H*+2(?dZP@5NX<4Sj~=ogtQP^T_p3#@@#FJa+RH^)QLE+xn8#mnzlHUVgJZ{ z<>0e|TOqWi*Urcsak**9vhd^gOyp(HnvNj;bxD`kY^Xu}a0_~*c1XUo8MD&7YqT9| zHxOtO_JlBx^MqE(@JMW;av$49g985Oy;Y36>uJgj+j7`;lFe~Dc&KA6?a}XY7QSJ% z`E$jK58meRZxGeLMMg)wzOAmqsdz%frcO9ouD>N1iACam5SPJxAhJ1J>ibNOeH`oN zQ{^V?wp2K_)&Fz0CH5CA#fplfoHxt;;Cl1(S7`B9G`HG}B~B0Fln0+oe0q_gc44f! zaI$tYH>Z~gkHO{j-Ts~zC!F9=R@|Xf?W6681A$mBoCUPH`#kY)wbQbMjz;XLUqW1G!ecP4XkFdj9R z_9lJ}{yTA(-nx$)+7PTZ7b^SX1g@QFAeDJ`TNb7dPgHlAjUWEI`yl65<%{FgUr6tS zjLf&;!`*ue6!-)}HNzU7U}Gcch)H?vwtDx2=2NQRlZ%q$h>vwN_lPfz1$)JJcSw0- zyXhFA6RUpHr6EFR#741kLTko$viU*3t9s3T2Mti!yTbKO0F)zTGqsGI;H8svFegG) z$5sf*KZoZwq{lN_wzZz5(RXCXDKIOdo|P;nkOv?hK(%lr zl$xbHD#s~@%#R}fe8VAjEJbU9&{VVPvDyNliYZ^C{-`LK8Fyj zLGO+m^eWdiP8v>-q-uk^@N&#{soH1vnFi1+BOgql+T?|t|8qg@R!TA=_`LtNome+t zc}s5k*=laC7N^?Tv~C=GdEi<1r`j;^H8pIJ4ea2pQ+zkm!R8dUo+W~rlI7s-%lHra zn&l;x?xwo&S{=nht(D7fOcyj}YKxflG=bopgx`#3z!>E1*Om)ME_9uVdSJgdK=Vn;fmX{bSO896s`k49vkcq>p>m60H zl}ceYw2P`WxJku~neB}3!90$qfd&`usjE+g4iY|ANgrxI&L;SlEeUgnydBvBs4eCUSdXUMKRLhC$T!%qYB+)xc4V&6(SHM08sfVmPk4OXQh;X?_ zB=2*zh}7q6O>dN(l>mmthOYEy0Y0AOyX41I)QvK~wGqm@71+3*`if#`i6&m7e$W-A zR?RlstNN&uy+(QY`IQzR%SigY8sRfx5vKM^V}MumX;Z-DK*I@fac#^Y8Hs zi*~;+NfR>?#5I6LU}ClWhl8xhFq0o2rsd}-)?6_rkgV(CE2B*N0KzaiZnjr59te4h z4M@LkRn;o?9g=4VY2UGT)@xl?hDTL$`LD@QmhOyEePtw;G#nJcWtVOr@?%2%ssS|~ ztV^Bb&-aD+W4N_R6S|=nWn_v`+QZN0h5*!rk&Ds@F_TIl09V#5O9llUvC#aeD*uf* z+AD$3PecYZai>J{4HBweG#&0RIZWODbe|YPmo#X}^XnF8A}aNmU<}-*yAf;i7Znp!SyDqPd_J!=5gSc*PT<6$7?(WLeY!cct$C{% zPK#DTN8W7$G@Ja29gH>(ysOhu&(<;8Q#IcGDJ3W8rh(e*EG9;bY`m=#7E0cMjdx}u z7i%cQ`H=GL*sLeFhc#=0z2N(y_)~5p-`8U}Cfu~+<}_M!TYA>neCE5?mk?aTP{vLO+s@Izlz(L7L(jQ@MHhyra_i~8EO+_mt9A^`06Jk zwcVk47!{P06!u)qx)&-ax?8HVvH-(+9 z5DZlNeyew}ZN`Wi!pM(1Ahr4>QoWwNT<$#5)5|Ba8yz`-7Rz5``S#ht4L0Wm>v1X| zWmL-9W#x&@c1$rr_Z$%)R%P$3ejw{x$ER*yVwRK^YpMtN&}8oAavg19JR_wH@K3_Z zXvmMh7bHwK;#zACYEQ3SZ=PDa2ny!}KYI<(SQQBfTU-8+nNoK1o|zDL;T1+qxf$gr z%cyy#L>e`!g;y-!LubeMdGR&sM^?p^3?bTFnL>Gl>5oPUpC@L*Ln&BD@3mdz+s{RHP&i3^_=$3qOJ=;nrk$mk|IA;9O`!yUEmJu(7PG{Nk;q>zvYTRb* z9+(EwsN*HOk8GN)fr&Y63n9GE{n3Szfln1<9WNU9JNHFXpoti;g5AvKw{> zK}U)^$7{Qwie^iarJ9L%T>KRF!&(s?I{MYy#S8d3&P+eo^s(YBhjDB*WV>&vfQzrD z#qVE7WAE^2Ag{j#EM@ts=RZb{_3$sBUMrmF_zWu+UgwghFY;Np8b1)HX$fhxMuto= zISsraw(1k@p0Md}hQ){<8a!sOFV9Lcz+v1#sDJqp@4H0>ogc5b^fAkJg}QhIzRzeL zbQ4r67r_AhC%xxcO{Qq1(4G&l13)4@(z#B3(g_2>ClSp|lMiSp!;v9+Bb(8Py3HJG z;%(%mA2(zB;(KHb_V%&))oyD;Fq(JZH8{8x8}b>EdP=6gc6qrYzTL|gE@^wl^@LgC zc5&Jq7Lp3j6?+o?t@&#;o-Eq1x?RURrWjW<#u=v~dpb=uW)*cJ-C^dIV0NGzUP5TZ zyMZ3zeI|16rQtmZg;celwk7bk?p$|JbfWUb+)ezg0EA;Zy>>C8rfUVSf39Z{2 zURn=ZOsp*pn`UFg)fXJMVZ#dK*&!S2`kLm&S;784e8I#uP(YexZAw8OtMgkN&0?W$)dhFaO2An5HQW!brWDo`Lx#%iU}FQ zr!(h$;^+z9SnB+eOkZ+E0L%pnJvW0A#+6q7X|f|uwQWpUWDyn|BJ5Ee_xXkH>tvk# z_pAIy=5{-Ub2qe4T%D~ISo3`ISh2*fMY|X=q?YC+r7gaaVGISYr1d$m8jeLW;N~4` zh$BEZO}idqYx%fns$m!sMoLPHC2BB{C+HV{9;ou{E^YE&lK1oP@oG8zM2*`z(6nYNKk%Ot9#V z?cr3Pz$4tke$DzkI0=Y5^QZvsw~i)|j>?hWh^6;Vz)_>oAyJ{Dz!8DZzF#1W|0nSA zY!~wvl>ndS%}mkEEb!5DP^1`xJmq}!m=@quz(azA#0frA+W&aVgcca;CWO*U)U|#? zl6g(o@r6lDf&nWxGcJS!jz}hyUJVcjXEU?nLX>I#J@!8tDlj}q{Qu$pPcZ1!#6yAq zTph;B`;Or=ht)T4S@4CWy#n^P2uCo?k#iGdh8znRw^7hgC+;m^j*{}#p0zMMp--8;Yu4B*nq zuL~ru>yR?O4Ubr0zlGIse&JYjElcWWB%Q9j#>;VzUj_A<+#ofG0Ec}S`4Q97JrT)4 zXo9J+tr?d+&Y|2PnNfwEMjmc5NjGVp@<_@rgp}ib&^zG(Rk_gORGh0z%t)F}7xOcd zo7RZNy-|+w(xzK}$8swCw)f;Dz(y}8XXQ)q53VmS&SqO5=zWEr=zVW)x7-}=2fy+@ zUJNESpRJ7ck}Gtb^hQe`V~E`M>UZzuuZ)TSy!Vvy!ej&D>xsrMAJ3KW?p?fZ53Y5* zdG8sQ0UWxF(N=Fk!49UI`PJi<m;L#O=Z(ER07=%BQxry{s8+oBX*1SgqC78R3_7pxQ$0Ps-#DWkV=Ii74>yd2 z-ir9p@tX?sbCEyT3i1cMPl9#vFA;yv<{vo`A9K0Slruk-{J{>7()1VBx8EFNV_Fa24h0ivLB}SAbQuefugPAW|xwV$j`F*?Z>F6PuvMPUn8m@-IHpw3>7OpV=UCv9=&ofMDXZw#yxS1q0!DPk8_dPVH-VnsOU^u37R%rq$wIF ziAs=m7@4*VufGqIc3`<)iNaq}__7w%jWI^YVGE&)kG8Um(c#D>9Z5(h%3o%eXmwR& z?zpAjWHwHBdi)j~5X#2rTq9{WKY2_p9!XqnH-m#=kDLF8!QdPuva}&UWd|^1RRP;? z$8PC3a_^7OLKH0PnwvkW7l73ARVMb!kGdI2+{4Zvo&Iv|g@5!VEQcotEj=0b^S3!2 zm~@wa8GMnO=`FKc%YS>fr*W4!{9ytO@(QgxN`9}C%9VdsfmZytTgq3JX6_#%MB@rx z6Op9RWjH$F(HcFW4ms?!B3Xl>iVV|cV|tC!{xtKkz;$%g97Z#vjSf|sB{;>RULbxW zPoMf+CwHIvyZoRIU5~Vk0~E#s)s1~#oQKtaKBB$%wUT2y*Y@?~y^wq6+ocT=%$4Gw zVlGdQIJU%%uW;o3<@QQ=9ZBwF4!uc57O z-%Md;VfT->8bXoQ3XYmjTCFpcoZ1)9biEUfE5sY;WpcJc+m3wExwaweuwN}n%9Dg4 zn}PIJQ*%U3p?rD8Yu6%MX@VBdbA09H*zD{-dy$w z0v};+V4&PVSi)`g5*ZqWmiN_fCcNK8y4DBaEIg0;FcNU(hpgGB(YpEIJQOzEHF;vp%?)z?@ zQ6T9~aYu})2jRgGW7y~4*i91T&Kcg&+C!?vN`+)@7Ae9oS?P?mI$p#hpQT+%a5X-_ zRvz062EMIu!S&f3etib>c5H-huIkSma-OG1zI#?0nO4P)6E7Ka%R7IG0ZbC(j?dlE zNz*FZ7bBAuCL<%N$)Up$Kh6wpsHK3vsVDw_Qvx2wo~&jYxw7pURV9Li9FAjD`Y}_$ zES`5Wy6EL*uIx`Mo9oax4q+WUU*q0fh-dNU?S#%}Ig*jvAYw`Le9Fx#OJZSeJcBcc zmQwz_)quaxi2d{c8tQ5caC&_VX^7em>H}x-j1l zCst2!P^AtzF(qbeqCh|4vMDmrEL?Cr?W_Pv*X zxe7B|HX^F7&DWV;JRS9~q!OFk|qb@}av|Y}r{?wIn2*`{5NOZSIcM zhm|Ftx!~U4PMfFoHXbhGZLCAn0`f-RaqiI$iicW+LZ+SAPx;h;-yJf!2oA+Zr9f$+ zHZXYpA?ta$9A8Abw8(rVN&-DD|IV+qUq4CW23gs^DQk3=lH7c@+xlMfn{(_7MuaKD zNfJX5;>ichhO!Mop~^wAT*7Yc%x00|b;?&87oL{^zIQmpyC-vsa$3d=L&k>+DG@t| z?svD6LA)%-w2YFW-wdpnZKE(ygpmw|(e)vT9R z5y)02o!h?NFaf*sw#IF;s!O|hr-*4U4x5^nRt;p8Gfyh!(5H8zVAd#B)^_UFeok52 z(s}kNV@_NV_76t(b}|&KxF%=Nr$2jFEw5+O;R(~8aV2AugUVaAvcqp{+>R zvWiZAjSnGK{&3mm%_e1wTrk4I;}DqMa%3c(h{70p zv+H!Vx9iClgSqtxWu4$#OLRui$|-_Vt*-<6P}3_Er?tNb860FF_Km_!e1|^7@(Se% zDR&X!H~mOVabBBd_E#OpuTXGTHkzPVPsbWnj+*|@)kEB!(skXTW$giYVR1FOzmF#w z%p>CS41XWTFD!xLaxuQS&#x|hu#@6!2))j6Gozo}Y82_wYMxPVpTb(5c zk983zs_2;cJ%aY*sUQ`?8!rRq6852phfm%m|E~Ns^GbaG;JzS}obdLSU>LEr-IGLa ztzPU~3}1MH+A5aOt&8^v3GyE>ZHecjSO1Hc30-v&<}38fXcE15D^9dWU-&}rJz~fHv76^5{0vRuOM;PZ_v4Km?J9}b zb7USOiRDCniGe(kKjhaG#UDJu@6c}yIzFbT`vY4XR7txOMONNy%un{=6a#Y9!WC$Q zKi8DA673a9fgc(h)le8h%1wh94h48kPFoNCrR8 zt->YoT@NM@a~Oan-oGs2ij8KJk~&!Mlc~L0E7{vVgS%Vaqo3p5WkP^K+)qE?Ro>p( z^gb89py=`EF!R0eMPlPcju+88(J)bm8ff}yU<7^x{W%`rsD~(Jx^uz-)QdfNnJjUD z5k+kH^ukRgU~$Ab%3qmimm;HHMrBH}y8h%8`>5Kv@GlK4Q!RhA-!suzea} zQRWHc?mfz;^}Xpczl?h{rU;uapNYvaZlmjVeFA?@OY+@G2TTMEaLjtpot^~N9~@~@ z|2HP|mn!_LCjZ3*hkMUFQG=J zI?#OWy_5oGq5ygYQ=+Ogy11u^^vhkY93494wsM@6Q1>vPs~M~BgP+Zy{muF6vD)Jajm1Xf@@7`J(>uo$;n z;&-FQJbWeHL7{;F)E>?QWHQg|Me%+ww=cCzt8p^@r^qqK^&E5aLxLvtP3f0=9MLai zX(4iUz`6SUe@)fXPwV|2cHqBu*%WWSn~z`r@cj(66iHSc$@P1=_CAG^ZfC0f`$73w zi_QigP@|-paYG)ZS1Yh!>075Cv#*ueZwGI)Ef0r5Yt9#nt;G#8X}n3cuUdDK?{URe z>Je2J^%hbPq#GNS*6+GV$v_c4Gy&>Zb-xfs2h;6qGS$j6k($;{*!FntzoLBXPR97* z^znTe^w$r_@$2zu=03gc2wYvtTs&@1n4b4{VL_}|j9W4;9;eDwIL8}ADCpqAdar0D zaM-?Qon%PQsA;<^o?40aWYqD#JDZ34#=YQamj$Xlwmmw#Vwd-B9d-7Qk=Fd3@%7B# zIzA=s1oySxw|s4hKHw;Q`y%8yy`HM#aE6SJ0n=-G%0Z!gLdmO*0&vDU2~H8Fs{NW^x`nU9N;-nd}Wa&Q6t)g0b@jjLP9B6mLtW73TqQZeO_y zhNGS_=l9f|9|7e|U%Q}k@Z&tT%PB36k@th+DFM|AqOce(1NG5?<4Il10-}vp1ampj znXJ_9o}(hTi_o+i7nmHt#mK<%v)Kt{Fe5w(SWWwuI7nR$lJKt zrdlbYXI{>a`>XucRd3Pue$`2cB`PHij2cnUdmuAYE8}{66a&`aw%ay#JEZQq@%Wd{ zCRO5Y_$uAj$gHK^5|a03hn@;ilWS9}wp2RL=cOl|!t+n7@9#b2oo@1qM-lDF_pc+c zxT|YG&_CGDUDn3-G5JTnTn2SCS*p|<%4sMrP3rd^+v6-BZSJl+jvPV?II6g;Hke%=9Jd zH0V9-Du6fl39vi>i%o|HJtWQQF}b+7-(#M#UK{D3U*-Ae?X@1BejmZ?Q5<_ANL$vz zTE#Ia9EZ6h-5$H_k?!<1BaPBdEsON?`^xu;%4UIvghMZ6=*n6iXXdU6>Z zzSZ012|k~e;{-s4^$h;Han_Q$Z&zS{@%~~ZbjC)tWVXlWKMN)iyLaDiMt1f=6NMgHii$CGdSaUP#7)sTMEIARQ zR8|_s^E7=F>$+epabq7`V{0@j$Y42-`7@JufK+aaO&4ifw z2W`SG>}fjCIzl?GeOJvhObAcH4W<$>!wIT;~qq z#jmMo3cP7PRoh$<>c(}*eT6>V!iMW%yJ6Gnd^eUgbkNJBt0Guid4N-bzmJv5Kj^)4 z$0V`#OQqI~e{1&)f0WhcdY%6prS`48$L~gx8r8K)cuII`Pn|ocUT$q((>&L#IZATd zn?~tKCs0LOVB}78>G}}eF}L}AQ-q$K=zLq~+G^xGIeAn+l&O6UUGBDT8k@7QGH-MR zGq_G4;Uiui5yr?@D!EavKvCoJ+JpR}qKU~35$%xIBaWB3?BHKV`b9Ce_H)nhb!P^r zI{5!MZ=kby`mxA1cp3|y2wcP=pH)U>n;_a`b<=3*`+Zu}%hApmi+g&{gWPh2=enm? z+NwG0_o;CzJBg>v~-6$3K%77d|cF`N{L!{-QnP5yE4;fu@fZ5d2mwJI+tn zk5AdPf{1CUmBXkwmoz{^)w-itnU8htJdJU7+@GwhML<8vN11MI1zk5afz8iH&?Jze z{R|!b%|IVvvj~?l>Yd9p(f|Up`~T(?15S-I^9x}hzc-UefpeJSM4)H!un8Nw176ZQ z*ayfB6u@+YZ1WKUsQ>ZpHH;}5ios8imI5OATm8UBJG10NXOY=y!v4Qz=c`Niz%56= zyttP;_M{3ER(PbzFh3UKBo@L`6(oXztiHvO%QPi1qGQvc)p9n~C*Sg2i7|>UN4ctX zbbt(s>3pVdOzR)XYCgYG7>JzSqDj?|x=?cbqn+l4xq_L6x$_C&{1H`AUqo9Hkx4>~2re#&ou6 zAB)}%R8EzCVB&Au<)?$u)7rfnvMOKUxHJ2(1xYGe_M)5Bv1yz! zenGG9TfBQIp^wNf&rCcY#X5B>0%siA<=aor#wY%jx5;Swsa*S97aO-(aSdU;n&r$i zS%&wb^;7}j3kU=iKxhIYO%V`WfDo~>n7v&k8f2Ek+j7RJp~JXm(rN2s>E@pYHQy~K~xaN_FvXA;cniHcKzcDl}^ccGz{K_j-v zEGbs$w-KWTzTPKsXM9kYB_F~pW=1WMcdWFtkM8140T`ce9hVYW&efQrEf=153bT^7Q1yjqFVA{+Bjw;)tjWNkLjUG!j|t!M`nCUNMSdo}&QI4ks{SLHmee0GY}X4M`2_Z5h<-F9t15|dpKQz0_NJT}mBNRL|4 zv97AtnDG=8d7#d*TJ=?MKVsc~I6MY0<0?@Qd_T8bARyMRKYX(|b+6l~aJ zGUkmErJDM<<9rfqS%KI9&8oc%XFAlJ=;guxF8yQviY-6hQYAF)$R1td&KF%d+Futw zAUHk)mKV*d&O{fY4(Co%ceME_<6|55s9il*&K2P?sE zO1;XTgS75|;4~mOzc&be7X*I^f)gTu;8@hS)1f_NV#NO~6X;)w{vC$V9mlfwf0W^G z>7P1L^l>NL&P1db=UkZO{E}&jvcSG&QIOGG6V-g`WA)8uF@=~WQFu)pE%QNjR5Oo1 zVA-Vtmf@Osx8y>`8`aom(pRoD(~$Sam_O8iCZt`9_vI@QX_)?3B8%PMa!8wR ze*8zM!xMjnr!%h>G+uMbbDIu@;r#dlSi{tS|I;rB>5u58 zfad&YIo$?DUh97+OwnMxDBJI}`3OfqNHj+fQWS*be*;45!dWDMrSJ+qF?lZF=pM>N z2F}j&Zb)(g^II*P`rimV%-_;9)Bm|THzoWdN~h5vwXzAYE~+K(eR%?Y7-mk-^|tye`RZFZz-Tu@OOsJ7Wv?tPWv2r29J4vnFRwd5E_fH~b{h&$d?g zY3R}ng)WKpox4jeb1w-x68M|BX9w?t8wQ!pg>H@)m4{pTFNx*ok`%~cEV=NQ5p5xhEy)R$opT#|O>c@~ptw{tMaVSpIolAX_m8in2$twQM58miZi4!vgRldveQd%83hVv#Jy zIqy#7J3lDYM0}=G!zj_{l=t!7_8HA>7>5!Mul$%!p zGiP9S3d~R_buz0INQtdlRFP{2LjafJVWFl9rB2P5RHM^n+`H{~c3@@(%*K(n*qtp< z`UYEMqeJ2m#y!}RaAJHHJgV1`QV3Ow_=r0Y+^w>VnY#j7DHIg%&5&w4)=$>;VD+5&#MSS^&lYHUX|5 zc8tZRc+m5vdeBb+xTSf}6MglduLe;2=0Sf35aZC!rQ-YT8=EU1W5{|sgIqjTK!ata z%sRE-;$s=qw$TLa;2us2oN;pzYQ_;ia8t&+sg>*xMIc-04BYH`f`=luxRid2`;w?_ zjxpH5_ZTT~RMdcK5l~eJs^5pul(eM*5&A&H_VTIUV)JWoYeMiP8OdkB=_{Za4m5GA zXji+QU%RoBYh7NR)(mdf7N&D?u348`ukxcVp}oRxcZ_%xnnNl~FwX76oNs}o3u*MD zHdhAU_p{wjdzM?T2Z*G{s7o6!u-iG_KMJM04^+v4Dld|*hB?q|9(bUvtpbR6Y(HBJ z3e=@;VeIxJAK(-TXd(kmR3u#!EG_M@v7B2%(u^I$&Uqff=4eDdV>k{7c{C=s)f8;D ztfiZT8#wN~JRgH_NLJJpY&_;-<@pLLGUkJ3<9$S3&C$Xa@@TkS0OR{iyibcGUx8SV}kTl>^2UVCZVk_U-f>v6NSH$IkU_1v-Z$ z&#~Zymw}TMc&JTyH5lu_*Z@YT84#_2=m2LyeLHl2M0<4quK=PB=>AIpzK-brPn^*G zTLAQ(`4qQrk%=x)1IPim0HgqP0{j9XAQ#XIY`0|#OR9T`AT0VrkxMMa=U3s;2lY>)n<;9quW9Qm{V80czDg`Q{DFtq^Vf9b$| z+tyjp;@v}d8C}tKbXZOM2B{m@RjM4{RqB|)wYSvNT7CG3ele_5zjzs77vQv0A1X$C z&$4OxiY&Sg0OK_oo8>{BO@g+7Y&oT?ZLv_7e(`Gn1prN;C?H7|9R@H1z#v5y?FrBa zKq^fZZ3$4<*HT@|p%5HHiNW|&>2qU2` zGNA7Z^s2?k`kQXa%WnN~_h%Rh0?`3|v#(o>u+nu)VulJQ6-+0#^4P&y%`G#KiNoSp z&2`JIAIMIC%ooVofIkD^j}4f{2PCb?2=O^9Zzl-A&f^gmaO0=TEDXqYfy@QS_(_xNzJ&LC$#xj`XD*fO4(|g-MeIQp5Y})Gc8eDV%(0HnD{QChtSUdHx(sG$o+#O14GDzC)%Q>hDc*n~T9e3GVwM+hWuJ zEXIcmCs#pgdmuGukQyIGf~O`~&FnDXtpc7M@WKteBmyteEk?T;x+T`Yq@<54d%evw zA-sPUWPJ^?4g^_ufXtRbX7;>-?!2VQ|07%If2KQmzI?EGnH=6v2C^cDXQgC`Kd?86 z1@gWN^7aR=L`lgn7jmjSKY;6gWkTpmTV-NxlD4Ibo(S0kO&ziaVcKM@eYh|vGVq0a zOyG-`01pA?J_o+Y!4n;;F5!PlRLuX>tq|fjm>RK!36niYQYL%Qr$qMPQjzQd1AwLi zx~lod{m8Yj{YaBQFunt$8yM}uXbDE6{YVQPMl%^BRH9h=r^NqHU>DCe8c}LIwbZuz zHiN6Em8NQM%fuVSI-bm@Z3E6ZYNg3LBn<~)!f7?Sr}Js#4{Qc;?pB&=y)}IaHHx_d z)=R*mzFWEW8A+p53aHHio-5!9->o$HillKUkHAPodmCT#)4Px{iN|4j%bW)_<>+Xs!R&&>h;Vn*O$Azx}#n72J5SUn$GO%k#ZN$Ew?>@cuSBuxjy- z8q8!7AMRJRr@ISk{DOwy?LAEI*B>aUd%8D1-sa%J_yKrg8Q!b%$XK#xknUJ*jt8DN z!Jc8_+Y^b@F3Z%ab(>om2}yZ5Vpb>%paP%`U<_al;5=gX?bJ9^FX+Hm;MRKVZ^uOM{(3T$Bma1IdK_^puxgj_&K2!tWP zn;6(JX<#F~=`e=4t?lDq4m>gAn4kin17HGR1KL>8hvG7IHi|1s%C(mX8P-egalPr^&dMu)?V~0Du%X>C+)KYMo=Jn1f{R5>U4cWQcM?e zyrIi(NwfQI;K|a5Yj?cs6Sb>1JPGv@$-AcxRt0hiO0rc16UiF2$>{knTlDxzHE`5> zR2)Jn+eB?y;y<;Vn((SZr9xIolrcY6?o}PST2i0Xi|<4w3Fcr-HgFZoP6=joIB#+a zQo%%)`Lm?h0FDe(H8nD4NSb#Hy6?AKN!5$J)=j2TS%exgKq-sJg2D=W05H1CeC>&tsu=nx#nD>K5*Adro8u z&knpe)7WRB0r8J)=1-^w+;V!R1!aehT?MOYWHLrgBH10z*Dko1!Mm7?Hp8FEEI+ph zD2zK$d9F`mDqef`AY7cP)L*Dnd$dQg1teaEM(PO?OIgv)u_jHtbAO{19@Ao4bky{N z-)L{<=bl1Oc*6R&3CkMZ5ku}73Zc~OY#2%jxdk%{6bF%gincqR>FWG&&b3K=bv_r8 z&}3nw`6CZMKTMamq<}GM&I-GImFsNnhxoE(5r>OCAL(4*Hb!3Z47z}QbsXx(HaULM z0&MRvOyDR=!27iGYPGm}uas>md}xz2N9GW^+7`09mth^oxyE>1Y=MOLAe@M^;ddlS zrt{QSD8#e6QWW2LeUVIaIx_^tVQ_4O($=fC!Z6vI^lHXMFt*n^NB>$T6W_4t(p56( zk=tpIm!KXMc~L^dM9<5u)hC$y_X9D4%q$6)?`UidYwrxSX;xRh#6MYIyscSUmT#H} zEAYykU(idwvI}I~8EO-#u9U^cT3e*hAc0n-AO#__hPFI5cako_aQ#mh(wx#($s>+L z5muA~=80Cx0}4W^nPljxS>r{bEZ@E5Q7?5+rR&B_lSS4PQ2Cm$mA%dQs?S8x6!o`s7c*?+`vYh*vT z7`icU0&+{F*MG~&;pPE}|Cn=*)(VExY;W+j$hjIH*ao86W;&s;?_A7P6|5B9-OUL+ z8O=QBEz4n-f250Y*Xh%l<d6<;aIdZ$OOz*yF%{Nu!d;vi zZ!22~7^;-Iw^*EmJ?_nz&(RUxZm5PGqv>CX=?K~8RmHP24*OJYnGubT?=eX?tk%mY zN;gd09J_9g)i=kSn`0t4hBbthn;O+|j%mQe?2nJX-m#3~t~A>9Z#rVGtOpcgK$9wg zL1SwZM-4N&6^btm7iHX{jhXwNZ*D9Q3k5W7>)M{BAy5A)?MC#>qfne}__RZ-?~ph4fAfZe%U_SyPNpqT4JgwxBh z{XY9bYHN{45HtWBT;VQDqyEHF@8RmNORK%>eQ|6ad;6*urkamwI=VZb7CBx?`>pN@ znG`D@Rru1&{Sw2COas&BjBophYt7Au0d-@ye0(ltx5@v}_l9vT$oB_|ig(J@jUu@Q zg3lQWT+z$s5@mxNu6W(lM*h9QQ$yd~0%Dr-;B?d9jAfciNY-Z;>M-&05oSMmLGS|0 zcMZkYWG9>%HTuaD9Q3p*+2%)1%t13c*nOlAk#+41g5ioX1g&JqMdUyn()>s&99^C{ zXvGW7m%H&1rmrx&voe8SSClGmK8s|slkzshFpFA-eyP+THRoFX0JkpAr3r*Xe5hiQ z%p9C#f?`!IyBJs!0xWurHjaW|Gew+ydvRnG{h6 z=MC=;YSFG#2{ShYS9 z(6@4sX%umXG^XhhR9T~$e;^;=oGfjAUBG69kP|115H~CPaRXcIER4w&iEocz|H^bN zv#j7fX%zI*=Q_7yZ=l6Hci+XTpWE@o+LbRTd3@KGTc2{D>8UNZfv%MHSDpCvyWG*rM7=V{tG@8dubn9;X(qRgjh41I7)r)M)a~U_u9JhZ8EtjjS>=7b z>MCP*-a=a2%2$aFEF8TOkL#F1+-><=7jG;6<{FcQ_8nG+6ZCR;X`6pcx}J0$Z4^N@ ziuUAZ`=?%y6z4kK+K;Uvod_Ei4O=SpVR<*FcmCPwhhN+!*BOWwA6n9Q>PoH)oqQgG zx)}^#PRKg}$)qcwRREm~Xiq@PPRJj_`R;($1~i-x^p~Gc$YTONj|-sX01fy&9>EOD zE#}Au3~kw^{Wa-|So3$4p;^IN7pV#PFRsgZ&Sy{QtaCo6<L8V!XvI%=@8rkCgHkk>_BF&TCi20`W%{Uzni1M z(XB5wHwNB&e+;xZLg-)yQ6b!^VHzZ)v^EW{H(ujUs>QC)fQY6_U&-`{38{3 z!+k_k-JP(l_FodP4DGK=zi7y>oy>u}BfMVE_PwpsI61&~!w{T|+HIKl{CxFg!~Sx^ z&@vkpkqfRA|2HlOb_Eb1~=?bC+Gy6RR5!k1IF^_DF03+e&ChkK6@e$Qc1N5kzn7iHX{2ef% z_TL!vA7qo~uqrAJ$gfpy{khYg79kB1B=SfwYy|Pvt##~Mw=lq?zFjPs>>XS!4DI1h zeBF8r9(c@+?Wvt|{pgqGSlb5%!Vkey;qMS;+7P-BJky^^P&9`;8qAtWyRH}2wBWFm zhe;FB7kaVqQ1&NQ*>F1?I(5X^%5DTm+<#)M_ry0yYDMuQ%h@U=2ciKxS_lan4fHDX z_?xhGG#B(DY>Lg!Q!ZrviD~uwohRwFd zEl(ZyF2y>f z*zXjk?iW%WFryaSs`pJ!M@70v{W8xW zJ@2DL6OBY#;-WlSuR}H_-`Q=b(a5jJT$5iAZ%$_yP1M4*d(_GtY@ZJ4I5+^-2M6x6HOQQZpfoZxLo-L;5|yHXkkp$r~DcZfKY124h{ zv_diUWtc#2|0)&%l0*KQnd&m>ZTxD2>nOuGqm zXiF@sru|~=b}WOs4xy>TkkaI3)K{IxIW)%lb&Aqe%*l-WulhYQ*uLj~+pN-BeVQyg zAJe~!_-PyCp7X}q;?>HOphjcBj*0$Z%+3knVf!VinML_WVe5TgI%4L7nWDP`Go-zN z?VQmA4DU0ny(~Q=gms@ihIXfxln2U29jo5Ii4UM7*1}mrKGn@}*=jvwFs+U+$S2!w z%l-W0I&tVaH`xJ+qVJ>E{c`D53g?BypWhnQGpsO$+SjGZ^J1W}1ie1YQd<9T*^CEkTqVmK`Iwctj%KfKKs#T0P90(x-()YP4`v}0P-*{I=w6eg8fuJ6W165C|4 zk&v}pxfxecyRQJX&VV26>Z^wjU!tURo!=AV(N#n*B6`gJStL^D%5Fl05CFt-f-J;;&3N5kkSqvZDqS5MXwP|^E*%`ev=7rF$Y;L= z2CnyYRO~`fUD&Vf)h{f9muH*j&ixU|vzM1k2fNx8!h%AO%em5T=ydy%Tzls$3)?m46KCY? z7ab?Ng3#Ii`gp-yr;Rmd8vp8Y-@dr`*+Px>Y!A9}NyFL21w8Ym{q6pko|dDd1oC=? zhnLAG{g4;U)#d28EOc=Kt!g)19bPQ7pg{yo1=@KH&Dw&VXE3y@et7ItK|K#J3^Xd8T1Xy*TdGZE6MtezCF$5hPj55jE33k-xnJ(tJ-r{mo4Mhr|bRK z#}`)x4W6IW4ROqK#ZQl8AOS(hm8v1YbbeI+z`Xu4^Xl^8 zl1UpnzdE{*j_>H#Z} z1>uh0`$yWF1*IQ0NMtNh6MyasP9G&~F6(xUU$F#uqMy2Fek8+`39IT zs;{$MDAlHhu%NL6Zp>kl6wjF(f3H7#!mO;zlNEPAgD*eMUHzI_m4)g*JfjnuiV>R4 zCvIF;C$y>K2-wJ@IB9k3gL3gbuhqO>3qw)r;6Awg9w#g0b}03*`$AShAs4(TKkcfX zzPKz+{kbV2CqD4?9ufB8Pakolnb>lQL$)Ud()}F}vvsRU;IhG4`tn7aL&XHz)s>@Z z_#v})*dXVC;ecZa(OKqp^!o4lL9bs1LX|TOrkd@W1VZ@ax2_$zXuM82uW{*}+l7C2 zZ2LMkku_+#y~R5~w5FcH`P92~>ARTS<6GtWMPs1tBGy@)=?O+i(}hN1Kvs{>Zt@vg zK$bN*G(WdC*0Yfp`z%S7S1q{xb z6Qa)aVkvRke~#s};Vhn)g`catA!+b;T&s#I3?-?{tJ_jDR`z5;8D7RC@or5-8D3FA z->;2T*rmL#TYt>%IPm4hUhUoOo!fC_3`VyZFoRT6euh&rr)t8Qw95xFfBgdAVMcQ5 zfa#{+El)KNuJ=QZ37G+po7HhIthg4=G4=7`i+_akRkQq67JCy}l<-IUs);1)hC=ox zr&Jd2ne*_?Day)Wv-p(xa7t8vSM$d3n#Qa5Rrfy3+;)Cziog^s>4e3fZ=R4sH9=SP z^{xoC@WpR#49Ti7W=%KXalI#XEl|CuiL-l0Kv=trR2m!Ye2g46eaC7(#)R)%r!{$Z z?7Q-o{E6L^Q4Q3xwcQ73*EnHhO>xS_b0W-Vr5yIN&sai%3=)Px)QUJ4TM+y9v8D zF)HO0Ce4HCKvv3>?Ls;{eiII9xe#QgR2w;H&;)_&QEw@!{EJE~f6C5MQl~aQl)Q|) zW^Wdr;o#8{NzWq(#FdK%qo1UP-ZkOd3dX=vlYTgo)^g;jIzQ7FjQnuz2)5b%xV6iP zZ(7%1fnShjMzb828uB=z@M|j*3CVAa&f98pxGk_8Ifqzk-f1BgTj6rp0w$gGyjb8Q zWEI%q*jG89GRiK@z$;b6<$^=HapZwNv27FhiSk!ki$z7tQg!)Vx3m^d>M)BvMpUuD z_h~Jc5AE^M;Q`a{)~?wU!WL{bVMqdly6}nxV?GoMyjjLSa%WH98O#W(}7(zhewYtP>F3H1HiuRo2_o4O_k?_A#6KV|-}OT_J$ zCMxE8_gJ>q$)yb5YW&T6udBwjx1H9~)@Hyu8v1tgNp~M)R6Are}=bP z&P}al_Wpz+`FpM5ZoG8C{^hNm+Wu9UZ|U=8t?*~KvoJL;$xTn+)BUHXOa5E8aSzmh zel1-~s^%jzKvg#6qTpkvbSLbYoHPKNxX;~b)2eU%RwzmJlJ|4C?fCiRdc-tGLdc?e0y zA$Du`+(BcUQ&`sFtzCydD9OuU%oAA~rdJ~-#VryKxox%G{`+a*Mk5!Tv_MT8u*<+O)Ixx=1@SWM*is8YY~|G4p|HYhHmmUV&X^+^vSvZa>3>ct988!+G_9w zEEAauy!5PZ&z+qU(`>7)K8nv!01bya>ac3jH3%MuXGV?F8BNR}xP9Gia{5KmqZ@fp zD6jC%Gu*MmK!ET&1$mz$XXP$m6^`lqldtD9`1#&Cj5al#t%iA~=G zc6jOXXi^18ypQ*=^mF2)#^I}G!1!JD^L>LAb#{EPiP*U#G%ZxrkRJwRJH6%6T(wk_ zC{>y?+4?hECF#`f5`(`ttKZ-{T5aKf9zIH=-Iz|<{1fTTC{A!TNY?Qy?Z(gqyslzO zlj2GaGu!Z5Fl1K;q|u7CIGo7#_DPWv{wXS<(wmpa@P#SOP~Z0}bH@-<0?7jZkfSy{ zfFtYo_ti{)Wviy>__th%@{W%?x+7B5xg5a@`OG$NUY|~15&P=0?;AvJC+T2yiIv`{ zw0Y^CZn}ZVDh)VR{4M@#j@eE1$8&!sIU+1PK7)zYw?3AZt&~OcC`0(oCrHbB&YEiD z^Mo!~k?+CP&%hk6-uJGitM-khUU|H;_&ULXqeMdlX>w(!{Rp~jwyV}sXfT`URZpOuamee(&l zw7QK!Iqe4PU(+8keEwIJXa8j$?(B)bDF=Mr)BfN*ClgPTxkTi@K4?I|84vL82{PZxQ@5B3iYZxs0nB?ETEY*HH)fm!Xv3EWU-dZ7_*yLFHs>zkV@F^z8mEPUU z{eH59=I*-t*+Tk!SP;E7&1vVCyMa<1;cS1D$!14eSf0_tCj$9}dSvCym!{+^7Gx)p zS>|L>%o`nT81WVq7fWb#tGZ6_Ga=8|64z<{)O^<$i(kp{xro$q>9622+`SXsA1k(4 zc5W*a65HM?b3#@&Y7`-p56N&ROe&vZ09H(}EeO*D^$V6F(6e@FqBao*B(^m$=v9@f#nh z_Iqf>3@x9#Q1dSgT@Y=2kgWR>e?x3>ku@;~&ZW-xzt&#pXeD(TG%gscXV4SBJ3wns zkZN5npu##bezqL5m+0jM70PJawlV34L>jXGxQA!WdcT3`WqvE=lIxYlz2xPX+vCZW z?~A0`T|F12DHku6rP3x0_)n58RZFChFQD=}t*nHr%RyXma!A-iqt|aR`}f8|8PvQK zHCz)0kq2mEcd1ued>>ieqGg=Zyrf;lUpE*CnFuzBJ0PRR>G(Y@1kqvcFGPI#{T0^Z zOxAJQ_|izQ=#frLG8b`tp3-M>6yICwAL*Zx?rIq{pm*V~eyRV&knc+G{dU-Kr@Z;? ztHpjj$@l)>mdZAtY9~73zaBS*RqIf^mx1Bky7#(+c>Hxe_Y&iWe75q@T9F4yMGP?9 z54XM#yW19M9%`JJ_Wz*hfZpP7 z23D*(&{L5&(a@&d8eCfOX#1ZB9s`wSk4Wmz64NX>$(OO)pJjL#ah8<-ka3}ATuAAJ zZ+DVQ{NX4>0MnA}brCtFpV-xkv-Fl)g+kU1cHPNE3$XSGH%{Lu%{R!Uj{R%e%s65r zvm)!;am`ljC&sIrimm$GL~p4vDgDqkH2k)$aK=wsk>E2Z!=pHv&m2s&aTt^_qRAz8 z=r~dc*r(Q(E=*{ued|mHyRLT59TsTn$=D#|G)Y;b*e5ee%XpNOOxrTDl-+H5UiJA9 zX_UqTVNbQ3$*LPkJro7#4#*hGY+#l#<#~uqD|Vge{L&8#b^3w_YQ!?!kL4(lKbobQF4{?UWs|W^Jx{pUn-K5S}vQ|G|>sfuwOV;&O~; zs;194ufs-YbAJpC0&JfgD6BIa`?&ls>~0J@|Gf5rfC_VlNws@*VX!u1GK1=NUiI;i z)`VT})0>=7j(}!6`}UNXVS!TPl5MTQ10i-~lF z+J{aXoJw76(Ekx@O3gnJaQU>~mRflOtJw#-`}^AlvrS*EjxXBfkQ4qUY4aznwPk{7 z{5AB-@YNQQ{&3A%sSh1GO3RU_9_%ge{sMQ(XeTZqMN|3>zP#XQGf8~!3w7q1@8!kO zCs7*Nbv%zrJUuhkk$m5BTf8{MH3q#&|BCmfwK!JCxwxlhSDz5)n$VlYccs`~?9}p> zzP3SZs^yw}Y^}v%_B(HpAH#zlocR0qS?r>kLdi4-yW9|_Eo=3scA$uX;*L)(qcna) z?F9NGrW-3vo%4BKAVb1~{as-7c5mr46(l`-PGBc@wVWBQ7>Vg>5j7m@a^E<|6+Xh` zY}vmyqn6r*32wb+1Obgst79H)UlHPXFv@H|9@~WRu1%Yr>0K6vS=`*k+50m&pPl%o z{gdx86lkwFZz+o(=u|&CnE1q|U#ASGF&s;CG&sidwqI!g7jJAaaLp1_$6;}|nTNc71}zL?5f6{`mf3GENm_m za33p0?y^e#w+*eq?7BxA{zYU1KAgy$_l(1Th1AzY8@DE%rkP;x7a5PlOs)XXvb(UBz3Zs{v>9d*!w`|ilxEEqKWG!*0u_6pE1p%r zNld#>qP9R8ui>_j)z(v0qfoGuE-X>L%$XQO_*cC^_%5?V+H6)wY1{VFQT6p^u9$Jb zgMnP5RQE82ex*szWN16{*O?`x-N#4?W^+^~gi-4#qh&04`ks^klo^R(`11r~z?d)J zKlTkyb5-Le)ev`e?R(pPpH5XxAMnYim2t#I?9VWvunnrDZZ^ z>A1?G7I6rNuZd)W`GS9DP(^FOlTJ)fZr%EEEe@cFY(gqmTS18)O@@@6G_gglI8E|L zWP1zMByD96j8a8s5Jw*|u>uaazJyl5gG4YFce(yLsm^Q_UUfoesQ;YaCrz2*u2Aoo zGP-om%umFX7lbqA`EXFmt9su4U*k+%Ui*n*7)w@if|RMvOiY=DL@j6{A#0f2i5y}Y zdjVcSaXU`%;y%copb`5T3U$P}_6l_bCNmI1x(vG{!8JmhlrA%#6N8wl?YM4#_bHl0 zllB?H2`oCzlJ!kLFnpm;e=rnj`6yNLZtuLy3(=GNGzPTa;lUBw#p3hDU?h54PHNnj zgZ;%YoIP*45J2m~wBFDvf#bCtBILA)vpyua#}o`SbJoYO0R0bOiD7%4)flDI=(1Wy7c zr+QmrK;{i?2hh0=GWK1n9m&50`A6d$I3BMs-!;_};g8t{7a7!9G-|1$U*Aq|P}vK6 z4kz)gfm!#IZx3}zp>g0#>?{woXw)jgFvA8}KUzY|-IT&scFeRKKPpBu(RV!)v_y6d z{Noab;VZe8Ty{x!Q=xSIdL$qvM`M*+GmlT3G4_*HXT&fnE^^)8HU!=hSNv=1R!67;b5^}rxz3NOvv+P z4u-M~_|Vj!f;>JZC73--eUirRf$O}mr;an@E}nkG`NA-S#HiopsDo$t5^QG3v1^-_ z1L5xaPnV!npzWRd7Zu!Ba{PI$Iej26Yf~db%9u7>3cj#w_WSYoOzdPChGPKVo;V(C zaOx^o5pGrcHlr^*nMo}?Tfw43=f;#OM11D+HnXZ=5i6H9pB1mBJ?XBd-Gs_*8Fl1_ ziqvP;fTwtx^~3t9++x*qKyE*u_w zDF;CI$;RfjH~I zQFF$%m|&M*VbNdQ$HPytLVyhQ_+){l!xW){U_mA>l zM>q?38LSPjun-eg+-;af&2}$F1usYZobCr_fEI*fGcY;-6Tc3?vgsLGrQFaJh-U1m zJG=$~v?3S;jr~4e!b6;ZZuZ7RY&2#9<(V7izeu6Zc>#&*5?((?W!N|z&l{UH3+*g| z`Lsb+3SMqyuqgPBoCN2e1I|2(1L5_f|4Ju7fCjNT2ZPr12^Io*oE88ucYVkMRQ^F~ zO%_6=(y^zWV^IF4g$-r|KZ#rAR%a}p>=AT?y zzyNg5vN@#4lH0<7igQ$Ebhtr&n!X$k%M+r{@6=3i3#Fc&=^e>-YnzT!V8zYx$zv^r z7DPF~{FgAUSsjP9iy_pX^&61tseC-d|F9vtrP`T;&ObM>AEJ!?(w=HjV9BvwNwe{4 z*ba--zfyz0mxUCqW^=KAPI~**mU_&NUSgZ?^=Zdu#xTS_#tbUt)hyUZ zIvL-%#iN2Ruu%67uoHJf{J)#QPt>bs>jP(Y2oGK#vXoqA0p~?#4b%ZnRRgvvnj@jK zGc@Q_80u7}w0Sl|Foe%?%|Xk=5;#gwzZCYtpkHR^ojxF8k5&xk9gNGXHKeY`?3%f$ zOe*TS_h||Eur%c8;le*1>!>iGK6qEcI&p?k#x)0T$2Nmm(EJxw7s{-PNcP^xC~K&p zeT0)X?HO3ZE1)$Jnfutv(2Weit>Y#+;XTlzGq8_6;Vwrwb~mb6`%rg<_cPzQ7O)n~ zbj4pk`F*%?t~DgQb!tMJVYo|ohCS%cd1f_jDDez!;H)?~*r7C!q7ia>c7&XPf$O&g zecAxsNM)}V3uyf|4!gXLC6_CTuR+hS8JT78z?(AK>CU&^>_~i$*s{WYnYGR%up_%# z`g+We8vOmeSF?WxmKUT27?SB-!NJ4)*;2!K%5|i10{rgBcl_(uPtNkg5@rY$pIK+; zxb~*bD!2_ZY*Qk}eIWp0Ih%+xA+q^1}Yt;`rbjS|RFvrLe8}Lq=hLzV;36LU0)G zG&?78_QCE^hED%LYD&X~eEMdGYP{125*mDnDT}HzF>}~?U}OVVdm!QX$W~bJx9a#{ z745#zn(1hXXD~mZ-#~=X{O|kGX9VSMNZw9(j3IjXEwpCO;$6Uoo$^oQQ!TJLoK(R^ zyBPlP2?tU!7|uoMq{?Vaml+q*Mb$t5piw8U@jK(Q2z>$OE;DT6Ads6`epv+ZsdKJphQ!V{V!?aC0EUo8$lD^A8$RRWs1_ z;%p6Fo{5Vv;EYnB>flWlr0=s0 zU^&{0_rs6Vh8Q@wEh@977~dGsM!%WU+hbOOcT|O6W}Oh@9Q5K(g>m$NZE(;nE)?x^ zr{N9%1{TX!g%}l{lVZ~-jNR~}k5$Fw->8x)DI%6BO56{oiD2qO>drhWJKk@M)RoSR*)edqLuyn)X$Z}b^XYu*Ihhk?GM?FY9 ziaQ@YZgIXGey-B1aAU7x)0eqoocR<(%!`N9QV zGL%Pi@9Ze~VE0!yLsTGlf9PAeLPZz7#dcduK5T?DH-e~Mk6C)+&&pyY(#F?{jZb7E z>$;Rqtl6Yl#vqzh-nerpCFH~scQ4a@>+bT6spWnSJr-ZI@s?ua9VsMedHt^jOmzQ~ z^p%2)pmWA|*NjbP9y~I*QSRBvt-qu;CEhYTpA}f%J4$?`vux7&d;W^8F?-&>Xn0gL zFDpCMcl-Mn@lJ204T~a{S2)z%xoH|+ck8yuS;GLE_1jnHhL957R=Dod{N9!Kj{G)G zNzo-iNPB+CNqgjX;Nyq7SE6tJym!16i(RJJcw7wkdpZWQP1D|^VE86tak+z>0aB@Z zHk?Pj&faO&f*xk^hs6i*s0ZekyJXFMp7Ka9&-%mV^?Rvh_Fw+?eEZqfYSjvvTv55Y zNB8DsX;35I?&j@HFC$*kHaaL0)^PGRe)wh=uX|$MkJXE->qF0rV7JO|tUZx@so9e~ z)+O9hKr;1${{!!2#WS8PM#W8UlU?mc{I+?;{*=uQwh#u+Ffc~1_M?4FWgroFML;pgvpzB`8&()TKlig|-m>t}gk6E^WoR%CU&4#AEWc z#$9$r#U_nDmD^Ji&M$V~sG)x*ebukWecJiOCLetYx21#xi6CNN(WZP7{=G_RJ9vG~ z&KZZU9Q&A=w|J>{!;g;Y*da}4U;UKN^2+?N-#u3>l`ex_;dTT=c>D zh95`DH0(DH_%>S>&An+#satOOX0t?7rE#pRCI}k8v*lsPD0e8$t+BCi|6p?x&Z^$6 zuI(Km?mME7odu0g>vT;Hm1&SAG{3vAqHa&Szey;%Pt>roJ-VV(X>N$h{CJbW(^ioI znTw3eQ&zZ5IcFdr)f#?`wIBZsAMLA~63>`g-TD>k;Pfj0F#og9mZQHcfdC>8Qt8MW}ddX_4*!&X_@lp9uzAiW4)T{V|yEhazrIgZ>lNeydyH z8^XJAy?-AUxDe)y(yQJ1pug=--scRARDXYt!P)P1g5>PM1aJ}89 zt(?y80wZ#`>?=j(RNdfrW_`5|k*`60p3#6ta_VEDu_WT%=6 zI#D#+sjWSRAS9zpvjoe$K+Z5F6Sq6QZ(I2b_2GfC&#tU;i8p(4Wo>MAcbYioW@$Az z@yAwyNkbF3GMNP4b|@{@jS(LuCSLgh=vm~3jD59V8KEt|p0GWwaxoZ$)UKgk`z8YL zVTFx32HvwFxe-oyjC^A(|5M4NOp?eXMIeY)XA;=tX@VPh# z+$BUDL-yWZLjc~HKMUaFI;Y$@5SZ}B^+}lSZ`W%Ua6PaDU~#9)h>6QS;q>GAgTiw* zsPz*yJQa+*LMUHY!$CsdhB|dcMu_up{8Du=Y&1h zyWaoSEVc;q{w`KT*yKC5-4 z|D9q4!4B&U95cX_<=JF)OuVhby~B ziOJ1FIlTmmV^{Pw(;M#e%Mldo=;TiQpSUd78rS;D(Q)0K0ibV5&6&EEx z$W;9JkNr%=q0@Lc^w%}1o#4|C2HD@)#x_2!y-`3DoF}*^TN9|tkgrE`!7ZQ6gJzDC zi+c$zKbY;6l|HqOsyiOyXBd9CKRBfoGV>o_ZETURYpDN(SOu<@5vwH<`5Ey|^%An6 zK7f9hKWi?8_uKsxhO2Ev-46%X-{xjD$NU&WYJ{luI;6h!@$rX0=}YqAXAF z+?U(n)J}eG z%FjzcW7SShwJPQCK46TvndyH3#@?H>HP`#Ox{YE zquA}6nHQVT;Q&+ihZ0<^yH*;mbnyK6z=f#B9|%m>Kxi|UBcy*DX^-YLZHIm+73+uF z&^|Wyd$g+X5hu83r4aq6lspVN<1Sr4hGkZ3RGmbaJQ`58>ND}zd|=&yv(F8P?8+vS z59)Z(MvovtwS5vFW5EbsXbj3~X3&NALJ#C=?stE@#4J%nJjMcf*`5_hKGEugoZovxI>BCjSy|{>i68eh0skX!^FYN?N zziW_#*5(N3!wR4c2!@xyxE(kmwO3=+t=I^jex$4v0^S4b)RI`)Rhj%dS5{Ym0 zo@Vin)ruP-?=|dUI@2b8v`ji%;bd+JLZs)0#N~GxvRsZ$ZvlXye4=)G2zoc+J8uu6 z&cfdV2F$!zP8u{0AcT1P-8!gR-tx+Bi1K|yMvFTX4T=F;6OUV9cJmN!{^SNaX)7KW zXz!i4vYBvxd{Mda^Mw^r4wLh;TK5J&n!7XDF!d}tc6nIYi8U73qu%}19`D_Kr}4^z zcIg-k8MQ?Hd?R%`K)4sLT2QK~KEX}N?~~wqHPh7pBTI2+R@LVQKUF%R{?MD`TNi=m zp6MEHLM$cm=EyUGq1dhZHqXFk$I@ssF$&H^9uBGl!8y*5&+UtT$Ab*Tha~#5Uv7~z(*|LIUg;@w(~ezrV69M zN8~>14tD@U;)6EhCAzVyF_OUYJ995wpoyJ6fJhd|v#rikRAlQgVAv8@>X7W2Izz z@{hg2VM;^h`2OI8YX__#LSZp(6wT?ah+R0+K}etPw9>)BCK&3l^&t51!`!#6AhR*D*y0&tv=Zl^Z@|%agG&rf9f^}w`tZiHnDh->_zK~dD&o4J} zfrF;>-O483CZ@!@b$@~MpR?}aN*KTZ?HD;`b@cq02LWgsI7ZqEX~zB-cOwio4Lwtl zSd@QV$OjKmHVY`$jmM3Ht-{kox&X*Rn&q_&88j`JIO(|wv;zLs+@|Y7?@WcA2}jg5 z$(5B4`R6JHl6B6fUhU19pM=1KCj0K9Do_tY;Dac>_Q8OHohbjhzuT|QEz+Cu4UtO< zwA#4W@@QJwe#s<%xc__1tAJ3dY2WF6#s#;5a@<6e5vXWeb>Ped$jWUKW zH{3RLlhqgV(tIJ9zq5vN@T)y8|4c;Pb>F(h2=dZDHn30~?jxMs{Ad-8T(9xlU_7wC2CdnJO-er zr@kN-E*tdbVwvPdiLgx)8Wt!J=>E0->c|G%Tsls+MmNzqGi$+vu5gwvg0B$JJ>G6D zu>X|a$`|3Y0GiL-6TpQ6XaU*J`D9g;P2e4AI!x(ZLk4G0Wj~<|+=UHfr?h+Rwyf5g z5D9p3L>95ho4B!gHccMz_WxXBYhI+!f*=8L9yfx^1=kXHq!hnyXp+1|AAq^s3k*Pk zhzmIu;U8EWro*qyOn|ipd>U!g)AZ%K54HLI6zp&hu3m60<$mzc1AAvXw<+K+IUaNj z0@_d|Vah^#3fQRzpnFq?Hc&0x>2YJ0Wn3>O-?bIWP$&n(>&nj!dQ)2gnI1fzwml=n zSIU{Qgh0CbP^enmMsf85?Ddqn*^w_CCT|M*8!A8I@(f^=OH7+UOBRN&nc!mDsbD@? zw9ITFfIArz$Z0W5w&Bm2E$$W89_O# zRcV%2GTi+GgiD|t+#?GcfowAPAcr$tTOT3B;{x)k4?Vbm)55f!<8p<3_N>W^`4aMQC=_cm96{1 zaq^X|N=oa~SFOZrgz&<+baKB$wk@&L0nS~`=`kaAi54@Iz<0cBDbL>W3eAzF{v=Z3 z-|`aIziNdG1#!u(8E5IrN9m!27Da-v!{iCm5~aJ8HWJ6`*fA1aZRyJLCx1{kCS*Nqcg#H%!cGJ8441YspVREZSAc0ocE@1PL4+22he?CPk-z=!Gz=ZB8j_U2vg_)H;!HZ#2m4YL zpUsdRKa(efwfl5yrpbflgL+J3piZz2#kjt)|wXFr{PH5(Y1qrTXkVL{B$& zU+4`vGE6V@w+}Q`F7z*Q+Is4%T>8NjhspJ}u2hf0eZh=Re_hPkYg(Z6(z&kA29sJBtj~Yu z!vX0mH-C+~)xj;9&kJ!&D&J1|tG!^B|7Fy%T|y(o@M7S(1}DX5Vs87VBK1?gTJ7|d zrFIZY-nMpEZyxC`X*4`UpAjT@Y*uhn+L?KJC)1#E$W)n`^cS&IU{vN2QKEUXM9|64 z&SPngDj!*S{)YvG5S=gw6?euRHA{NM6~m4|?wNzi#~%DB=w!$6?bTHtI1#l{Pv6T= zTxIJTmEG!J0i1`p2Ms!s?f)V+^GRq(Wj(P!wNsLH{D5=@`DJVW@SaeaNB9xp5cg#2EUWjL}v`!FAXRNBE#(#`SwSzAAZ z5b#~*cIm~u>792nlg(FgJ*zvw^=yr+=j=(#zW+JFLKHK%OR!~aRm3-U;1yz1ydf$- z5rcq)940UQtVLDR?YUv3UTH1CaZa%OL9XsWRj#HY2EkEk{8-Fh!}R!S#1(qg+n22- zNz1u$msI>chTnwx{_cTiK(fE!h1!5b&|HgQYt=gCOq^%(iAM+n$PZUe#20>p1kBMj z#X*JWP|%G7N!qxEYgSP1k6FCFOiT{ZJ-%;qSx4x)K2_YGbd~J~F9F>(Yas}Tf$QGZ zuO5#Bg2Ijwt`L9?EhSAJc*lr)*&5j3G&XZj=26ok1HUYxsEJcgzIGoXHb2G)fXp)? zu?f5bA-~p)Nm!rz`t!Uw-8xavivASRthN5wAE&bn@k6t92m@h%z+f9K?O&Ap`T*%e zEwI7q9r2!j(I59p%S?*MG;Lxt>58O!C^0>|H36eH3%CVG-$q1*8(I_sQT`at?Z&f9y-!v?M+Yan zuBT_>g>zcYx4b@2B z)%uK;gBCk>xF|vMm-Hj~XF3bnvopBJJAZJIR6j>|{&?}Bc>Pernmx0Ybi~{q+W(le zyhkZgvhzZTbM{RB8YLzBOnCDjhe`#-kVCwgtL3|h@3XO1=pZU)hER_-#IRn8X1Gbc z7@Cg5kYaOo>|!D`X{NA0XuBC70JZ(9^>>0GZCtJ$rMr01je%DqO^ZYq?Fp%{sw-Di z1Ik~9ILbc4m11)Ha-H;vi?fV!4zR{UxO)zJNCBg}`ku?E1Axzt0P7=dT@xK$dy}s2 zX|}Rmt-lY=2ItDC0Mk;XU43WnPSlq#al_qz@r8IY`8yp1^9J5RY)N!dCm(}vA zwXw;qCF6t^lnT!}G>23CrhrinEkkE;*VYLv%HP-n(Juo*HTZ-qh`Rguq7c|C?1`mb z^s4}|gDXChm;>`AntREw0j40-l1ek66T@?eYQEMEB|Kl()iP?!6`vuyFv$VlGk2}) zhzK-L7iL8_Mhih_bCu#V?2ind0(X2Mvhen%PG8%1Fep69-WV23L`2k(VM?KR^1T=x8 zTm1kN)G+m>Ri?KorNN{aTT}xb$$Z2jp`!PoTLpght`<|-EU{?OnGU@~-j^l^^~a(1T!I&U zL&h8}l$o=3&p&7i)>;ZQL_VD~LeC`Eh1n{SZ5u zp0xpu$bqcNr>V%n%l`}}7w5x{&C-tuf;-oZ+#2CeTT9yfT9FCGVVI6L@7_FrxkThI z>aB5Vp~Px2$>&RQmG-s_g}%OAzncUb?xL~vrX~Xti$1I~ZIYDm24Jw2W&OImXGGk_ z7K#24xkvdHxeNF3O6(`{Ej8{KJ6hbtCBj`r<_`dC&EI1e?NJ+siTz22J9h_V9~`V4|#Sc9?kU)a{Yr^^Lm}>%zYZ(56u&|OGuokCG8999EfDrECyHLBp z39i2)(_|g_3nfYpAk?}E7b4A*HY;xWW(1)htsJ_6d{GfE?u0JGJuy`-hD9O$H{ZFg zb`}_|8RPCH%p?aD)2IFu%~2QbZU8^9h%fjuaT}Hi*OnvrT84866;&HVH1W}S?2FPx zhe_B4s24*vB<6V0hf9xpM!@CsAo9GYNdM^nv-QsVI-y4LWjAxqlTE@VtrxrdtVA zyx#8J^H(#nUl}dtmM--MPdO$T`u=Ow`?;0I_b7+yczT^~rmPM&;a83OS`^*N)zqek z275=?YWZAyNjQ=Xrg_{FKOo&noHq#_&+knhS>_Qz%Uis2yF}2OErmt1*jyg_+s>)Q zY5xhhNR~kt4c&Gq!3Mr}^*t`>Fks#3dnP7Vpf~OVrf4T{Rb5#F=~g6^%_{0_vqLk= zk}o|?wGL_yO7kAySEzIt+Os9s+x@HB9L-(899a^FA?ecM)VH=Mwlr$j#u$_{-ll9+E zm~!MZ?+#4N@zj1vfAb10L4WfVveRGH#HQ_b8$1%p-=RO2>|rBY%A$);+a;&@eo4N& z)XPDJ=&!IgyWDV8`0#D3*K4QiNjH~}9xpNLma}N{%l(qPT*NE$baal2Rhy8P5+_Oh z%W#@J2q~_xKIR!o{V5~1ET8{lLxJ{e+=f~-cJp;fMMqn4!389kYlHosTx#dqKylm5BQFRy)}zYL$h%tC+sGzR_jzW_JsF3SRo14G7gn`vozCBjnU#^?49K+oJKd4Dr6gj-c>$>DkM!ZblxAFU=43H8C3( zK3WjE0+62agI@`4bELFzIJ^t>p&vR9j~pbZd8xC6=_m*M(6dJy=DcZ(qo}< z*^{0%y$3NbXI74YoYy*z$`)nszm7NehD~oX+Ts1q$DHyI^&ejy6 zlkJ8h!BzL$C#_xt*UC)N3MM<5?eUTAhHjahA?k}@X8XgWOssrV>Qydd%akDduByby z!*@{Xb%tGn(VaqI#%D>Kd?LyHdxTEg#jU5lV;ERIZ#}F(GGeOSQ#G}xAm5Uy&367) z+ZHqDXV!)4n9&=2qv_d1lDCmJ^WhiJHT{M3ScV(!R__IxL2??|9Cz)%O9lLAs0Z(c zKUzuhT?ub7lZVcgLSR6G{#>2;CC*xvlZR|(PZmyXdOdaM)?{4__VTAmQl+60X1+eH zg><{b+pjSHHe>(9|FMLu^zr%mZcvQI2lDRBEQsKz}X?|(C`DHJA zwuS15{(To_M3Tm^@WA%$<+LZ*sk_XF-I6qwcpc`ArvYV*n!iS>uB;%f+YMf^HZ-V; zZ%%Y1tjm{w{*-nROLC`5FbbIF4?VYgzi0TJEzmhsrgIMcoo=q=4c-Ul>D(?G_CGoi z{-q1K3QpKEA2KD$In#f8>*i=9y2Jr~qYs=%^haE_p86G+K-#S1t?li7TyB`EQviyh z5%V{a){#iBDG+qWtfIpY!?F9};d27^g->d2c1?`<#Uh-t?quDHGYJ#6RAaxcBhawz zpV*rP6ugvPG2b1TTG2kN14$9zc~|3b&Iz;gtcn$vq-f^C<@vqA%gy(hZG7AVG>k4R zTOPbmrnAd>VNztU5LtQiB)j*S>oiMJ?X?Oga9Cw58T-N`F`Z_fh=FHP``~q<-5E;o z7Vpk6=NuCVY4a)XJXgtSSB~u5`tp1M7nH}p!90AcF_RhaN6d&T#uDLo=x)EB4%K_= z12X_D3{S85bJGdG+0M|y{dqNQcS%+H=J&zF0r?n-@iB*F>BCYLD`r4VwRKtt^m8WTjs<+f>y2P(d&8@(R{(PBcsIgLC^V~%S?{$B5@_RdlxV> z$xp)H!Hl6OZlZI^xKl!3H&_;A-{?|^Y1xCDamtMS9LOc=kI%lmn! zFL|#W9VI#kJr}#mIS|3rr_M0O{UDGd&&o!9i5G(crQ>vd3a;uZ-!OV(f!Iup(og0k z*4I?Z@?a}wJxXGz(8+1LDZd+~ks!CdbK~8qobsu*>DqCsI}?+{=%!un41_TI(x^tk;GnU%#hGZSi`O72d- z!u;ENv1yR}O7^{uvN9qDpL-0N1>|q{?vvU6DQ^;7tbNYB#8f3~{c-61ct=co*&ncQ z1~IS=`Nz^SIF@RQVBU%F_#vJWABG2!@+W^W%{k>vwSsV~UMc?jEtoS?b?i0uCPRgM|4|a_WRj|-K3!AbDu=ot!tXbIl{h1qK@8R?He6ki+R^hKQ!xf_sS*B zlg}5w+ZBh7h#_X3FLXv-J{P5mmy|tVPMz*O0k0++r@`JLuU#a_n7u(zMB&uapIu0I zX>iAMR9^U+g168v7lTNf%po>2UP+Et$e1o_%aUsIok zyBhs}c6|wt(hQ@|yMUAqSxKdX67xk52S$s#4d-0gAjFaUt21us z_3(N<_t;Z*n|)VJnvd?Rz4Abjg+zDbq5|_Z>J$FDa6i_}Hww#BIlDLaxYed*If5Am z1xJrF;+(3N%VeOlU%959Nrw+!xE~LK2NkR@dKgc}-cQf0$#?U5a0wJDYG+EzK59R; zW4R~%p1qHUK6{G>5lfyGB5YM#Aj zsOJkBhu^D4q4YdkmE`q0xmzK~Bwq!7xFjXI%Q}rS)ng>?l~>WLyVy{Ext39O(^_v~ z(IV%~(?z!s{5P^kG8qm6i*)^*yPjW8KLvy+m)ZWhqoKYmN{J=%gs#O z(?40Y)gb+lEGD{$7QCbgoPM9EbSPi2krA+V)UY)|@5K}{Y*ME35n|gVEU>H$YgrpM zYvtx{MF`}&lxUB_p*$(GR}kApKR(8a&rNz3KaXsU@yi2HDy0@&686!(dZIgJg~4X( zE3cokTmX-9Tugk{KOSG2c zrF~zUA-AnHe?Ue`js0hG1=8pFDe;P6f4@ape+ks5UMT0^2gWY=}$ zHWzZ8!ji6bBWtf$wRTc64ihCeZ_yU`sjj)_jm4g74hD!%Ft0o~A+w;~dTs429Dl0; z==9zdx5p#5XE@f{PK*_;n>44CHm&^*ckQ+-lBcHRO__^ zv!=hODZVLNEE2qcv0|Vw`(rKmSFN@zwrsIz@B#(vw;KBVUC!6y%f8&`OxD?h`}v^6 z+HOdVJw~T=sG3xA;+!5UEaCXw>0}|6l{+fC@$*1z9il$m{HLAkFSq%*kZRq5De>48 z4?L~WoR(sQQVghUJ!5HFXYOwEt~XTQi)`a&Q>{u5Yy?PqR~)WxDe>S5 z!2dpx{87eUS3R$yQ{n2UG>;YIYEBO|SX*7c`jfk7l85k*3(frI@7P;ySPVT?;BxXM z*7r<7%`xT`@l0uAiUy|7-#467YCZ5%oo97-B)3vmde~gja8VxQ-F6OxzjbpjmM-(k zyL_buqZbRdaSe<0 zf?*0C+A%TtG?x(&JunD%^3dNtYp)7}KUi`Ha_Cbx?v`kgy;Q9N>4&ttj~mCMF`G3I zj7`yW%)HqHMJ>a@@|foFp_1_IneRHBu^BAqs*88ZQ`Vh{z2ABoOV-S7pQM|ve17FN zP4c9&ZEmU8m0$i7>^HCl9c__q@8irwQf%kooSL_SU`&Rs5;3Q8QQ z{gvU1_ckxM(dJq@Z19-ao^%k7r9V7nB~C=~Ubp;y(RvKi$P;0e$$qfr>8rFF9v?AX zzAQhbnEJVRc|M(|^3L~Nc9`b*vd)z!@KkbE6s?5Q~ z6ERm(%%;I!T-We+exY2MF*T3oPg_~Lw&&H3zLc*sc>FP#)a^FDVb1mMeG}Q@Bg>zz zBgz~|THY?~9;W`loDvqbd{?iV^P!0;*&~6&f|Ny-yy94kmB)pgtzP;$5}8{ju3IwH zG(MR}s>F9z-bv^RWsQ69-Rt?n@#1Q!>~F4XySySNZ-iNw?W~WUkh^)R%>S@mQ@-cd z9Il5!D{1-bN3UW=6)<~Z(k~A zg)80~+cp%zUT)RvRw+M(0;(FlfPHa|8MMkMRcQJ(BeKvUpk}mtAvt$&*y+n&!_20v z=`IPIuCRa#Ueo1Tb9W~fF}%ev`uGgB`9n6FQHM2QEM=1$sh_)OtOllpcOu534~9=T zG94|b_9{I_-|SN;k$T3Klo2kDLs4%()#tBWAMQ>Flua9A)%{A2M1ZUYrZJ zHfxx-N#BmoPyKPE+)F6&vA2*@9xZIoy>v0dEN>yViI?JwNThoW(+c&&!&3PrOmd;M znl;HxXq#QGW9!MsSAPjC2#hkmF!A+-dbWUJ_xoF-{JX_y2TCsPIr4bI2OFr|zKr3oF1n*(x$3N+3*|E zXxL2E1U55MMw_9^W4T?~Oy0fT(~T3sN=BR(8gnw3O>=@@m7H(pJvB^g;q>~+!#6kx zeV(C^ehhGWgGuZWw#=zJo(vL+Jr>Ry^c>~z{rg)qC|)c0=Tl5h^Wxv3Ax_b`$SaWQ zdzx2=fBsxrNWHcI4^R4o?F1ra@kV}uR0&@GQvwtrS^mYT221!;co)QPJ!m$<%fk~o zC-v?M{*}Dg8ON$^%e=JONRKm9k6A?MrH36fes`!b_S*%I{dwuO@v2w;ZXuJ+f*-`6 zF8sL4HA7}YewVbF-}C;9N41?yPb=I$NLN{H{_^O z?K;b@%v*o$Z{15b^@>!s4r7Ow%GrCdFPstGv(38eKxD|W<*z#Gw0HHMzw>wYgNPOV z%BOWx`O+^hkds#UrqiIkfKa7btRJbqZTf_{_)5DfvAwEgr*F3}S!<+~IW6k2`}SAi z*2qT+x3yazZd?9$P0~)x*7A(&C1&$S!EoLPYek-KmP^NzS*M;4Rn1*|-SFC$y1=ii zRvot3IV7(Y5G12#?_f=^mid@;GByW0EdIGwL|AQBDcXxCwh52M?3BOxda~rAcW$?am0_XUWTWMIYl}N9 zBN?#<*`;<61^Vah#Pu61nN$?o=T?8Wd!j&a+k$8=h0 z4@3k-DOW}KOH*xR`2F}P?ko5grp{Z&?=2uuCm@w#p88FaUy&Cxnog=b!B@RBL{?-@ z+qu5;62#s2&fClkI!hCxR|bt2dp|jSeg`Rb_2e9@(c@){1LrN!^gsU7U16V2!|G=d zpLQj#lh-CFT$O8hg&B*Ccn_2TP$ljbC@a6R(Tb zYnqB__;JTys)Z+L{t62LEa>onO5!z(nx%Sv4_|1VlzC;tbKHER=CvzgRkzw4sr*rW z;rxLYf1XI+eKK2LeB#-b19Ia7H%dI(y=lSYH`bHObcTyYT9aQBe|~HZ;d!|J_%;il zjLMgegVD{K5|?_8pO#PhQM-keSf~26u|0G!^~zi7kwmGlit8WV{F|6pg>8NnaO9LE zZGGC)-JzbhUb#G-^Y;(qqz|Kq+@zbnTMJbWuU{2?T2kTo8udZT>)>qaPpr& z6yh3w4c=>P z`PWl!tmP;24J@GS*$D2uL+Y2gO`h5w_}_!@dHEBQ|o73cXM4V5>!8lbU?qLxbJ zKYoXoq9ez@hH_YzUsU!_YvtjA?>GC`AJG6_p1&QfbT2wOxyV~MIZ;G5@-L&5YyuVP z!Mv27P5i4UP?3w#SE9}S5xR@3mZikV@-L#8BWqy~X01hlH7UGcff$b<^&-D-;s2Bj b<)ti^<6pK+02qOSSkChV{w)O&j_3aa%XI@; diff --git a/vs-build/FASTlib/FASTlib.vfproj b/vs-build/FASTlib/FASTlib.vfproj index cb2cb9a044..011fe32a9b 100644 --- a/vs-build/FASTlib/FASTlib.vfproj +++ b/vs-build/FASTlib/FASTlib.vfproj @@ -303,6 +303,7 @@ + From 6e66429a17311122cb8c405f9d843a0081b4b3f9 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Fri, 15 Nov 2019 10:09:31 -0700 Subject: [PATCH 09/72] fix length of AD all nodes output names --- modules/aerodyn/src/AeroDyn_AllBldNdOuts_IO.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/modules/aerodyn/src/AeroDyn_AllBldNdOuts_IO.f90 b/modules/aerodyn/src/AeroDyn_AllBldNdOuts_IO.f90 index 46f7dc2289..4d3d66300b 100644 --- a/modules/aerodyn/src/AeroDyn_AllBldNdOuts_IO.f90 +++ b/modules/aerodyn/src/AeroDyn_AllBldNdOuts_IO.f90 @@ -19,7 +19,7 @@ MODULE AeroDyn_AllBldNdOuts_IO ! Parameters related to output length (number of characters allowed in the output data headers): - INTEGER(IntKi), PARAMETER :: OutStrLenM1 = ChanLen - 16 ! The NREL allowed channel name length is usually 10. We are making these of the form AeroB#_Z######y_namesuffix + INTEGER(IntKi), PARAMETER :: OutStrLenM1 = ChanLen - 5 ! The NREL allowed channel name length is usually 10. We are making these of the form B#N##namesuffix ! =================================================================================================== @@ -128,7 +128,7 @@ SUBROUTINE AllBldNdOuts_InitOut( InitOut, p, InputFileData, ErrStat, ErrMsg ) ! Create the name prefix: WRITE (TmpChar,'(I2.2)') IdxNode ! 2 digit number - ChanPrefix = 'B' // TRIM(Num2LStr(IdxBlade)) // 'N' // TRIM(TmpChar) // '_' + ChanPrefix = 'B' // TRIM(Num2LStr(IdxBlade)) // 'N' // TRIM(TmpChar) ! // '_' ! Now write to the header InitOut%WriteOutputHdr(INDX) = trim(ChanPrefix) // p%BldNd_OutParam(IdxChan)%Name InitOut%WriteOutputUnt(INDX) = p%BldNd_OutParam(IdxChan)%Units From 18f9366e8b075b2da74aa00e6a2c71e8490ca933 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Fri, 15 Nov 2019 10:19:15 -0700 Subject: [PATCH 10/72] Sync AeroDyn driver --- modules/aerodyn/src/AeroDyn_Driver_Subs.f90 | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) diff --git a/modules/aerodyn/src/AeroDyn_Driver_Subs.f90 b/modules/aerodyn/src/AeroDyn_Driver_Subs.f90 index 2ca6fe5fc6..596553b2a1 100644 --- a/modules/aerodyn/src/AeroDyn_Driver_Subs.f90 +++ b/modules/aerodyn/src/AeroDyn_Driver_Subs.f90 @@ -262,7 +262,7 @@ subroutine Set_AD_Inputs(iCase,nt,DvrData,AD,errStat,errMsg) AD%u(1)%HubMotion%RotationVel( :,1) = AD%u(1)%HubMotion%Orientation(1,:,1) * DvrData%Cases(iCase)%RotSpeed - ! Blade root motions: + ! Blade motions: do k=1,DvrData%numBlades theta(1) = (k-1)*TwoPi/real(DvrData%numBlades,ReKi) theta(2) = DvrData%precone @@ -273,7 +273,7 @@ subroutine Set_AD_Inputs(iCase,nt,DvrData,AD,errStat,errMsg) end do !k=numBlades - ! Blade motions: + ! Blade and blade root motions: do k=1,DvrData%numBlades rotateMat = transpose( AD%u(1)%BladeRootMotion(k)%Orientation( :,:,1) ) rotateMat = matmul( rotateMat, AD%u(1)%BladeRootMotion(k)%RefOrientation( :,:,1) ) @@ -283,6 +283,14 @@ subroutine Set_AD_Inputs(iCase,nt,DvrData,AD,errStat,errMsg) rotateMat(2,2) = rotateMat(2,2) - 1.0_ReKi rotateMat(3,3) = rotateMat(3,3) - 1.0_ReKi + + position = AD%u(1)%BladeRootMotion(k)%Position(:,1) - AD%u(1)%HubMotion%Position(:,1) + AD%u(1)%BladeRootMotion(k)%TranslationDisp(:,1) = AD%u(1)%HubMotion%TranslationDisp(:,1) + matmul( rotateMat, position ) + + position = AD%u(1)%BladeRootMotion(k)%Position(:,1) + AD%u(1)%BladeRootMotion(k)%TranslationDisp(:,1) & + - AD%u(1)%HubMotion%Position(:,1) - AD%u(1)%HubMotion%TranslationDisp(:,1) + AD%u(1)%BladeRootMotion(k)%TranslationVel( :,1) = cross_product( AD%u(1)%HubMotion%RotationVel(:,1), position ) + do j=1,AD%u(1)%BladeMotion(k)%nnodes position = AD%u(1)%BladeMotion(k)%Position(:,j) - AD%u(1)%HubMotion%Position(:,1) AD%u(1)%BladeMotion(k)%TranslationDisp(:,j) = AD%u(1)%HubMotion%TranslationDisp(:,1) + matmul( rotateMat, position ) @@ -462,6 +470,7 @@ subroutine Dvr_ReadInputFile(fileName, DvrData, errStat, errMsg ) call setErrStat( errStat2, ErrMsg2 , errStat, ErrMsg , RoutineName ) call ReadVar ( unIn, fileName, DvrData%OutFileData%Root, 'OutFileRoot', 'Root name for any output files', errStat2, errMsg2, UnEc ) call setErrStat( errStat2, ErrMsg2 , errStat, ErrMsg , RoutineName ) + IF ( PathIsRelative( DvrData%OutFileData%Root ) ) DvrData%OutFileData%Root = TRIM(PriPath)//TRIM(DvrData%OutFileData%Root) if (len_trim(DvrData%OutFileData%Root) == 0) then call getroot(fileName,DvrData%OutFileData%Root) end if From f0053622ecb421e4db242812c8a6762ecaaca55e Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Fri, 15 Nov 2019 19:32:25 -0700 Subject: [PATCH 11/72] Sync BeamDyn - nodal outputs (check length of channel name) - send optional flag to avoid calculating WriteOutputs if they won't be used in this step - minor changes to use log maps in mesh packing for linearization --- .../examples/bd_primary_nrel_5mw_dynamic.inp | 12 +- modules/aerodyn/src/AeroDyn_IO.f90 | 2 +- modules/beamdyn/CMakeLists.txt | 1 + modules/beamdyn/src/BeamDyn.f90 | 168 +- modules/beamdyn/src/BeamDyn_BldNdOuts_IO.f90 | 1496 +++++++++++++++++ modules/beamdyn/src/BeamDyn_IO.f90 | 101 +- modules/beamdyn/src/BeamDyn_Types.f90 | 395 +++++ modules/beamdyn/src/Registry_BeamDyn.txt | 11 + .../src/OutListParameters.xlsx | Bin 207757 -> 215167 bytes vs-build/FASTlib/FASTlib.vfproj | 1 + 10 files changed, 2150 insertions(+), 37 deletions(-) create mode 100644 modules/beamdyn/src/BeamDyn_BldNdOuts_IO.f90 diff --git a/docs/source/user/beamdyn/examples/bd_primary_nrel_5mw_dynamic.inp b/docs/source/user/beamdyn/examples/bd_primary_nrel_5mw_dynamic.inp index 680db38b10..375e860f26 100644 --- a/docs/source/user/beamdyn/examples/bd_primary_nrel_5mw_dynamic.inp +++ b/docs/source/user/beamdyn/examples/bd_primary_nrel_5mw_dynamic.inp @@ -93,4 +93,14 @@ True SumPrint - Print summary data to ".sum" (flag) "TipTDxr, TipTDyr, TipTDzr" "TipRDxr, TipRDyr, TipRDzr" END of input file (the word "END" must appear in the first 3 columns of this last OutList line) ---------------------------------------------------------------------------------------- +====== Outputs for all blade stations (same ending as above for B1N1.... =========================== (optional section) + "All" BldNd_BlOutNd - Future feature will allow selecting a portion of the nodes to output. Not implemented yet. (-) + OutList - The next line(s) contains a list of output parameters. See OutListParameters.xlsx for a listing of available output channels, (-) +"TDxr, TDyr, TDzr" +"TVxr, TVyr, TVzr" +"TAxr, TAyr, TAzr" +"RDxr, RDyr, RDzr" +"RVxr, RVyr, RVzr" +"RAxr, RAyr, RAzr" +"Fxr, Fyr, Fzr" +END of optional blade station output section diff --git a/modules/aerodyn/src/AeroDyn_IO.f90 b/modules/aerodyn/src/AeroDyn_IO.f90 index 94f803eb83..fa1ce31d89 100644 --- a/modules/aerodyn/src/AeroDyn_IO.f90 +++ b/modules/aerodyn/src/AeroDyn_IO.f90 @@ -2377,7 +2377,7 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, ADBlFile, OutFileRoot, UnE !----------- OUTLIST ----------------------------------------------------------- - ! In case there is something ill-formed in the additional nodal outputs section, we will simply ignore it and assume that it is an NREL compatable input file. + ! In case there is something ill-formed in the additional nodal outputs section, we will simply ignore it. ErrMsg_NoAllBldNdOuts='AllBldNd section of AeroDyn input file not found or improperly formatted. Therefore assuming no nodal outputs.' !----------- OUTLIST for BldNd ----------------------------------------------------------- diff --git a/modules/beamdyn/CMakeLists.txt b/modules/beamdyn/CMakeLists.txt index 28eee6db3e..0481d770f5 100644 --- a/modules/beamdyn/CMakeLists.txt +++ b/modules/beamdyn/CMakeLists.txt @@ -21,6 +21,7 @@ endif() set(BD_SOURCES src/BeamDyn.f90 src/BeamDyn_IO.f90 + src/BeamDyn_BldNdOuts_IO src/BeamDyn_Subs.f90 src/BeamDyn_Types.f90 ) diff --git a/modules/beamdyn/src/BeamDyn.f90 b/modules/beamdyn/src/BeamDyn.f90 index e32b4eca4f..a2ba1d44bd 100644 --- a/modules/beamdyn/src/BeamDyn.f90 +++ b/modules/beamdyn/src/BeamDyn.f90 @@ -17,6 +17,7 @@ !********************************************************************************************************************************** MODULE BeamDyn + USE BeamDyn_BldNdOuts_IO USE BeamDyn_IO USE BeamDyn_Subs !USE NWTC_LAPACK inherited from BeamDyn_Subs and BeamDyn_IO @@ -156,7 +157,7 @@ SUBROUTINE BD_Init( InitInp, u, p, x, xd, z, OtherState, y, MiscVar, Interval, I ENDIF ! compute physical distances to set positions of p%uuN0 (FE GLL_Nodes) (depends on p%SP_Coef): - call InitializeNodalLocations(InputFileData, p, GLL_nodes, ErrStat2,ErrMsg2) + call InitializeNodalLocations(InputFileData, p, GLL_nodes, InitOut, ErrStat2,ErrMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) if (ErrStat >= AbortErrLev) then call cleanup() @@ -493,11 +494,12 @@ END SUBROUTINE Cleanup end subroutine InitializeMassStiffnessMatrices !----------------------------------------------------------------------------------------------------------------------------------- -!> This subroutine computes the positions and rotations stored in p%uuN0 (output GLL nodes). -subroutine InitializeNodalLocations(InputFileData,p,GLL_nodes,ErrStat, ErrMsg) +!> This subroutine computes the positions and rotations stored in p%uuN0 (output GLL nodes) and p%QuadPt (input quadrature nodes). p%QPtN must be already set. +subroutine InitializeNodalLocations(InputFileData,p,GLL_nodes,InitOut,ErrStat, ErrMsg) type(BD_InputFile), intent(in ) :: InputFileData !< data from the input file type(BD_ParameterType), intent(inout) :: p !< Parameters REAL(BDKi), INTENT(IN ) :: GLL_nodes(:) !< GLL_nodes(p%nodes_per_elem): location of the (p%nodes_per_elem) p%GLL points + type(BD_InitOutputType), intent(inout) :: InitOut !< initialization output type (for setting z_coordinate variable) integer(IntKi), intent( out) :: ErrStat !< Error status of the operation character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None @@ -551,6 +553,63 @@ subroutine InitializeNodalLocations(InputFileData,p,GLL_nodes,ErrStat, ErrMsg) ENDDO + + !!------------------------------------------------- + !! InitOut%z_coordinate contains the z coordinate (in meters) along the blade and will be used for naming output channels + !!------------------------------------------------- + ! + ! + !SELECT CASE(p%BldMotionNodeLoc) + !CASE (BD_MESH_FE) + ! CALL AllocAry( InitOut%z_coordinate, p%nodes_per_elem*p%elem_total,'InitOut%z_coordinate',ErrStat2,ErrMsg2) ! same size as y%BldMotion%NNodes + ! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! if (ErrStat2 >= AbortErrLev) return + ! + ! member_first_kp = 1 !first key point on member (element) + ! DO i=1,p%elem_total + ! + ! member_last_kp = member_first_kp + InputFileData%kp_member(i) - 1 !last key point of member (element) + ! DO j=1,p%nodes_per_elem + ! + ! eta = (GLL_nodes(j) + 1.0_BDKi)/2.0_BDKi ! relative location where we are on the member (element), in range [0,1] + ! InitOut%z_coordinate( (i-1)*p%nodes_per_elem + j ) = Find_InitZ(InputFileData%kp_coordinate, member_first_kp, member_last_kp, eta) + ! ENDDO + ! + ! ! set for next element: + ! member_first_kp = member_last_kp + ! + ! ENDDO + ! + ! + !CASE (BD_MESH_QP) + ! CALL AllocAry( InitOut%z_coordinate, size(p%NdIndx),'InitOut%z_coordinate',ErrStat2,ErrMsg2) ! same size as y%BldMotion%NNodes + ! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! if (ErrStat2 >= AbortErrLev) return + ! + ! member_first_kp = 1 + ! + ! DO i=1,p%elem_total + ! member_last_kp = member_first_kp + InputFileData%kp_member(i) - 1 + ! + ! DO idx_qp=1,p%nqp(i) + ! eta = (p%QPtN(idx_qp,i) + 1.0_BDKi)/2.0_BDKi ! translate quadrature points in [-1,1] to eta in [0,1] + ! temp_ID = SUM(p%nqp(0:i-1)) + idx_qp + p%qp_indx_offset - (i - 1)*p%qp_overlap_offset ! indx_offset=0, overlap_offset=1 for trap + ! InitOut%z_coordinate( temp_ID ) = Find_InitZ(InputFileData%kp_coordinate, member_first_kp, member_last_kp, eta) + ! ENDDO + ! + ! ! set for next element: + ! member_first_kp = member_last_kp + ! ENDDO + ! + ! IF (p%quadrature .EQ. GAUSS_QUADRATURE) THEN + ! InitOut%z_coordinate( 1 ) = InputFileData%kp_coordinate(1,3) + ! InitOut%z_coordinate( size(InitOut%z_coordinate) ) = InputFileData%kp_coordinate(InputFileData%kp_total,3) + ! ENDIF + ! + !END SELECT + + return + end subroutine InitializeNodalLocations !----------------------------------------------------------------------------------------------------------------------------------- !> This routine calculates the contributions of the integral of shape functions outboard of an FE node. These weighting values are @@ -722,7 +781,7 @@ END SUBROUTINE BD_InitShpDerJaco !> This subroutine initializes data in the InitOut type, which is returned to the glue code. subroutine SetInitOut(p, InitOut, ErrStat, ErrMsg) - type(BD_InitOutputType), intent( out) :: InitOut !< output data + type(BD_InitOutputType), intent(inout) :: InitOut !< output data (we've already set InitOut%z_coordinate) type(BD_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 @@ -741,11 +800,12 @@ subroutine SetInitOut(p, InitOut, ErrStat, ErrMsg) errStat = ErrID_None errMsg = "" + ! p%BldNd_BlOutNd contains the list of nodes we are outputting. At each node there are BldNd_NumOuts output channels. - call AllocAry( InitOut%WriteOutputHdr, p%numOuts, 'WriteOutputHdr', errStat2, errMsg2 ) + call AllocAry( InitOut%WriteOutputHdr, p%numOuts + p%BldNd_TotNumOuts, 'WriteOutputHdr', errStat2, errMsg2 ) call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - call AllocAry( InitOut%WriteOutputUnt, p%numOuts, 'WriteOutputUnt', errStat2, errMsg2 ) + call AllocAry( InitOut%WriteOutputUnt, p%numOuts + p%BldNd_TotNumOuts, 'WriteOutputUnt', errStat2, errMsg2 ) call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) if (ErrStat >= AbortErrLev) return @@ -756,12 +816,17 @@ subroutine SetInitOut(p, InitOut, ErrStat, ErrMsg) InitOut%Ver = BeamDyn_Ver + + ! Set the info in WriteOutputHdr and WriteOutputUnt for BldNd sections. + CALL BldNdOuts_InitOut( InitOut, p, ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + end subroutine SetInitOut !----------------------------------------------------------------------------------------------------------------------------------- !> This subroutine allocates and initializes most (not all) of the parameters used in BeamDyn. subroutine SetParameters(InitInp, InputFileData, p, ErrStat, ErrMsg) type(BD_InitInputType), intent(in ) :: InitInp !< Input data for initialization routine - type(BD_InputFile), intent(in ) :: InputFileData !< data from the input file + type(BD_InputFile), intent(inout) :: InputFileData !< data from the input file [we may need to shift the keypoint to match a MK matrix eta for trap multi-element] type(BD_ParameterType), intent(inout) :: p !< Parameters ! intent(out) only because it changes p%NdIndx integer(IntKi), intent( out) :: ErrStat !< Error status of the operation character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None @@ -786,7 +851,8 @@ subroutine SetParameters(InitInp, InputFileData, p, ErrStat, ErrMsg) p%GlbPos = InitInp%GlbPos - ! Global rotation tensor + ! Global rotation tensor. What comes from the driver may not be a properly formed + ! DCM (may have roundoff), so recalculate it from the extracted WM parameters. p%GlbRot = TRANSPOSE(InitInp%GlbRot) ! matrix that now transfers from local to global (FAST's DCMs convert from global to local) CALL BD_CrvExtractCrv(p%GlbRot,p%Glb_crv, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -900,7 +966,7 @@ subroutine SetParameters(InitInp, InputFileData, p, ErrStat, ErrMsg) ! Set start and end node index for each elements !............................................... - ! Store the node number for first and last node in element + ! Store the node number for first and last FE node in element ! p%node_total = p%elem_total*(p%nodes_per_elem-1) + 1 is the number of GLL nodes total for the beam ! --> This assumes that the first node of element 2 is the same as the last node of element 1. ! Some subroutines are looking at a single element, in which case the values stored in p%nodes_elem_idx @@ -915,6 +981,8 @@ subroutine SetParameters(InitInp, InputFileData, p, ErrStat, ErrMsg) CASE (BD_MESH_FE) CALL AllocAry(p%NdIndx,p%node_total,'p%NdIndx',ErrStat2,ErrMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AllocAry(p%NdIndxInverse,p%elem_total*p%nodes_per_elem,'p%NdIndxInverse',ErrStat2,ErrMsg2) ! same size as y%BldMotion%NNodes + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL AllocAry(p%OutNd2NdElem,2,p%node_total,'p%OutNd2NdElem',ErrStat2,ErrMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) if (ErrStat >= AbortErrLev) return @@ -923,18 +991,24 @@ subroutine SetParameters(InitInp, InputFileData, p, ErrStat, ErrMsg) p%OutNd2NdElem(:,1) = 1 ! note this is an array indx = 2 DO i=1,p%elem_total + p%NdIndxInverse((i-1)*p%nodes_per_elem + 1) = indx-1 ! Index into BldMotion mesh (to number the nodes for output without using collocated nodes) + DO j=2,p%nodes_per_elem ! GLL nodes overlap at element end points; we will skip the first node of each element (after the first one) p%NdIndx(indx) = (i-1)*p%nodes_per_elem + j ! Index into BldMotion mesh (to number the nodes for output without using collocated nodes) + p%NdIndxInverse(p%NdIndx(indx)) = indx ! Index from BldMotion mesh (to number of unique nodes) p%OutNd2NdElem(1,indx) = j ! Node number. To go from an output node number to a node/elem pair p%OutNd2NdElem(2,indx) = i ! Element number. To go from an output node number to a node/elem pair indx = indx + 1 END DO ENDDO - + CASE (BD_MESH_QP) + IF (p%quadrature .EQ. GAUSS_QUADRATURE) THEN nUniqueQP = p%nqp*p%elem_total + 2*p%qp_indx_offset - + + CALL AllocAry(p%NdIndxInverse, nUniqueQP,'p%NdIndxInverse',ErrStat2,ErrMsg2) ! same size as y%BldMotion%NNodes, a sibling of u%DistrLoad + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL AllocAry(p%NdIndx, nUniqueQP,'p%NdIndx',ErrStat2,ErrMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL AllocAry(p%OutNd2NdElem,2,nUniqueQP,'p%OutNd2NdElem',ErrStat2,ErrMsg2) @@ -943,6 +1017,7 @@ subroutine SetParameters(InitInp, InputFileData, p, ErrStat, ErrMsg) DO i=1,nUniqueQP ! gauss quadrature doesn't have overlapping nodes p%NdIndx(i) = i + p%NdIndxInverse(i) = i END DO indx = 2 @@ -960,7 +1035,9 @@ subroutine SetParameters(InitInp, InputFileData, p, ErrStat, ErrMsg) ELSEIF(p%quadrature .EQ. TRAP_QUADRATURE) THEN ! at least one quadrature point associated with each blade station nUniqueQP = (p%nqp-1)*p%elem_total + 1 - + + CALL AllocAry(p%NdIndxInverse, nUniqueQP,'p%NdIndxInverse',ErrStat2,ErrMsg2) ! same size as y%BldMotion%NNodes, a sibling of u%DistrLoad + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL AllocAry(p%NdIndx, nUniqueQP,'p%NdIndx',ErrStat2,ErrMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL AllocAry(p%OutNd2NdElem,2,nUniqueQP,'p%OutNd2NdElem',ErrStat2,ErrMsg2) @@ -973,6 +1050,7 @@ subroutine SetParameters(InitInp, InputFileData, p, ErrStat, ErrMsg) DO i=1,p%elem_total DO j=2,p%nqp ! trap quadrature contains overlapping nodes at element end points; we will skip the first node of each element (after the first one) p%NdIndx(indx) = (i-1)*p%nqp + j ! Index into BldMotion mesh (to number the nodes for output without using collocated nodes) + p%NdIndxInverse(p%NdIndx(indx)) = indx ! Index from BldMotion mesh p%OutNd2NdElem(1,indx) = j ! Node number. To go from an output node number to a node/elem pair p%OutNd2NdElem(2,indx) = i ! Element number. To go from an output node number to a node/elem pair indx = indx + 1; @@ -1020,6 +1098,10 @@ subroutine SetParameters(InitInp, InputFileData, p, ErrStat, ErrMsg) if (ErrStat >= AbortErrLev) return + call BldNdOuts_SetParameters(InitInp, InputFileData, p, ErrStat2, ErrMsg2 ) ! requires p%BldNd_NumOuts, y%BldMotion + call setErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat >= AbortErrLev) return + end subroutine SetParameters !----------------------------------------------------------------------------------------------------------------------------------- !> this routine initializes the outputs, y, that are used in the BeamDyn interface for coupling in the FAST framework. @@ -1156,13 +1238,16 @@ subroutine Init_y( p, u, y, ErrStat, ErrMsg) CALL SetErrStat(ErrID_Fatal, "Invalid p%BldMotionNodeLoc.", ErrStat, ErrMsg, RoutineName ) END SELECT + y%BldMotion%RefNode = 1 !................................. ! y%WriteOutput (for writing columns to output file) !................................. - call AllocAry( y%WriteOutput, p%numOuts, 'WriteOutput', errStat2, errMsg2 ) + ! p%BldNd_BlOutNd contains the list of nodes we are outputting. + + call AllocAry( y%WriteOutput, p%numOuts + p%BldNd_TotNumOuts, 'WriteOutput', errStat2, errMsg2 ) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) end subroutine Init_y @@ -1409,7 +1494,7 @@ subroutine Init_u( InitInp, p, u, ErrStat, ErrMsg ) CALL MeshCommit ( Mesh = u%DistrLoad & ,ErrStat = ErrStat2 & ,ErrMess = ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SetErrStat( ErrStat2, 'u%DistrLoad'//ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! initial guesses u%DistrLoad%Force = 0.0_ReKi @@ -1784,7 +1869,7 @@ END SUBROUTINE BD_UpdateStates !----------------------------------------------------------------------------------------------------------------------------------- !> Routine for computing outputs, used in both loose and tight coupling. -SUBROUTINE BD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) +SUBROUTINE BD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, NeedWriteOutput ) REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds TYPE(BD_InputType), INTENT(INOUT) :: u !< Inputs at t @@ -1798,6 +1883,7 @@ SUBROUTINE BD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) 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 + LOGICAL, OPTIONAL, INTENT(IN ) :: NeedWriteOutput !< Flag to determine if WriteOutput values need to be calculated in this call TYPE(BD_ContinuousStateType) :: x_tmp TYPE(BD_OtherStateType) :: OtherState_tmp @@ -1807,13 +1893,20 @@ 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 - + ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" AllOuts = 0.0_ReKi + + if (present(NeedWriteOutput)) then + CalcWriteOutput = NeedWriteOutput + else + CalcWriteOutput = .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. CALL BD_CopyContState(x, x_tmp, MESH_NEWCOPY, ErrStat2, ErrMsg2) @@ -1912,19 +2005,31 @@ 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 ) !uses m%u2 + call Calc_WriteOutput( p, AllOuts, y, m, ErrStat2, ErrMsg2, CalcWriteOutput ) !uses m%u2 CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) y%RootMxr = AllOuts( RootMxr ) y%RootMyr = AllOuts( RootMyr ) - !............................................................................................................................... - ! Place the selected output channels into the WriteOutput(:) array with the proper sign: - !............................................................................................................................... + if (CalcWriteOutput) then + !............................................................................................................................... + ! Place the selected output channels into the WriteOutput(:) array with the proper sign: + !............................................................................................................................... + + do i = 1,p%NumOuts ! Loop through all selected output channels + y%WriteOutput(i) = p%OutParam(i)%SignM * AllOuts( p%OutParam(i)%Indx ) + end do ! i - All selected output channels - do i = 1,p%NumOuts ! Loop through all selected output channels - y%WriteOutput(i) = p%OutParam(i)%SignM * AllOuts( p%OutParam(i)%Indx ) - end do ! i - All selected output channels + + IF( p%BldNd_NumOuts > 0 ) THEN + ! Put the values from the nodal outputs into the writeoutput array + y%WriteOutput(p%NumOuts+1:) = 0.0_ReKi + + ! Now we need to populate the blade node outputs here + call Calc_WriteBldNdOutput( p, m, y, ErrStat2, ErrMsg2 ) ! Call after normal writeoutput. Will just postpend data on here. + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ENDIF + end if call cleanup() @@ -6677,7 +6782,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 ) +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, NeedLogMap ) 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) @@ -6696,6 +6801,7 @@ SUBROUTINE BD_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 + LOGICAL, OPTIONAL, INTENT(IN ) :: NeedLogMap !< whether a y_op values should contain log maps instead of full orientation matrices INTEGER(IntKi) :: index, i, dof INTEGER(IntKi) :: nu @@ -6704,6 +6810,7 @@ SUBROUTINE BD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'BD_GetOP' LOGICAL :: FieldMask(FIELDMASK_SIZE) + LOGICAL :: ReturnLogMap TYPE(BD_ContinuousStateType) :: dx ! derivative of continuous states at operating point @@ -6740,10 +6847,15 @@ SUBROUTINE BD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, IF ( PRESENT( y_op ) ) THEN + if (present(NeedLogMap)) then + ReturnLogMap = NeedLogMap + else + ReturnLogMap = .false. + end if - 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) - 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 @@ -6760,10 +6872,10 @@ SUBROUTINE BD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, FieldMask(MASKID_RotationVel) = .true. FieldMask(MASKID_TranslationAcc) = .true. FieldMask(MASKID_RotationAcc) = .true. - call PackMotionMesh(y%BldMotion, y_op, index, FieldMask=FieldMask) + call PackMotionMesh(y%BldMotion, y_op, index, FieldMask=FieldMask, UseLogMaps=ReturnLogMap) index = index - 1 - do i=1,p%NumOuts + do i=1,p%NumOuts + p%BldNd_TotNumOuts y_op(i+index) = y%WriteOutput(i) end do diff --git a/modules/beamdyn/src/BeamDyn_BldNdOuts_IO.f90 b/modules/beamdyn/src/BeamDyn_BldNdOuts_IO.f90 new file mode 100644 index 0000000000..569deb518c --- /dev/null +++ b/modules/beamdyn/src/BeamDyn_BldNdOuts_IO.f90 @@ -0,0 +1,1496 @@ +! This module is an add on to BeamDyn to allow output of data at each blade node. +! +! Copyright (C) 2016-2017 Envision Energy USA, LTD +! +MODULE BeamDyn_BldNdOuts_IO + + USE NWTC_Library + USE NWTC_LAPACK + USE BeamDyn_Subs + USE BeamDyn_Types + + IMPLICIT NONE + + PRIVATE + + + ! Outstanding issues + ! 1. Currently nothing is added to the summary file. If we add some output there, some changes either in the BeamDyn + ! code (as distributed) will be needed, or changes here (reopen file and append). + + + PUBLIC :: BldNdOuts_InitOut + PUBLIC :: Calc_WriteBldNdOutput + PUBLIC :: BldNdOuts_SetParameters + + + + ! Parameters related to output length (number of characters allowed in the output data headers): + + INTEGER(IntKi), PARAMETER :: OutStrLenM1 = ChanLen-5 ! We are making these of the form B1_Z######y_quantity, but note that the glue code adds the "B1_" (turbine component) part + +! =================================================================================================== +! NOTE: The following lines of code were generated by a Matlab script called "Write_ChckOutLst.m" +! using the parameters listed in the "OutListParameters.xlsx" Excel file. Any changes to these +! lines should be modified in the Matlab script and/or Excel worksheet as necessary. +! =================================================================================================== +! This code was generated by Write_ChckOutLst.m at 12-Dec-2017 20:48:14. + + ! NOTES: + ! (1) These parameters are in the order stored in "OutListParameters.xlsx" + + + ! Sectional Loads: + + INTEGER(IntKi), PARAMETER :: BldNd_FxL = 1 + INTEGER(IntKi), PARAMETER :: BldNd_FyL = 2 + INTEGER(IntKi), PARAMETER :: BldNd_FzL = 3 + INTEGER(IntKi), PARAMETER :: BldNd_MxL = 4 + INTEGER(IntKi), PARAMETER :: BldNd_MyL = 5 + INTEGER(IntKi), PARAMETER :: BldNd_MzL = 6 + INTEGER(IntKi), PARAMETER :: BldNd_Fxr = 7 + INTEGER(IntKi), PARAMETER :: BldNd_Fyr = 8 + INTEGER(IntKi), PARAMETER :: BldNd_Fzr = 9 + INTEGER(IntKi), PARAMETER :: BldNd_Mxr = 10 + INTEGER(IntKi), PARAMETER :: BldNd_Myr = 11 + INTEGER(IntKi), PARAMETER :: BldNd_Mzr = 12 + + + ! Sectional Motions: + + INTEGER(IntKi), PARAMETER :: BldNd_TDxr = 13 + INTEGER(IntKi), PARAMETER :: BldNd_TDyr = 14 + INTEGER(IntKi), PARAMETER :: BldNd_TDzr = 15 + INTEGER(IntKi), PARAMETER :: BldNd_RDxr = 16 + INTEGER(IntKi), PARAMETER :: BldNd_RDyr = 17 + INTEGER(IntKi), PARAMETER :: BldNd_RDzr = 18 + INTEGER(IntKi), PARAMETER :: BldNd_AbsXg = 19 + INTEGER(IntKi), PARAMETER :: BldNd_AbsYg = 20 + INTEGER(IntKi), PARAMETER :: BldNd_AbsZg = 21 + INTEGER(IntKi), PARAMETER :: BldNd_AbsXr = 22 + INTEGER(IntKi), PARAMETER :: BldNd_AbsYr = 23 + INTEGER(IntKi), PARAMETER :: BldNd_AbsZr = 24 + INTEGER(IntKi), PARAMETER :: BldNd_TVxg = 25 + INTEGER(IntKi), PARAMETER :: BldNd_TVyg = 26 + INTEGER(IntKi), PARAMETER :: BldNd_TVzg = 27 + INTEGER(IntKi), PARAMETER :: BldNd_TVxl = 28 + INTEGER(IntKi), PARAMETER :: BldNd_TVyl = 29 + INTEGER(IntKi), PARAMETER :: BldNd_TVzl = 30 + INTEGER(IntKi), PARAMETER :: BldNd_TVxr = 31 + INTEGER(IntKi), PARAMETER :: BldNd_TVyr = 32 + INTEGER(IntKi), PARAMETER :: BldNd_TVzr = 33 + INTEGER(IntKi), PARAMETER :: BldNd_RVxg = 34 + INTEGER(IntKi), PARAMETER :: BldNd_RVyg = 35 + INTEGER(IntKi), PARAMETER :: BldNd_RVzg = 36 + INTEGER(IntKi), PARAMETER :: BldNd_RVxl = 37 + INTEGER(IntKi), PARAMETER :: BldNd_RVyl = 38 + INTEGER(IntKi), PARAMETER :: BldNd_RVzl = 39 + INTEGER(IntKi), PARAMETER :: BldNd_RVxr = 40 + INTEGER(IntKi), PARAMETER :: BldNd_RVyr = 41 + INTEGER(IntKi), PARAMETER :: BldNd_RVzr = 42 + INTEGER(IntKi), PARAMETER :: BldNd_TAxl = 43 + INTEGER(IntKi), PARAMETER :: BldNd_TAyl = 44 + INTEGER(IntKi), PARAMETER :: BldNd_TAzl = 45 + INTEGER(IntKi), PARAMETER :: BldNd_TAxr = 46 + INTEGER(IntKi), PARAMETER :: BldNd_TAyr = 47 + INTEGER(IntKi), PARAMETER :: BldNd_TAzr = 48 + INTEGER(IntKi), PARAMETER :: BldNd_RAxl = 49 + INTEGER(IntKi), PARAMETER :: BldNd_RAyl = 50 + INTEGER(IntKi), PARAMETER :: BldNd_RAzl = 51 + INTEGER(IntKi), PARAMETER :: BldNd_RAxr = 52 + INTEGER(IntKi), PARAMETER :: BldNd_RAyr = 53 + INTEGER(IntKi), PARAMETER :: BldNd_RAzr = 54 + + ! Applied Loads: + + INTEGER(IntKi), PARAMETER :: BldNd_PFxL = 55 + INTEGER(IntKi), PARAMETER :: BldNd_PFyL = 56 + INTEGER(IntKi), PARAMETER :: BldNd_PFzL = 57 + INTEGER(IntKi), PARAMETER :: BldNd_PMxL = 58 + INTEGER(IntKi), PARAMETER :: BldNd_PMyL = 59 + INTEGER(IntKi), PARAMETER :: BldNd_PMzL = 60 + INTEGER(IntKi), PARAMETER :: BldNd_DFxL = 61 + INTEGER(IntKi), PARAMETER :: BldNd_DFyL = 62 + INTEGER(IntKi), PARAMETER :: BldNd_DFzL = 63 + INTEGER(IntKi), PARAMETER :: BldNd_DMxL = 64 + INTEGER(IntKi), PARAMETER :: BldNd_DMyL = 65 + INTEGER(IntKi), PARAMETER :: BldNd_DMzL = 66 + INTEGER(IntKi), PARAMETER :: BldNd_DFxR = 67 + INTEGER(IntKi), PARAMETER :: BldNd_DFyR = 68 + INTEGER(IntKi), PARAMETER :: BldNd_DFzR = 69 + INTEGER(IntKi), PARAMETER :: BldNd_DMxR = 70 + INTEGER(IntKi), PARAMETER :: BldNd_DMyR = 71 + INTEGER(IntKi), PARAMETER :: BldNd_DMzR = 72 + + + ! Sectional Partial Loads (debugging): + + INTEGER(IntKi), PARAMETER :: BldNd_FFbxl = 73 + INTEGER(IntKi), PARAMETER :: BldNd_FFbyl = 74 + INTEGER(IntKi), PARAMETER :: BldNd_FFbzl = 75 + INTEGER(IntKi), PARAMETER :: BldNd_FFbxr = 76 + INTEGER(IntKi), PARAMETER :: BldNd_FFbyr = 77 + INTEGER(IntKi), PARAMETER :: BldNd_FFbzr = 78 + INTEGER(IntKi), PARAMETER :: BldNd_MFbxl = 79 + INTEGER(IntKi), PARAMETER :: BldNd_MFbyl = 80 + INTEGER(IntKi), PARAMETER :: BldNd_MFbzl = 81 + INTEGER(IntKi), PARAMETER :: BldNd_MFbxr = 82 + INTEGER(IntKi), PARAMETER :: BldNd_MFbyr = 83 + INTEGER(IntKi), PARAMETER :: BldNd_MFbzr = 84 + INTEGER(IntKi), PARAMETER :: BldNd_FFcxl = 85 + INTEGER(IntKi), PARAMETER :: BldNd_FFcyl = 86 + INTEGER(IntKi), PARAMETER :: BldNd_FFczl = 87 + INTEGER(IntKi), PARAMETER :: BldNd_FFcxr = 88 + INTEGER(IntKi), PARAMETER :: BldNd_FFcyr = 89 + INTEGER(IntKi), PARAMETER :: BldNd_FFczr = 90 + INTEGER(IntKi), PARAMETER :: BldNd_MFcxl = 91 + INTEGER(IntKi), PARAMETER :: BldNd_MFcyl = 92 + INTEGER(IntKi), PARAMETER :: BldNd_MFczl = 93 + INTEGER(IntKi), PARAMETER :: BldNd_MFcxr = 94 + INTEGER(IntKi), PARAMETER :: BldNd_MFcyr = 95 + INTEGER(IntKi), PARAMETER :: BldNd_MFczr = 96 + INTEGER(IntKi), PARAMETER :: BldNd_FFdxl = 97 + INTEGER(IntKi), PARAMETER :: BldNd_FFdyl = 98 + INTEGER(IntKi), PARAMETER :: BldNd_FFdzl = 99 + INTEGER(IntKi), PARAMETER :: BldNd_FFdxr = 100 + INTEGER(IntKi), PARAMETER :: BldNd_FFdyr = 101 + INTEGER(IntKi), PARAMETER :: BldNd_FFdzr = 102 + INTEGER(IntKi), PARAMETER :: BldNd_MFdxl = 103 + INTEGER(IntKi), PARAMETER :: BldNd_MFdyl = 104 + INTEGER(IntKi), PARAMETER :: BldNd_MFdzl = 105 + INTEGER(IntKi), PARAMETER :: BldNd_MFdxr = 106 + INTEGER(IntKi), PARAMETER :: BldNd_MFdyr = 107 + INTEGER(IntKi), PARAMETER :: BldNd_MFdzr = 108 + INTEGER(IntKi), PARAMETER :: BldNd_FFgxl = 109 + INTEGER(IntKi), PARAMETER :: BldNd_FFgyl = 110 + INTEGER(IntKi), PARAMETER :: BldNd_FFgzl = 111 + INTEGER(IntKi), PARAMETER :: BldNd_FFgxr = 112 + INTEGER(IntKi), PARAMETER :: BldNd_FFgyr = 113 + INTEGER(IntKi), PARAMETER :: BldNd_FFgzr = 114 + INTEGER(IntKi), PARAMETER :: BldNd_MFgxl = 115 + INTEGER(IntKi), PARAMETER :: BldNd_MFgyl = 116 + INTEGER(IntKi), PARAMETER :: BldNd_MFgzl = 117 + INTEGER(IntKi), PARAMETER :: BldNd_MFgxr = 118 + INTEGER(IntKi), PARAMETER :: BldNd_MFgyr = 119 + INTEGER(IntKi), PARAMETER :: BldNd_MFgzr = 120 + INTEGER(IntKi), PARAMETER :: BldNd_FFixl = 121 + INTEGER(IntKi), PARAMETER :: BldNd_FFiyl = 122 + INTEGER(IntKi), PARAMETER :: BldNd_FFizl = 123 + INTEGER(IntKi), PARAMETER :: BldNd_FFixr = 124 + INTEGER(IntKi), PARAMETER :: BldNd_FFiyr = 125 + INTEGER(IntKi), PARAMETER :: BldNd_FFizr = 126 + INTEGER(IntKi), PARAMETER :: BldNd_MFixl = 127 + INTEGER(IntKi), PARAMETER :: BldNd_MFiyl = 128 + INTEGER(IntKi), PARAMETER :: BldNd_MFizl = 129 + INTEGER(IntKi), PARAMETER :: BldNd_MFixr = 130 + INTEGER(IntKi), PARAMETER :: BldNd_MFiyr = 131 + INTEGER(IntKi), PARAMETER :: BldNd_MFizr = 132 + + ! The maximum number of output channels which can be output by the code. + INTEGER(IntKi), PARAMETER, PUBLIC :: BldNd_MaxOutPts = 132 + +!End of code generated by Matlab script +! =================================================================================================== + +CONTAINS +!---------------------------------------------------------------------------------------------------------------------------------- + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This subroutine populates the headers with the blade node outputs. The iteration cycle is blade:node:channel (channel iterated +!! fastest). If this iteration order is changed, it should be changed in the Calc_WriteBldNdOutput routine as well. +SUBROUTINE BldNdOuts_InitOut( InitOut, p, ErrStat, ErrMsg ) + + + TYPE(BD_InitOutputType), INTENT(INOUT) :: InitOut ! output data + TYPE(BD_ParameterType), INTENT(IN ) :: p ! The module parameters + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! The error status code + CHARACTER(*), INTENT( OUT) :: ErrMsg ! The error message, if an error occurred + + INTEGER(IntKi) :: ErrStat2 ! Error status code + INTEGER(IntKi) :: INDX ! Index count within WriteOutput + INTEGER(IntKi) :: IdxNode ! Counter to the blade node we ae on + INTEGER(IntKi) :: IdxChan ! Counter to the channel we are outputting. + CHARACTER(1) :: ChanPrefix ! Name prefix (B#_ -- note that the B# part is added in FAST, not here) + CHARACTER(3), ALLOCATABLE :: DistStr(:) ! Array of prefix (Z######y) + CHARACTER(2) :: TmpChar ! Temporary char array to hold the node digits (2 places only!!!!) + CHARACTER(*), PARAMETER :: RoutineName = ('BldNdOuts_InitOut') + + + ! Initialize some things + ErrMsg = '' + ErrStat = ErrID_None + + + IF ( p%BldNd_NumOuts == 0 ) THEN + return + ENDIF + + ! create the channel names using the z-coordinate of the beam in mm + ALLOCATE( DistStr(size(p%BldNd_BlOutNd)), STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + call SetErrStat(ErrID_Fatal, 'Error allocating DistStr array.', ErrStat, ErrMsg, RoutineName) + return + END IF + + ! Warn if we will run into issues with more than 999999 nodes. + IF (p%node_total > 99 ) CALL SetErrStat(ErrID_Severe,'More than 99 blade nodes in use. Output channel headers will not '// & + 'correctly reflect blade stations beyond 99. Modifications to the variable ChanLen in FAST are required.',ErrStat,ErrMsg,RoutineName) + + DO IdxNode=1,size(p%BldNd_BlOutNd) + ! Create the name prefix: + WRITE (TmpChar,'(I2.2)') IdxNode + DistStr(IdxNode) = 'N' // TmpChar + END DO + + + ! Populate the header an unit lines for all blades and nodes + ! First set a counter so we know where in the output array we are in + INDX = p%NumOuts + 1 ! p%NumOuts is the number of outputs from the normal BeamDyn output. The WriteOutput array is sized to p%NumOuts + num(BldNdOuts) + + +! ChanPrefix = '_' !newer names have underscore character to deliniate between sections + ChanPrefix = '' + ! Loop through all the outputs we requested here: + DO IdxChan=1,p%BldNd_NumOuts + + DO IdxNode=1,size(p%BldNd_BlOutNd) + + ! Now write to the header + InitOut%WriteOutputHdr(INDX) = TRIM(ChanPrefix) // TRIM(DistStr(IdxNode)) // p%BldNd_OutParam(IdxChan)%Name + InitOut%WriteOutputUnt(INDX) = p%BldNd_OutParam(IdxChan)%Units + + ! Increment the index to the Header arrays + INDX = INDX + 1 + + ENDDO + + ENDDO + + IF (ALLOCATED(DistStr)) DEALLOCATE(DistStr) + + +END SUBROUTINE BldNdOuts_InitOut + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This subroutine populates the headers with the blade node outputs. The iteration cycle is blade:node:channel (channel iterated +!! fastest). If this iteration order is changed, it should be changed in the Calc_WriteBldNdOutput routine as well. +SUBROUTINE Calc_WriteBldNdOutput( p, m, y, ErrStat, ErrMsg ) + TYPE(BD_ParameterType), INTENT(IN ) :: p ! The module parameters + TYPE(BD_MiscVarType), INTENT(INOUT) :: m ! misc variables + TYPE(BD_OutputType), INTENT(INOUT) :: y ! outputs + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! The error status code + CHARACTER(*), INTENT( OUT) :: ErrMsg ! The error message, if an error occurred + + ! local variables + INTEGER(IntKi) :: IdxOutList ! Index within WriteOutput + INTEGER(IntKi) :: IdxChan ! Counter to the channel we are outputting. + CHARACTER(*), PARAMETER :: RoutineName = 'Calc_WriteBldNdOutput' + + + ! temporary variables for calculation + INTEGER(IntKi) :: idx_node_in_elem ! node on current element + INTEGER(IntKi) :: nelem ! current element + INTEGER(IntKi) :: idx_node ! Counter to the blade node we are on + INTEGER(IntKi) :: compIndx ! index for array component (x,y,z) + REAL(BDKi) :: BladeLocalOrient(3,3) ! Local blade orientation matrix + REAL(BDKi) :: Tmp33a(3,3) ! Temporary 3x4 for orientation calcs + REAL(BDKi) :: Tmp33b(3,3) ! Temporary 3x4 for orientation calcs + REAL(BDKi) :: ThetaYXZabs(3) ! Tait-Bryan absolute values for Cant, Toe, Twist angles + REAL(BDKi) :: ThetaYXZrd(3) ! Tait-Bryan reltative change in Cant, Toe, Twist angles + + REAL(BDKi) :: WM_ParamRD(3) ! Wiener Milenkovic parameters for current node, in Global coordinates + REAL(BDKi) :: temp_vec(3) ! temporary vector for orientation info. + REAL(BDKi) :: temp_vec2(3) ! temporary vector for orientation info. + REAL(BDKi) :: temp_vec3(3) ! temporary vector for orientation info. + REAL(BDKi) :: d_ref(3) ! root displacement + REAL(BDKi) :: d(3) ! displacement + + ! WM param finding + REAL(BDKi) :: RootRelOrient(3,3) + + ! Error handling + INTEGER(IntKi) :: ErrStat2 ! Temporary Error status + CHARACTER(ErrMsgLen) :: ErrMsg2 ! Temporary Error message + + + ! Initialize some things + ErrMsg = '' + ErrStat = ErrID_None + + IF ( p%BldNd_NumOuts == 0 ) THEN + return + ENDIF + + + ! Set the root rotation DCM relative to the reference. + ! NOTE: the orientations used in this routine are DCM's. These are directly from the mesh. + call LAPACK_DGEMM('T', 'N', 1.0_BDKi, m%u2%RootMotion%Orientation(:,:,1), m%u2%RootMotion%RefOrientation(:,:,1), 0.0_BDKi, RootRelOrient, ErrStat2, ErrMsg2 ) + + + ! Loop over the channel sets + DO IdxChan=1,p%BldNd_NumOuts + + + ! Case to assign output to this channel and populate based on Indx value (this indicates what the channel is) + ! Logic and mathematics used here come from Calc_WriteOutput + + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + + CASE (0) ! This is an invalid channel so we'll just skip it + CYCLE + + !---------------------------------------- + ! Sectional translational locations and deflections (relative to the undeflected position) expressed in g + CASE (BldNd_AbsXg,BldNd_AbsYg,BldNd_AbsZg) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) + CASE (BldNd_AbsXg) + compIndx = 1 + CASE (BldNd_AbsYg) + compIndx = 2 + CASE (BldNd_AbsZg) + compIndx = 3 + END SELECT + + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + d = y%BldMotion%TranslationDisp(:, idx_node) + d_ref = y%BldMotion%Position( :, idx_node) + ! For actual global location + temp_vec = d + d_ref + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + !---------------------------------------- + ! Sectional translational locations and deflections (relative to the undeflected position) expressed in r + CASE (BldNd_TDxr,BldNd_TDyr,BldNd_TDzr,BldNd_AbsXr,BldNd_AbsYr,BldNd_AbsZr) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + d = y%BldMotion%TranslationDisp(:, idx_node) - m%u2%RootMotion%TranslationDisp(:,1) + d_ref = y%BldMotion%Position( :, idx_node) - m%u2%RootMotion%Position( :,1) + ! For relative change in location + temp_vec2 = d + d_ref - matmul( RootRelOrient, d_ref ) + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1),temp_vec2) + ! For actual location relative to root + temp_vec2 = d + d_ref + temp_vec3 = MATMUL(m%u2%RootMotion%Orientation(:,:,1),temp_vec2) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (BldNd_TDxr) + y%WriteOutput( IdxOutList ) = temp_vec(1) + CASE (BldNd_TDyr) + y%WriteOutput( IdxOutList ) = temp_vec(2) + CASE (BldNd_TDzr) + y%WriteOutput( IdxOutList ) = temp_vec(3) + CASE (BldNd_AbsXr) + y%WriteOutput( IdxOutList ) = temp_vec3(1) + CASE (BldNd_AbsYr) + y%WriteOutput( IdxOutList ) = temp_vec3(2) + CASE (BldNd_AbsZr) + y%WriteOutput( IdxOutList ) = temp_vec3(3) + END SELECT + ENDDO + + + + !---------------------------------------- + ! Rotational displacements as W-M parameters + CASE ( BldNd_RDxr, BldNd_RDyr, BldNd_RDzr ) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) + CASE (BldNd_RDxr) + compIndx = 1 + CASE (BldNd_RDyr) + compIndx = 2 + CASE (BldNd_RDzr) + compIndx = 3 + END SELECT + + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + + !------------------------- +!FIXME: we are not trapping errors here. Do we need to? + ! Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) expressed in r + call LAPACK_DGEMM('N', 'T', 1.0_BDKi, y%BldMotion%RefOrientation(:,:,idx_node), RootRelOrient, 0.0_BDKi, Tmp33b, ErrStat2, ErrMsg2 ) + call LAPACK_DGEMM('T', 'N', 1.0_BDKi, y%BldMotion%Orientation( :,:,idx_node), Tmp33b, 0.0_BDKi, Tmp33a, ErrStat2, ErrMsg2 ) + call BD_CrvExtractCrv(Tmp33a,temp_vec2, ErrStat2, ErrMsg2) ! temp_vec2 = the Wiener-Milenkovic parameters of the node's angular/rotational defelctions + WM_ParamRD = MATMUL(m%u2%RootMotion%Orientation(:,:,1),temp_vec2) ! Rotate the parameters to the correct coordinate system for output + + y%WriteOutput( IdxOutList ) = WM_ParamRD(compIndx) + END DO + + + !---------------------------------------- + ! Translational Velocities, global frame + CASE (BldNd_TVxg) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + y%WriteOutput( IdxOutList ) = y%BldMotion%TranslationVel(1,idx_node) + ENDDO + CASE (BldNd_TVyg) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + y%WriteOutput( IdxOutList ) = y%BldMotion%TranslationVel(2,idx_node) + ENDDO + CASE (BldNd_TVzg) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + y%WriteOutput( IdxOutList ) = y%BldMotion%TranslationVel(3,idx_node) + ENDDO + !---------------------------------------- + ! Rotational Velocities, global frame + CASE (BldNd_RVxg) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + y%WriteOutput( IdxOutList ) = y%BldMotion%RotationVel(1,idx_node) * R2D + ENDDO + CASE (BldNd_RVyg) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + y%WriteOutput( IdxOutList ) = y%BldMotion%RotationVel(2,idx_node) * R2D + ENDDO + CASE (BldNd_RVzg) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + y%WriteOutput( IdxOutList ) = y%BldMotion%RotationVel(3,idx_node) * R2D + ENDDO + + + !---------------------------------------- + ! Translational Velocities, local frame + CASE (BldNd_TVxl,BldNd_TVyl,BldNd_TVzl) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) + CASE (BldNd_TVxl) + compIndx = 1 + CASE (BldNd_TVyl) + compIndx = 2 + CASE (BldNd_TVzl) + compIndx = 3 + END SELECT + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node),y%BldMotion%TranslationVel(:,idx_node)) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + !---------------------------------------- + ! Rotational Velocities, local frame + CASE (BldNd_RVxl,BldNd_RVyl,BldNd_RVzl) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) + CASE (BldNd_RVxl) + compIndx = 1 + CASE (BldNd_RVyl) + compIndx = 2 + CASE (BldNd_RVzl) + compIndx = 3 + END SELECT + + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node),y%BldMotion%RotationVel(:,idx_node)) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx)*R2D + ENDDO + + + !---------------------------------------- + ! Translational Velocities, root frame + CASE (BldNd_TVxr,BldNd_TVyr,BldNd_TVzr) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) + CASE (BldNd_TVxr) + compIndx = 1 + CASE (BldNd_TVyr) + compIndx = 2 + CASE (BldNd_TVzr) + compIndx = 3 + END SELECT + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1),y%BldMotion%TranslationVel(:,idx_node)) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + !---------------------------------------- + ! Rotational Velocities, root frame + CASE (BldNd_RVxr,BldNd_RVyr,BldNd_RVzr) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) + CASE (BldNd_RVxr) + compIndx = 1 + CASE (BldNd_RVyr) + compIndx = 2 + CASE (BldNd_RVzr) + compIndx = 3 + END SELECT + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1),y%BldMotion%RotationVel(:,idx_node)) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx)*R2D + ENDDO + + + !---------------------------------------- + ! Translational Accelerations, local frame + CASE (BldNd_TAxl, BldNd_TAyl, BldNd_TAzl) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) + CASE (BldNd_TAxl) + compIndx = 1 + CASE (BldNd_TAyl) + compIndx = 2 + CASE (BldNd_TAzl) + compIndx = 3 + END SELECT + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node),y%BldMotion%TranslationAcc(:,idx_node)) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + !---------------------------------------- + ! Rotational Accelerations, local frame + CASE (BldNd_RAxl, BldNd_RAyl, BldNd_RAzl) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) + CASE (BldNd_RAxl) + compIndx = 1 + CASE (BldNd_RAyl) + compIndx = 2 + CASE (BldNd_RAzl) + compIndx = 3 + END SELECT + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node),y%BldMotion%RotationAcc(:,idx_node)) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx)*R2D + ENDDO + + + !---------------------------------------- + ! Translational Accelerations, root frame + CASE (BldNd_TAxr, BldNd_TAyr, BldNd_TAzr) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) + CASE (BldNd_TAxr) + compIndx = 1 + CASE (BldNd_TAyr) + compIndx = 2 + CASE (BldNd_TAzr) + compIndx = 3 + END SELECT + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1),y%BldMotion%TranslationAcc(:,idx_node)) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + !---------------------------------------- + ! Rotational Accelerations, root frame + CASE (BldNd_RAxr, BldNd_RAyr, BldNd_RAzr) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) + CASE (BldNd_RAxr) + compIndx = 1 + CASE (BldNd_RAyr) + compIndx = 2 + CASE (BldNd_RAzr) + compIndx = 3 + END SELECT + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1),y%BldMotion%RotationAcc(:,idx_node)) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx)*R2D + ENDDO + + !---------------------------------------- + ! Applied point forces, local coordinate system. Not used when coupled to FAST. + CASE (BldNd_PFxl,BldNd_PFyl,BldNd_PFzl) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) + CASE (BldNd_PFxl) + compIndx = 1 + CASE (BldNd_PFyl) + compIndx = 2 + CASE (BldNd_PFzl) + compIndx = 3 + END SELECT + if (p%BldMotionNodeLoc == BD_MESH_FE) THEN + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), m%u2%PointLoad%Force( :,p%NdIndxInverse(idx_node))) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + else ! we need to do a mesh mapping first +!FIXME: this is not implemented yet. + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes + y%WriteOutput( IdxOutList ) = 0.0_ReKi + ENDDO + end if + + !---------------------------------------- + ! Applied point moments, local coordinate system. Not used when coupled to FAST. + CASE (BldNd_PMxl, BldNd_PMyl, BldNd_PMzl) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) + CASE (BldNd_PMxl) + compIndx = 1 + CASE (BldNd_PMyl) + compIndx = 2 + CASE (BldNd_PMzl) + compIndx = 3 + END SELECT + DO idx_node=1,y%BldMotion%NNodes + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes + y%WriteOutput( IdxOutList ) = 0.0_ReKi + ENDDO + if (p%BldMotionNodeLoc == BD_MESH_FE) THEN + DO idx_node=1,y%BldMotion%NNodes + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), m%u2%PointLoad%Moment( :,p%NdIndxInverse(idx_node))) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + else ! we need to do a mesh mapping first +!FIXME: this is not implemented yet. + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes + y%WriteOutput( IdxOutList ) = 0.0_ReKi + ENDDO + end if + + !---------------------------------------- + ! Applied distributed forces (from AD15 when coupled to FAST), local frame + CASE (BldNd_DFxl,BldNd_DFyl,BldNd_DFzl) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) + CASE (BldNd_DFxl) + compIndx = 1 + CASE (BldNd_DFyl) + compIndx = 2 + CASE (BldNd_DFzl) + compIndx = 3 + END SELECT + if (p%BldMotionNodeLoc == BD_MESH_QP) THEN ! If we are on the quadrature points, the input and output meshes are siblings + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), m%u2%DistrLoad%Force( :,idx_node)) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + else + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), m%u_DistrLoad_at_y%Force( :,idx_node)) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + end if + !---------------------------------------- + ! Applied distributed moments (from AD15 when coupled to FAST), local frame + CASE (BldNd_DMxl,BldNd_DMyl,BldNd_DMzl) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) + CASE (BldNd_DMxl) + compIndx = 1 + CASE (BldNd_DMyl) + compIndx = 2 + CASE (BldNd_DMzl) + compIndx = 3 + END SELECT + if (p%BldMotionNodeLoc == BD_MESH_QP) THEN ! If we are on the quadrature points, the input and output meshes are siblings + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), m%u2%DistrLoad%Moment( :,idx_node)) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + else + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), m%u_DistrLoad_at_y%Moment( :,idx_node)) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + end if + + !---------------------------------------- + ! Applied distributed forces (from AD15 when coupled to FAST), root frame + CASE (BldNd_DFxr,BldNd_DFyr,BldNd_DFzr) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) + CASE (BldNd_DFxr) + compIndx = 1 + CASE (BldNd_DFyr) + compIndx = 2 + CASE (BldNd_DFzr) + compIndx = 3 + END SELECT + if (p%BldMotionNodeLoc == BD_MESH_QP) THEN ! If we are on the quadrature points, the input and output meshes are siblings + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), m%u2%DistrLoad%Force( :,idx_node)) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + else + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), m%u_DistrLoad_at_y%Force( :,idx_node)) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + end if + !---------------------------------------- + ! Applied distributed moments (from AD15 when coupled to FAST), root frame + CASE (BldNd_DMxr,BldNd_DMyr,BldNd_DMzr) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) + CASE (BldNd_DMxr) + compIndx = 1 + CASE (BldNd_DMyr) + compIndx = 2 + CASE (BldNd_DMzr) + compIndx = 3 + END SELECT + if (p%BldMotionNodeLoc == BD_MESH_QP) THEN ! If we are on the quadrature points, the input and output meshes are siblings + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), m%u2%DistrLoad%Moment( :,idx_node)) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + else + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), m%u_DistrLoad_at_y%Moment( :,idx_node)) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + end if + + + !---------------------------------------- + ! Internal Forces, local + CASE (BldNd_Fxl,BldNd_Fyl,BldNd_Fzl) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) + CASE (BldNd_Fxl) + compIndx = 1 + CASE (BldNd_Fyl) + compIndx = 2 + CASE (BldNd_Fzl) + compIndx = 3 + END SELECT + + if (p%BldMotionNodeLoc == BD_MESH_QP) then + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), m%BldInternalForceQP(1:3,p%NdIndxInverse(idx_node))) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + else + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), m%BldInternalForceFE(1:3,p%NdIndxInverse(idx_node))) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + end if + + !---------------------------------------- + ! Internal Moments, local + CASE (BldNd_Mxl,BldNd_Myl,BldNd_Mzl) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) + CASE (BldNd_Mxl) + compIndx = 1 + CASE (BldNd_Myl) + compIndx = 2 + CASE (BldNd_Mzl) + compIndx = 3 + END SELECT + if (p%BldMotionNodeLoc == BD_MESH_QP) then + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), m%BldInternalForceQP(4:6,p%NdIndxInverse(idx_node))) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + else + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), m%BldInternalForceFE(4:6,p%NdIndxInverse(idx_node))) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + end if + + !---------------------------------------- + ! Internal Forces, root frame + CASE (BldNd_Fxr,BldNd_Fyr,BldNd_Fzr) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) + CASE (BldNd_Fxr) + compIndx = 1 + CASE (BldNd_Fyr) + compIndx = 2 + CASE (BldNd_Fzr) + compIndx = 3 + END SELECT + if (p%BldMotionNodeLoc == BD_MESH_QP) then + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), m%BldInternalForceQP(1:3,p%NdIndxInverse(idx_node))) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + else + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), m%BldInternalForceFE(1:3,p%NdIndxInverse(idx_node))) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + end if + + !---------------------------------------- + ! Internal Moments, root frame + CASE (BldNd_Mxr,BldNd_Myr,BldNd_Mzr) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) + CASE (BldNd_Mxr) + compIndx = 1 + CASE (BldNd_Myr) + compIndx = 2 + CASE (BldNd_Mzr) + compIndx = 3 + END SELECT + + if (p%BldMotionNodeLoc == BD_MESH_QP) then + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), m%BldInternalForceQP(4:6,p%NdIndxInverse(idx_node))) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + else + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), m%BldInternalForceFE(4:6,p%NdIndxInverse(idx_node))) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + end if + +!>>> The remaining loads outputs are for debugging, and are not valid with BD_MESH_FE. We cannot get here in that case. + !---------------------------------------- + ! Internal forces from CalcOutput, local frame + CASE (BldNd_FFbxl,BldNd_FFbyl,BldNd_FFbzl) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) + CASE (BldNd_FFbxl) + compIndx = 1 + CASE (BldNd_FFbyl) + compIndx = 2 + CASE (BldNd_FFbzl) + compIndx = 3 + END SELECT + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + nelem = p%OutNd2NdElem(2,idx_node) + idx_node_in_elem = p%OutNd2NdElem(1,idx_node) + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), MATMUL(p%GlbRot,m%qp%Fb(1:3,idx_node_in_elem,nelem))) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + CASE (BldNd_MFbxl,BldNd_MFbyl,BldNd_MFbzl) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + nelem = p%OutNd2NdElem(2,idx_node) + idx_node_in_elem = p%OutNd2NdElem(1,idx_node) + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), MATMUL(p%GlbRot,m%qp%Fb(4:6,idx_node_in_elem,nelem))) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (BldNd_MFbxl) ! Gyroscopic moment Fc about x, root frame + y%WriteOutput( IdxOutList ) = temp_vec(1) + CASE (BldNd_MFbyl) ! Gyroscopic moment Fc about y, root frame + y%WriteOutput( IdxOutList ) = temp_vec(2) + CASE (BldNd_MFbzl) ! Gyroscopic moment Fc about z, root frame + y%WriteOutput( IdxOutList ) = temp_vec(3) + END SELECT + ENDDO + + CASE (BldNd_FFcxl,BldNd_FFcyl,BldNd_FFczl) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + nelem = p%OutNd2NdElem(2,idx_node) + idx_node_in_elem = p%OutNd2NdElem(1,idx_node) + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), MATMUL(p%GlbRot,m%qp%Fc(1:3,idx_node_in_elem,nelem))) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (BldNd_FFcxl) ! Gyroscopic force Fc x, root frame + y%WriteOutput( IdxOutList ) = temp_vec(1) + CASE (BldNd_FFcyl) ! Gyroscopic force Fc y, root frame + y%WriteOutput( IdxOutList ) = temp_vec(2) + CASE (BldNd_FFczl) ! Gyroscopic force Fc z, root frame + y%WriteOutput( IdxOutList ) = temp_vec(3) + END SELECT + ENDDO + CASE (BldNd_MFcxl,BldNd_MFcyl,BldNd_MFczl) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + nelem = p%OutNd2NdElem(2,idx_node) + idx_node_in_elem = p%OutNd2NdElem(1,idx_node) + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), MATMUL(p%GlbRot,m%qp%Fc(4:6,idx_node_in_elem,nelem))) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (BldNd_MFcxl) ! Gyroscopic moment Fc about x, root frame + y%WriteOutput( IdxOutList ) = temp_vec(1) + CASE (BldNd_MFcyl) ! Gyroscopic moment Fc about y, root frame + y%WriteOutput( IdxOutList ) = temp_vec(2) + CASE (BldNd_MFczl) ! Gyroscopic moment Fc about z, root frame + y%WriteOutput( IdxOutList ) = temp_vec(3) + END SELECT + ENDDO + + CASE (BldNd_FFdxl,BldNd_FFdyl,BldNd_FFdzl) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + nelem = p%OutNd2NdElem(2,idx_node) + idx_node_in_elem = p%OutNd2NdElem(1,idx_node) + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), MATMUL(p%GlbRot,m%qp%Fd(1:3,idx_node_in_elem,nelem))) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (BldNd_FFdxl) ! Gyroscopic force Fc x, root frame + y%WriteOutput( IdxOutList ) = temp_vec(1) + CASE (BldNd_FFdyl) ! Gyroscopic force Fc y, root frame + y%WriteOutput( IdxOutList ) = temp_vec(2) + CASE (BldNd_FFdzl) ! Gyroscopic force Fc z, root frame + y%WriteOutput( IdxOutList ) = temp_vec(3) + END SELECT + ENDDO + CASE (BldNd_MFdxl,BldNd_MFdyl,BldNd_MFdzl) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + nelem = p%OutNd2NdElem(2,idx_node) + idx_node_in_elem = p%OutNd2NdElem(1,idx_node) + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), MATMUL(p%GlbRot,m%qp%Fd(4:6,idx_node_in_elem,nelem))) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (BldNd_MFdxl) ! Gyroscopic moment Fc about x, root frame + y%WriteOutput( IdxOutList ) = temp_vec(1) + CASE (BldNd_MFdyl) ! Gyroscopic moment Fc about y, root frame + y%WriteOutput( IdxOutList ) = temp_vec(2) + CASE (BldNd_MFdzl) ! Gyroscopic moment Fc about z, root frame + y%WriteOutput( IdxOutList ) = temp_vec(3) + END SELECT + ENDDO + + CASE (BldNd_FFgxl,BldNd_FFgyl,BldNd_FFgzl) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + nelem = p%OutNd2NdElem(2,idx_node) + idx_node_in_elem = p%OutNd2NdElem(1,idx_node) + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), MATMUL(p%GlbRot,m%qp%Fg(1:3,idx_node_in_elem,nelem))) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (BldNd_FFgxl) ! Gyroscopic force Fc x, root frame + y%WriteOutput( IdxOutList ) = temp_vec(1) + CASE (BldNd_FFgyl) ! Gyroscopic force Fc y, root frame + y%WriteOutput( IdxOutList ) = temp_vec(2) + CASE (BldNd_FFgzl) ! Gyroscopic force Fc z, root frame + y%WriteOutput( IdxOutList ) = temp_vec(3) + END SELECT + ENDDO + CASE (BldNd_MFgxl,BldNd_MFgyl,BldNd_MFgzl) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + nelem = p%OutNd2NdElem(2,idx_node) + idx_node_in_elem = p%OutNd2NdElem(1,idx_node) + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), MATMUL(p%GlbRot,m%qp%Fg(4:6,idx_node_in_elem,nelem))) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (BldNd_MFgxl) ! Gyroscopic moment Fc about x, root frame + y%WriteOutput( IdxOutList ) = temp_vec(1) + CASE (BldNd_MFgyl) ! Gyroscopic moment Fc about y, root frame + y%WriteOutput( IdxOutList ) = temp_vec(2) + CASE (BldNd_MFgzl) ! Gyroscopic moment Fc about z, root frame + y%WriteOutput( IdxOutList ) = temp_vec(3) + END SELECT + ENDDO + + + + !---------------------------------------- + ! Internal forces from CalcOutput, local frame + CASE (BldNd_FFbxr,BldNd_FFbyr,BldNd_FFbzr) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + nelem = p%OutNd2NdElem(2,idx_node) + idx_node_in_elem = p%OutNd2NdElem(1,idx_node) + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), MATMUL(p%GlbRot,m%qp%Fb(1:3,idx_node_in_elem,nelem))) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (BldNd_FFbxr) ! Gyroscopic force Fc x, root frame + y%WriteOutput( IdxOutList ) = temp_vec(1) + CASE (BldNd_FFbyr) ! Gyroscopic force Fc y, root frame + y%WriteOutput( IdxOutList ) = temp_vec(2) + CASE (BldNd_FFbzr) ! Gyroscopic force Fc z, root frame + y%WriteOutput( IdxOutList ) = temp_vec(3) + END SELECT + ENDDO + CASE (BldNd_MFbxr,BldNd_MFbyr,BldNd_MFbzr) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + nelem = p%OutNd2NdElem(2,idx_node) + idx_node_in_elem = p%OutNd2NdElem(1,idx_node) + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), MATMUL(p%GlbRot,m%qp%Fb(4:6,idx_node_in_elem,nelem))) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (BldNd_MFbxr) ! Gyroscopic moment Fc about x, root frame + y%WriteOutput( IdxOutList ) = temp_vec(1) + CASE (BldNd_MFbyr) ! Gyroscopic moment Fc about y, root frame + y%WriteOutput( IdxOutList ) = temp_vec(2) + CASE (BldNd_MFbzr) ! Gyroscopic moment Fc about z, root frame + y%WriteOutput( IdxOutList ) = temp_vec(3) + END SELECT + ENDDO + + CASE (BldNd_FFcxr,BldNd_FFcyr,BldNd_FFczr) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + nelem = p%OutNd2NdElem(2,idx_node) + idx_node_in_elem = p%OutNd2NdElem(1,idx_node) + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), MATMUL(p%GlbRot,m%qp%Fc(1:3,idx_node_in_elem,nelem))) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (BldNd_FFcxr) ! Gyroscopic force Fc x, root frame + y%WriteOutput( IdxOutList ) = temp_vec(1) + CASE (BldNd_FFcyr) ! Gyroscopic force Fc y, root frame + y%WriteOutput( IdxOutList ) = temp_vec(2) + CASE (BldNd_FFczr) ! Gyroscopic force Fc z, root frame + y%WriteOutput( IdxOutList ) = temp_vec(3) + END SELECT + ENDDO + CASE (BldNd_MFcxr,BldNd_MFcyr,BldNd_MFczr) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + nelem = p%OutNd2NdElem(2,idx_node) + idx_node_in_elem = p%OutNd2NdElem(1,idx_node) + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), MATMUL(p%GlbRot,m%qp%Fc(4:6,idx_node_in_elem,nelem))) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (BldNd_MFcxr) ! Gyroscopic moment Fc about x, root frame + y%WriteOutput( IdxOutList ) = temp_vec(1) + CASE (BldNd_MFcyr) ! Gyroscopic moment Fc about y, root frame + y%WriteOutput( IdxOutList ) = temp_vec(2) + CASE (BldNd_MFczr) ! Gyroscopic moment Fc about z, root frame + y%WriteOutput( IdxOutList ) = temp_vec(3) + END SELECT + ENDDO + + CASE (BldNd_FFdxr,BldNd_FFdyr,BldNd_FFdzr) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + nelem = p%OutNd2NdElem(2,idx_node) + idx_node_in_elem = p%OutNd2NdElem(1,idx_node) + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), MATMUL(p%GlbRot,m%qp%Fd(1:3,idx_node_in_elem,nelem))) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (BldNd_FFdxr) ! Gyroscopic force Fc x, root frame + y%WriteOutput( IdxOutList ) = temp_vec(1) + CASE (BldNd_FFdyr) ! Gyroscopic force Fc y, root frame + y%WriteOutput( IdxOutList ) = temp_vec(2) + CASE (BldNd_FFdzr) ! Gyroscopic force Fc z, root frame + y%WriteOutput( IdxOutList ) = temp_vec(3) + END SELECT + ENDDO + CASE (BldNd_MFdxr,BldNd_MFdyr,BldNd_MFdzr) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + nelem = p%OutNd2NdElem(2,idx_node) + idx_node_in_elem = p%OutNd2NdElem(1,idx_node) + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), MATMUL(p%GlbRot,m%qp%Fd(4:6,idx_node_in_elem,nelem))) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (BldNd_MFdxr) ! Gyroscopic moment Fc about x, root frame + y%WriteOutput( IdxOutList ) = temp_vec(1) + CASE (BldNd_MFdyr) ! Gyroscopic moment Fc about y, root frame + y%WriteOutput( IdxOutList ) = temp_vec(2) + CASE (BldNd_MFdzr) ! Gyroscopic moment Fc about z, root frame + y%WriteOutput( IdxOutList ) = temp_vec(3) + END SELECT + ENDDO + + CASE (BldNd_FFgxr,BldNd_FFgyr,BldNd_FFgzr) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + nelem = p%OutNd2NdElem(2,idx_node) + idx_node_in_elem = p%OutNd2NdElem(1,idx_node) + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), MATMUL(p%GlbRot,m%qp%Fg(1:3,idx_node_in_elem,nelem))) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (BldNd_FFgxr) ! Gyroscopic force Fc x, root frame + y%WriteOutput( IdxOutList ) = temp_vec(1) + CASE (BldNd_FFgyr) ! Gyroscopic force Fc y, root frame + y%WriteOutput( IdxOutList ) = temp_vec(2) + CASE (BldNd_FFgzr) ! Gyroscopic force Fc z, root frame + y%WriteOutput( IdxOutList ) = temp_vec(3) + END SELECT + ENDDO + CASE (BldNd_MFgxr,BldNd_MFgyr,BldNd_MFgzr) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + nelem = p%OutNd2NdElem(2,idx_node) + idx_node_in_elem = p%OutNd2NdElem(1,idx_node) + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), m%qp%Fg(4:6,idx_node_in_elem,nelem)) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (BldNd_MFgxr) ! Gyroscopic moment Fc about x, root frame + y%WriteOutput( IdxOutList ) = temp_vec(1) + CASE (BldNd_MFgyr) ! Gyroscopic moment Fc about y, root frame + y%WriteOutput( IdxOutList ) = temp_vec(2) + CASE (BldNd_MFgzr) ! Gyroscopic moment Fc about z, root frame + y%WriteOutput( IdxOutList ) = temp_vec(3) + END SELECT + ENDDO + + + !---------------------------------------- + ! Inertial force from UpdateStates (Includes a few other terms), local frame + CASE (BldNd_FFixl,BldNd_FFiyl,BldNd_FFizl) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + nelem = p%OutNd2NdElem(2,idx_node) + idx_node_in_elem = p%OutNd2NdElem(1,idx_node) + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), MATMUL(p%GlbRot,m%qp%Fi(1:3,idx_node_in_elem,nelem))) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (BldNd_FFixl) ! Gyroscopic force Fc x, root frame + y%WriteOutput( IdxOutList ) = temp_vec(1) + CASE (BldNd_FFiyl) ! Gyroscopic force Fc y, root frame + y%WriteOutput( IdxOutList ) = temp_vec(2) + CASE (BldNd_FFizl) ! Gyroscopic force Fc z, root frame + y%WriteOutput( IdxOutList ) = temp_vec(3) + END SELECT + ENDDO + CASE (BldNd_MFixl,BldNd_MFiyl,BldNd_MFizl) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + nelem = p%OutNd2NdElem(2,idx_node) + idx_node_in_elem = p%OutNd2NdElem(1,idx_node) + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), MATMUL(p%GlbRot,m%qp%Fi(4:6,idx_node_in_elem,nelem))) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (BldNd_MFixl) ! Gyroscopic moment Fc about x, root frame + y%WriteOutput( IdxOutList ) = temp_vec(1) + CASE (BldNd_MFiyl) ! Gyroscopic moment Fc about y, root frame + y%WriteOutput( IdxOutList ) = temp_vec(2) + CASE (BldNd_MFizl) ! Gyroscopic moment Fc about z, root frame + y%WriteOutput( IdxOutList ) = temp_vec(3) + END SELECT + ENDDO + + !---------------------------------------- + ! Inertial force from UpdateStates (Includes a few other terms), root frame + CASE (BldNd_FFixr,BldNd_FFiyr,BldNd_FFizr) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + nelem = p%OutNd2NdElem(2,idx_node) + idx_node_in_elem = p%OutNd2NdElem(1,idx_node) + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), MATMUL(p%GlbRot,m%qp%Fi(1:3,idx_node_in_elem,nelem))) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (BldNd_FFixr) ! Gyroscopic force Fc x, root frame + y%WriteOutput( IdxOutList ) = temp_vec(1) + CASE (BldNd_FFiyr) ! Gyroscopic force Fc y, root frame + y%WriteOutput( IdxOutList ) = temp_vec(2) + CASE (BldNd_FFizr) ! Gyroscopic force Fc z, root frame + y%WriteOutput( IdxOutList ) = temp_vec(3) + END SELECT + ENDDO + CASE (BldNd_MFixr,BldNd_MFiyr,BldNd_MFizr) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + nelem = p%OutNd2NdElem(2,idx_node) + idx_node_in_elem = p%OutNd2NdElem(1,idx_node) + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), MATMUL(p%GlbRot,m%qp%Fi(4:6,idx_node_in_elem,nelem))) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (BldNd_MFixr) ! Gyroscopic moment Fc about x, root frame + y%WriteOutput( IdxOutList ) = temp_vec(1) + CASE (BldNd_MFiyr) ! Gyroscopic moment Fc about y, root frame + y%WriteOutput( IdxOutList ) = temp_vec(2) + CASE (BldNd_MFizr) ! Gyroscopic moment Fc about z, root frame + y%WriteOutput( IdxOutList ) = temp_vec(3) + END SELECT + ENDDO + + + + CASE DEFAULT + CALL SetErrStat( ErrID_Severe, "Coding error. Output channel not properly set.",ErrStat,ErrMsg,RoutineName ) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes + y%WriteOutput( IdxOutList ) = 0.0_ReKi + ENDDO + + END SELECT + + ENDDO ! Loop over the output channel list + + +END SUBROUTINE Calc_WriteBldNdOutput + +!.................................................................................................................................. +SUBROUTINE BldNdOuts_SetParameters(InitInp, InputFileData, p, ErrStat, ErrMsg) + type(BD_InitInputType), intent(in ) :: InitInp !< Input data for initialization routine + type(BD_InputFile), intent(in ) :: InputFileData !< data from the input file + type(BD_ParameterType), intent(inout) :: p !< Parameters ! intent(out) only because it changes p%NdIndx + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + integer(IntKi) :: i + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = ('BldNdOuts_SetParameters') + + + ! Initialize values + ErrStat = ErrID_None + ErrMsg = "" + + + ! Set the parameter to store number of requested Blade Node output sets + p%BldNd_NumOuts = InputFileData%BldNd_NumOuts + + IF ( p%BldNd_NumOuts == 0 ) THEN + + p%BldNd_TotNumOuts = 0 ! default to no nodal outputs + + ELSE + + ! Check if the blade node array to output is valid: p%BldNd_BlOutNd + ! TODO: this value is not read in by the input file reading yet, so setting to all blade nodes + ! -- check if list handed in is of nodes that exist (not sure this is ever checked) + ! -- Make sure the nodes actually exist on the y%BldMotion mesh + ! -- Sort the order of the list handed in + ! -- copy values over + + + ! Temporary workaround here: + ALLOCATE ( p%BldNd_BlOutNd( size(p%NdIndxInverse) ) , STAT=ErrStat2 ) + IF ( ErrStat2 /= 0_IntKi ) THEN + CALL SetErrStat( ErrID_Fatal,"Error allocating memory for the BeamDyn BldNd_BlOutNd array.", ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + DO I=1,size(p%BldNd_BlOutNd) + p%BldNd_BlOutNd(i) = i + ENDDO + + ! Set the total number of outputs ( requested channel groups * number requested nodes ) + p%BldNd_TotNumOuts = p%BldNd_NumOuts * SIZE(p%BldNd_BlOutNd) + + call BldNdOuts_SetOutParam(InputFileData%BldNd_OutList, p, ErrStat2, ErrMsg2 ) + call setErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat >= AbortErrLev) return + + END IF + + +END SUBROUTINE BldNdOuts_SetParameters +!********************************************************************************************************************************** +! NOTE: The following lines of code were generated by a Matlab script called "Write_ChckOutLst.m" +! using the parameters listed in the "OutListParameters.xlsx" Excel file. Any changes to these +! lines should be modified in the Matlab script and/or Excel worksheet as necessary. +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine checks to see if any requested output channel names (stored in the OutList(:)) are invalid. It returns a +!! warning if any of the channels are not available outputs from the module. +!! It assigns the settings for OutParam(:) (i.e, the index, name, and units of the output channels, WriteOutput(:)). +!! the sign is set to 0 if the channel is invalid. +!! It sets assumes the value p%NumOuts has been set before this routine has been called, and it sets the values of p%OutParam here. +!! +!! This routine was generated by Write_ChckOutLst.m using the parameters listed in OutListParameters.xlsx at 12-Dec-2017 20:48:14. +SUBROUTINE BldNdOuts_SetOutParam(BldNd_OutList, p, ErrStat, ErrMsg ) +!.................................................................................................................................. + + IMPLICIT NONE + + ! Passed variables + + CHARACTER(ChanLen), INTENT(IN) :: BldNd_OutList(:) !< The list out user-requested outputs + TYPE(BD_ParameterType), INTENT(INOUT) :: p !< The module parameters + INTEGER(IntKi), INTENT(OUT) :: ErrStat !< The error status code + CHARACTER(*), INTENT(OUT) :: ErrMsg !< The error message, if an error occurred + + ! Local variables + + INTEGER :: ErrStat2 ! temporary (local) error status + INTEGER :: I ! Generic loop-counting index + INTEGER :: J ! Generic loop-counting index + INTEGER :: INDX ! Index for valid arrays + + LOGICAL :: InvalidOutput(1:BldNd_MaxOutPts) ! This array determines if the output channel is valid for this configuration + CHARACTER(ChanLen) :: OutListTmp ! A string to temporarily hold OutList(I) + CHARACTER(*), PARAMETER :: RoutineName = "BldNdOuts_SetOutParam" + + CHARACTER(OutStrLenM1), PARAMETER :: ValidParamAry(177) = (/ & ! This lists the names of the allowed parameters, which must be sorted alphabetically + "ABSXG ","ABSXR ","ABSYG ","ABSYR ","ABSZG ", & + "ABSZR ","AXB ","AXL ","AYB ","AYL ","AZB ","AZL ", & + "DFXL ","DFXR ","DFYL ","DFYR ","DFZL ","DFZR ","DMXL ", & + "DMXR ","DMYL ","DMYR ","DMZL ","DMZR ","FFBXL ","FFBXR ","FFBYL ", & + "FFBYR ","FFBZL ","FFBZR ","FFCXL ","FFCXR ","FFCYL ","FFCYR ","FFCZL ", & + "FFCZR ","FFDXL ","FFDXR ","FFDYL ","FFDYR ","FFDZL ","FFDZR ","FFGXL ", & + "FFGXR ","FFGYL ","FFGYR ","FFGZL ","FFGZR ","FFIXL ","FFIXR ","FFIYL ", & + "FFIYR ","FFIZL ","FFIZR ","FXB ","FXL ","FXR ","FYB ","FYL ", & + "FYR ","FZB ","FZL ","FZR ","MFBXL ","MFBXR ","MFBYL ","MFBYR ", & + "MFBZL ","MFBZR ","MFCXL ","MFCXR ","MFCYL ","MFCYR ","MFCZL ","MFCZR ", & + "MFDXL ","MFDXR ","MFDYL ","MFDYR ","MFDZL ","MFDZR ","MFGXL ","MFGXR ", & + "MFGYL ","MFGYR ","MFGZL ","MFGZR ","MFIXL ","MFIXR ","MFIYL ","MFIYR ", & + "MFIZL ","MFIZR ","MXB ","MXL ","MXR ","MYB ","MYL ","MYR ", & + "MZB ","MZL ","MZR ","PFXL ","PFYL ","PFZL ","PMXL ","PMYL ", & + "PMZL ","PXB ","PXG ","PYB ","PYG ","PZB ","PZG ","QXB ", & + "QXL ","QYB ","QYL ","QZB ","QZL ","RAXL ","RAXR ","RAYL ", & + "RAYR ","RAZL ","RAZR ","RDXR ","RDYR ", & + "RDZR ","RVXG ","RVXL ","RVXR ","RVYG ","RVYL ","RVYR ","RVZG ", & + "RVZL ","RVZR ","TAXL ","TAXR ","TAYL ", & + "TAYR ","TAZL ","TAZR ","TDXR ","TDYR ","TDZR ", & + "TVXG ","TVXL ","TVXR ","TVYG ","TVYL ","TVYR ","TVZG ","TVZL ", & + "TVZR ","UXB ","UYB ","UZB ","VXB ","VXG ", & + "VXL ","VYB ","VYG ","VYL ","VZB ","VZG ","VZL ","WXB ", & + "WXG ","WXL ","WYB ","WYG ","WYL ","WZB ","WZG ","WZL "/) + INTEGER(IntKi), PARAMETER :: ParamIndxAry(177) = (/ & ! This lists the index into AllOuts(:) of the allowed parameters ValidParamAry(:) + BldNd_AbsXg , BldNd_AbsXr , BldNd_AbsYg , BldNd_AbsYr , BldNd_AbsZg , & + BldNd_AbsZr , BldNd_TAxr , BldNd_TAxl , BldNd_TAyr , BldNd_TAyl , BldNd_TAzr , BldNd_TAzl , & + BldNd_DFxL , BldNd_DFxR , BldNd_DFyL , BldNd_DFyR , BldNd_DFzL , BldNd_DFzR , BldNd_DMxL , & + BldNd_DMxR , BldNd_DMyL , BldNd_DMyR , BldNd_DMzL , BldNd_DMzR , BldNd_FFbxl , BldNd_FFbxr , BldNd_FFbyl , & + BldNd_FFbyr , BldNd_FFbzl , BldNd_FFbzr , BldNd_FFcxl , BldNd_FFcxr , BldNd_FFcyl , BldNd_FFcyr , BldNd_FFczl , & + BldNd_FFczr , BldNd_FFdxl , BldNd_FFdxr , BldNd_FFdyl , BldNd_FFdyr , BldNd_FFdzl , BldNd_FFdzr , BldNd_FFgxl , & + BldNd_FFgxr , BldNd_FFgyl , BldNd_FFgyr , BldNd_FFgzl , BldNd_FFgzr , BldNd_FFixl , BldNd_FFixr , BldNd_FFiyl , & + BldNd_FFiyr , BldNd_FFizl , BldNd_FFizr , BldNd_Fxr , BldNd_FxL , BldNd_Fxr , BldNd_Fyr , BldNd_FyL , & + BldNd_Fyr , BldNd_Fzr , BldNd_FzL , BldNd_Fzr , BldNd_MFbxl , BldNd_MFbxr , BldNd_MFbyl , BldNd_MFbyr , & + BldNd_MFbzl , BldNd_MFbzr , BldNd_MFcxl , BldNd_MFcxr , BldNd_MFcyl , BldNd_MFcyr , BldNd_MFczl , BldNd_MFczr , & + BldNd_MFdxl , BldNd_MFdxr , BldNd_MFdyl , BldNd_MFdyr , BldNd_MFdzl , BldNd_MFdzr , BldNd_MFgxl , BldNd_MFgxr , & + BldNd_MFgyl , BldNd_MFgyr , BldNd_MFgzl , BldNd_MFgzr , BldNd_MFixl , BldNd_MFixr , BldNd_MFiyl , BldNd_MFiyr , & + BldNd_MFizl , BldNd_MFizr , BldNd_Mxr , BldNd_MxL , BldNd_Mxr , BldNd_Myr , BldNd_MyL , BldNd_Myr , & + BldNd_Mzr , BldNd_MzL , BldNd_Mzr , BldNd_PFxL , BldNd_PFyL , BldNd_PFzL , BldNd_PMxL , BldNd_PMyL , & + BldNd_PMzL , BldNd_AbsXr , BldNd_AbsXg , BldNd_AbsYr , BldNd_AbsYg , BldNd_AbsZr , BldNd_AbsZg , BldNd_RAxr , & + BldNd_RAxl , BldNd_RAyr , BldNd_RAyl , BldNd_RAzr , BldNd_RAzl , BldNd_RAxl , BldNd_RAxr , BldNd_RAyl , & + BldNd_RAyr , BldNd_RAzl , BldNd_RAzr , BldNd_RDxr , BldNd_RDyr , & + BldNd_RDzr , BldNd_RVxg , BldNd_RVxl , BldNd_RVxr , BldNd_RVyg , BldNd_RVyl , BldNd_RVyr , BldNd_RVzg , & + BldNd_RVzl , BldNd_RVzr , BldNd_TAxl , BldNd_TAxr , BldNd_TAyl , & + BldNd_TAyr , BldNd_TAzl , BldNd_TAzr , BldNd_TDxr , BldNd_TDyr , BldNd_TDzr , & + BldNd_TVxg , BldNd_TVxl , BldNd_TVxr , BldNd_TVyg , BldNd_TVyl , BldNd_TVyr , BldNd_TVzg , BldNd_TVzl , & + BldNd_TVzr , BldNd_TDxr , BldNd_TDyr , BldNd_TDzr , BldNd_TVxr , BldNd_TVxg , & + BldNd_TVxl , BldNd_TVyr , BldNd_TVyg , BldNd_TVyl , BldNd_TVzr , BldNd_TVzg , BldNd_TVzl , BldNd_RVxr , & + BldNd_RVxg , BldNd_RVxl , BldNd_RVyr , BldNd_RVyg , BldNd_RVyl , BldNd_RVzr , BldNd_RVzg , BldNd_RVzl /) + CHARACTER(ChanLen), PARAMETER :: ParamUnitsAry(177) = (/ & ! This lists the units corresponding to the allowed parameters + "(m) ","(m) ","(m) ","(m) ","(m) ", & + "(m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ",& + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m) ", & + "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N) ","(N) ","(N) ", & + "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & + "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & + "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & + "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & + "(N) ","(N) ","(N) ","(N) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ", & + "(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ", & + "(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ", & + "(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ", & + "(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ", & + "(N-m) ","(N-m) ","(N-m) ","(N) ","(N) ","(N) ","(N-m) ","(N-m) ", & + "(N-m) ","(m) ","(m) ","(m) ","(m) ","(m) ","(m) ","(deg/s^2)", & + "(deg/s^2)","(deg/s^2)","(deg/s^2)","(deg/s^2)","(deg/s^2)","(deg/s^2)","(deg/s^2)","(deg/s^2)", & + "(deg/s^2)","(deg/s^2)","(deg/s^2)","(-) ","(-) ", & + "(-) ","(deg/s) ","(deg/s) ","(deg/s) ","(deg/s) ","(deg/s) ","(deg/s) ","(deg/s) ", & + "(deg/s) ","(deg/s) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & + "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m) ","(m) ","(m) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & + "(m/s) ","(m) ","(m) ","(m) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(deg/s) ", & + "(deg/s) ","(deg/s) ","(deg/s) ","(deg/s) ","(deg/s) ","(deg/s) ","(deg/s) ","(deg/s) "/) + + + ! Initialize values + ErrStat = ErrID_None + ErrMsg = "" + InvalidOutput = .FALSE. + + +! ..... Developer must add checking for invalid inputs here: ..... + + ! these outputs are not valid for FE (Gauss) + IF (p%BldMotionNodeLoc==BD_MESH_FE) then + InvalidOutput( BldNd_FFbxl ) = .true. + InvalidOutput( BldNd_FFbyl ) = .true. + InvalidOutput( BldNd_FFbzl ) = .true. + InvalidOutput( BldNd_MFbxl ) = .true. + InvalidOutput( BldNd_MFbyl ) = .true. + InvalidOutput( BldNd_MFbzl ) = .true. + InvalidOutput( BldNd_FFcxl ) = .true. + InvalidOutput( BldNd_FFcyl ) = .true. + InvalidOutput( BldNd_FFczl ) = .true. + InvalidOutput( BldNd_MFcxl ) = .true. + InvalidOutput( BldNd_MFcyl ) = .true. + InvalidOutput( BldNd_MFczl ) = .true. + InvalidOutput( BldNd_FFdxl ) = .true. + InvalidOutput( BldNd_FFdyl ) = .true. + InvalidOutput( BldNd_FFdzl ) = .true. + InvalidOutput( BldNd_MFdxl ) = .true. + InvalidOutput( BldNd_MFdyl ) = .true. + InvalidOutput( BldNd_MFdzl ) = .true. + InvalidOutput( BldNd_FFgxl ) = .true. + InvalidOutput( BldNd_FFgyl ) = .true. + InvalidOutput( BldNd_FFgzl ) = .true. + InvalidOutput( BldNd_MFgxl ) = .true. + InvalidOutput( BldNd_MFgyl ) = .true. + InvalidOutput( BldNd_MFgzl ) = .true. + InvalidOutput( BldNd_FFbxr ) = .true. + InvalidOutput( BldNd_FFbyr ) = .true. + InvalidOutput( BldNd_FFbzr ) = .true. + InvalidOutput( BldNd_MFbxr ) = .true. + InvalidOutput( BldNd_MFbyr ) = .true. + InvalidOutput( BldNd_MFbzr ) = .true. + InvalidOutput( BldNd_FFcxr ) = .true. + InvalidOutput( BldNd_FFcyr ) = .true. + InvalidOutput( BldNd_FFczr ) = .true. + InvalidOutput( BldNd_MFcxr ) = .true. + InvalidOutput( BldNd_MFcyr ) = .true. + InvalidOutput( BldNd_MFczr ) = .true. + InvalidOutput( BldNd_FFdxr ) = .true. + InvalidOutput( BldNd_FFdyr ) = .true. + InvalidOutput( BldNd_FFdzr ) = .true. + InvalidOutput( BldNd_MFdxr ) = .true. + InvalidOutput( BldNd_MFdyr ) = .true. + InvalidOutput( BldNd_MFdzr ) = .true. + InvalidOutput( BldNd_FFgxr ) = .true. + InvalidOutput( BldNd_FFgyr ) = .true. + InvalidOutput( BldNd_FFgzr ) = .true. + InvalidOutput( BldNd_MFgxr ) = .true. + InvalidOutput( BldNd_MFgyr ) = .true. + InvalidOutput( BldNd_MFgzr ) = .true. + InvalidOutput( BldNd_FFixl ) = .true. + InvalidOutput( BldNd_FFiyl ) = .true. + InvalidOutput( BldNd_FFizl ) = .true. + InvalidOutput( BldNd_MFixl ) = .true. + InvalidOutput( BldNd_MFiyl ) = .true. + InvalidOutput( BldNd_MFizl ) = .true. + InvalidOutput( BldNd_FFixr ) = .true. + InvalidOutput( BldNd_FFiyr ) = .true. + InvalidOutput( BldNd_FFizr ) = .true. + InvalidOutput( BldNd_MFixr ) = .true. + InvalidOutput( BldNd_MFiyr ) = .true. + InvalidOutput( BldNd_MFizr ) = .true. + END IF + IF (.NOT. (p%OutInputs .and. p%BldMotionNodeLoc/=BD_MESH_FE)) then + ! Distributed output channels not allowed yet as the mapping of the m%u_DistrLoad_at_y only exists for MESH_QP with p%OutInputs set to true + InvalidOutput( BldNd_DFxL ) = .true. + InvalidOutput( BldNd_DFyL ) = .true. + InvalidOutput( BldNd_DFzL ) = .true. + InvalidOutput( BldNd_DMxL ) = .true. + InvalidOutput( BldNd_DMyL ) = .true. + InvalidOutput( BldNd_DMzL ) = .true. + InvalidOutput( BldNd_DFxr ) = .true. + InvalidOutput( BldNd_DFyr ) = .true. + InvalidOutput( BldNd_DFzr ) = .true. + InvalidOutput( BldNd_DMxr ) = .true. + InvalidOutput( BldNd_DMyr ) = .true. + InvalidOutput( BldNd_DMzr ) = .true. + END IF + +! ................. End of validity checking ................. + + + !------------------------------------------------------------------------------------------------- + ! Allocate and set index, name, and units for the output channels + ! If a selected output channel is not available in this module, set error flag. + !------------------------------------------------------------------------------------------------- + + ALLOCATE ( p%BldNd_OutParam(1:p%BldNd_NumOuts) , STAT=ErrStat2 ) + IF ( ErrStat2 /= 0_IntKi ) THEN + CALL SetErrStat( ErrID_Fatal,"Error allocating memory for the BeamDyn BldNd_OutParam array.", ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + + + ! Set index, name, and units for all of the output channels. + ! If a selected output channel is not available by this module set ErrStat = ErrID_Warn. + + DO I = 1,p%BldNd_NumOuts + + p%BldNd_OutParam(I)%Name = "_"//BldNd_OutList(I) + OutListTmp = BldNd_OutList(I) + p%BldNd_OutParam(I)%SignM = 1 ! this won't be used + + CALL Conv2UC( OutListTmp ) ! Convert OutListTmp to upper case + + + Indx = IndexCharAry( OutListTmp(1:OutStrLenM1), ValidParamAry ) + + IF ( Indx > 0 ) THEN ! we found the channel name + IF ( InvalidOutput( ParamIndxAry(Indx) ) ) THEN ! but, it isn't valid for these settings + p%BldNd_OutParam(I)%Indx = 0 ! pick any valid channel (I just picked "Time=0" here because it's universal) + p%BldNd_OutParam(I)%Units = "INVALID" + p%BldNd_OutParam(I)%SignM = 0 + ELSE + p%BldNd_OutParam(I)%Indx = ParamIndxAry(Indx) + p%BldNd_OutParam(I)%Units = ParamUnitsAry(Indx) ! it's a valid output + END IF + ELSE ! this channel isn't valid + p%BldNd_OutParam(I)%Indx = 0 ! pick any valid channel (I just picked "Time=0" here because it's universal) + p%BldNd_OutParam(I)%Units = "INVALID" + p%BldNd_OutParam(I)%SignM = 0 ! multiply all results by zero + + CALL SetErrStat(ErrID_Fatal, TRIM(p%BldNd_OutParam(I)%Name)//" is not an available output channel.",ErrStat,ErrMsg,RoutineName) + END IF + + END DO + + RETURN +END SUBROUTINE BldNdOuts_SetOutParam +!---------------------------------------------------------------------------------------------------------------------------------- +!End of code generated by Matlab script +!********************************************************************************************************************************** + +END MODULE BeamDyn_BldNdOuts_IO diff --git a/modules/beamdyn/src/BeamDyn_IO.f90 b/modules/beamdyn/src/BeamDyn_IO.f90 index a4c06bf83c..3898574b6e 100644 --- a/modules/beamdyn/src/BeamDyn_IO.f90 +++ b/modules/beamdyn/src/BeamDyn_IO.f90 @@ -18,6 +18,7 @@ !> This module contains the input/output parameters and routines for the BeamDyn module. MODULE BeamDyn_IO + USE BeamDyn_BldNdOuts_IO USE BeamDyn_Types USE BeamDyn_Subs USE NWTC_Library @@ -564,6 +565,7 @@ SUBROUTINE BD_ReadPrimaryFile(InputFile,InputFileData,OutFileRoot,UnEc,ErrStat,E LOGICAL :: Echo ! Determines if an echo file should be written INTEGER(IntKi) :: IOS ! Temporary Error status CHARACTER(ErrMsgLen) :: ErrMsg2 ! Temporary Error message + CHARACTER(ErrMsgLen) :: ErrMsg_NoBldNdOuts ! Temporary Error message character(*), parameter :: RoutineName = 'BD_ReadPrimaryFile' CHARACTER(1024) :: PriPath ! Path name of the primary file @@ -586,6 +588,11 @@ SUBROUTINE BD_ReadPrimaryFile(InputFile,InputFileData,OutFileRoot,UnEc,ErrStat,E CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! Allocate array for holding the list of node outputs + CALL AllocAry( InputFileData%BldNd_OutList, BldNd_MaxOutPts, "BldNd_Outlist", ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL GetNewUnit(UnIn,ErrStat2,ErrMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL OpenFInpFile(UnIn,InputFile,ErrStat2,ErrMsg2) @@ -965,6 +972,55 @@ SUBROUTINE BD_ReadPrimaryFile(InputFile,InputFileData,OutFileRoot,UnEc,ErrStat,E !---------------------- END OF FILE ----------------------------------------- + + !----------- OUTLIST ----------------------------------------------------------- + ! In case there is something ill-formed in the additional nodal outputs section, we will simply ignore it. + ErrMsg_NoBldNdOuts='BldNd section of BeamDyn input file not found or improperly formatted. Therefore assuming no nodal outputs.' + InputFileData%BldNd_NumOuts = 0 ! Just in case we don't get an error but have no nodal outputs. + + + !----------- OUTLIST for BldNd ----------------------------------------------------------- + CALL ReadCom( UnIn, InputFile, 'Section Header: OutList for Blade node channels', ErrStat2, ErrMsg2, UnEc ) + IF ( ErrStat2 >= AbortErrLev ) THEN + InputFileData%BldNd_NumOuts = 0 + call wrscr( trim(ErrMsg_NoBldNdOuts)//' --> '//trim(ErrMsg2) ) + CALL Cleanup() + RETURN + ENDIF + + ! Number of blade nodes to output: will modify this at some point for arrays + ! TODO: Parse this string into an array of nodes to output at (one idea is to set an array of boolean to T/F for which nodes to output). At present, we ignore it entirely. + CALL ReadVar( UnIn, InputFile, InputFileData%BldNd_BlOutNd_Str, 'BldNd_BlOutNd_Str', 'Which nodes to output node data on.'//TRIM(Num2Lstr(I)), ErrStat2, ErrMsg2, UnEc ) + IF ( ErrStat2 >= AbortErrLev ) THEN + InputFileData%BldNd_NumOuts = 0 + call wrscr( trim(ErrMsg_NoBldNdOuts)//' --> '//trim(ErrMsg2) ) + CALL Cleanup() + RETURN + ENDIF + + + ! Section header for outlist + CALL ReadCom( UnIn, InputFile, 'Section Header: OutList', ErrStat2, ErrMsg2, UnEc ) + IF ( ErrStat2 >= AbortErrLev ) THEN + InputFileData%BldNd_NumOuts = 0 + CALL SetErrStat( ErrID_Warn, ErrMsg_NoBldNdOuts//' --> '//ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL Cleanup() + RETURN + ENDIF + + + ! OutList - List of user-requested output channels at each node(-): + CALL ReadOutputList ( UnIn, InputFile, InputFileData%BldNd_OutList, InputFileData%BldNd_NumOuts, 'BldNd_OutList', "List of user-requested output channels", ErrStat2, ErrMsg2, UnEc ) ! Routine in NWTC Subroutine Library + IF ( ErrStat2 >= AbortErrLev ) THEN + InputFileData%BldNd_NumOuts = 0 + call wrscr( trim(ErrMsg_NoBldNdOuts)//' --> '//trim(ErrMsg2) ) + CALL Cleanup() + RETURN + ENDIF + + !---------------------- END OF FILE ----------------------------------------- + + call cleanup() return @@ -1317,8 +1373,14 @@ SUBROUTINE SetOutParam(OutList, p, ErrStat, ErrMsg ) InvalidOutput( PRatAct ) = .true. InvalidOutput( PAccAct ) = .true. END IF - - + + if (p%BldMotionNodeLoc /= BD_MESH_FE) then + DO I = 1,9 + InvalidOutput( NPFl(i,:) ) = .true. + InvalidOutput( NPMl(i,:) ) = .true. + END DO + end if + ! ................. End of validity checking ................. @@ -1567,7 +1629,7 @@ SUBROUTINE BD_ValidateInputData( InitInp, InputFileData, ErrStat, ErrMsg ) END SUBROUTINE BD_ValidateInputData !---------------------------------------------------------------------------------------------------------------------------------- !> this routine fills the AllOuts array, which is used to send data to the glue code to be written to an output file. -SUBROUTINE Calc_WriteOutput( p, AllOuts, y, m, ErrStat, ErrMsg ) +SUBROUTINE Calc_WriteOutput( p, AllOuts, y, m, ErrStat, ErrMsg, CalcWriteOutput ) TYPE(BD_ParameterType), INTENT(IN ) :: p !< The module parameters REAL(ReKi), INTENT(INOUT) :: AllOuts(0:) !< array of values to potentially write to file @@ -1575,6 +1637,7 @@ SUBROUTINE Calc_WriteOutput( p, AllOuts, y, m, ErrStat, ErrMsg ) TYPE(BD_MiscVarType), INTENT(INOUT) :: m !< misc/optimization variables (for computing mesh transfers) INTEGER(IntKi), INTENT( OUT) :: ErrStat !< The error status code CHARACTER(*), INTENT( OUT) :: ErrMsg !< The error message, if an error occurred + LOGICAL , INTENT(IN ) :: CalcWriteOutput !< flag that determines if we need to compute AllOuts (or just the reaction loads that get returned to ServoDyn) ! local variables CHARACTER(*), PARAMETER :: RoutineName = 'Calc_WriteOutput' @@ -1615,7 +1678,7 @@ SUBROUTINE Calc_WriteOutput( p, AllOuts, y, m, ErrStat, ErrMsg ) !------------------------- ! we don't need to calculate the rest of these values if we don't ask for WriteOutput channels ! (but we did need RootMxr and RootMyr) - if ( p%NumOuts <= 0 ) RETURN + if ( p%NumOuts <= 0 .or. .not. CalcWriteOutput) RETURN !------------------------- @@ -2046,6 +2109,14 @@ SUBROUTINE BD_PrintSum( p, x, m, InitInp, ErrStat, ErrMsg ) END DO + WRITE (UnSu,'(15x,A)') + WRITE (UnSu,'(15x,A)') + WRITE (UnSu,'(15x,A)') 'Requested Output Channels at each blade station:' + WRITE (UnSu,'(15x,A)') 'Col Parameter Units' + WRITE (UnSu,'(15x,A)') '---- --------- -----' + DO I = 1,p%BldNd_NumOuts + WRITE (UnSu,OutPFmt) I, p%BldNd_OutParam(I)%Name, p%BldNd_OutParam(I)%Units + END DO if ( p%analysis_type /= BD_STATIC_ANALYSIS ) then !dynamic analysis @@ -2241,7 +2312,7 @@ SUBROUTINE Init_Jacobian_y( p, y, InitOut, ErrStat, ErrMsg) ! 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 ! WriteOutput values + + p%NumOuts + p%BldNd_TotNumOuts ! WriteOutput values ! get the names of the linearized outputs: @@ -2256,7 +2327,7 @@ SUBROUTINE Init_Jacobian_y( p, y, InitOut, ErrStat, ErrMsg) 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 + 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 @@ -2282,6 +2353,22 @@ SUBROUTINE Init_Jacobian_y( p, y, InitOut, ErrStat, ErrMsg) 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 SUBROUTINE Init_Jacobian_y !---------------------------------------------------------------------------------------------------------------------------------- @@ -2436,7 +2523,7 @@ SUBROUTINE Compute_dY(p, y_p, y_m, delta, dY) 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 + do i=1,p%NumOuts + p%BldNd_TotNumOuts dY(i+indx_first-1) = y_p%WriteOutput(i) - y_m%WriteOutput(i) end do diff --git a/modules/beamdyn/src/BeamDyn_Types.f90 b/modules/beamdyn/src/BeamDyn_Types.f90 index aaf7dfd3b7..378cf40104 100644 --- a/modules/beamdyn/src/BeamDyn_Types.f90 +++ b/modules/beamdyn/src/BeamDyn_Types.f90 @@ -118,6 +118,10 @@ MODULE BeamDyn_Types CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutList !< List of user-requested output channels [-] LOGICAL :: SumPrint !< Print summary data to file? (.sum) [-] CHARACTER(20) :: OutFmt !< Format specifier [-] + INTEGER(IntKi) :: BldNd_NumOuts !< Number of requested output channels per blade node (BD_BldNdOuts) [-] + CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: BldNd_OutList !< List of user-requested output channels (BD_BldNdOuts) [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: BldNd_BlOutNd !< The blade nodes to actually output (BD_BldNdOuts) [-] + CHARACTER(1024) :: BldNd_BlOutNd_Str !< String to parse for the blade nodes to actually output (BD_BldNdOuts) [-] END TYPE BD_InputFile ! ======================= ! ========= BD_ContinuousStateType ======= @@ -202,6 +206,7 @@ MODULE BeamDyn_Types INTEGER(IntKi) :: NNodeOuts !< Number of nodes to output data to a file[0 - 9] [-] INTEGER(IntKi) , DIMENSION(1:9) :: OutNd !< Nodes whose values will be output [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NdIndx !< Index into BldMotion mesh (to number the nodes for output without using collocated nodes) [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NdIndxInverse !< Index from BldMotion mesh to unique nodes (to number the nodes for output without using collocated nodes) [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: OutNd2NdElem !< To go from an output node number to a node/elem pair [-] CHARACTER(20) :: OutFmt !< Format specifier [-] LOGICAL :: UsePitchAct !< Whether to use a pitch actuator inside BeamDyn [(flag)] @@ -216,6 +221,10 @@ MODULE BeamDyn_Types LOGICAL :: tngt_stf_comp !< Flag to compare finite differenced and analytical tangent stifness [-] REAL(R8Ki) :: tngt_stf_pert !< Perturbation size for computing finite differenced tangent stiffness [-] REAL(R8Ki) :: tngt_stf_difftol !< When comparing tangent stiffness matrix, stop simulation if error greater than this [-] + INTEGER(IntKi) :: BldNd_NumOuts !< [BD_BldNdOuts] Number of requested output channels per blade node [-] + INTEGER(IntKi) :: BldNd_TotNumOuts !< [BD_BldNdOuts] Total number of requested output channels of blade node information (equal to BldNd_NumOuts * BldNd_BlOutNd) [-] + TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: BldNd_OutParam !< [BD_BldNdOuts] Names and units (and other characteristics) of all requested output parameters [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: BldNd_BlOutNd !< [BD_BldNdOuts] The blade nodes to actually output [-] REAL(R8Ki) , DIMENSION(:,:,:,:), ALLOCATABLE :: QPtw_Shp_Shp_Jac !< optimization variable: QPtw_Shp_Shp_Jac(idx_qp,i,j,nelem) = p%Shp(i,idx_qp)*p%Shp(j,idx_qp)*p%QPtWeight(idx_qp)*p%Jacobian(idx_qp,nelem) [-] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: QPtw_Shp_ShpDer !< optimization variable: QPtw_Shp_ShpDer(idx_qp,i,j) = p%Shp(i,idx_qp)*p%ShpDer(j,idx_qp)*p%QPtWeight(idx_qp) [-] REAL(R8Ki) , DIMENSION(:,:,:,:), ALLOCATABLE :: QPtw_ShpDer_ShpDer_Jac !< optimization variable: QPtw_ShpDer_ShpDer_Jac(idx_qp,i,j,nelem) = p%ShpDer(i,idx_qp)*p%ShpDer(j,idx_qp)*p%QPtWeight(idx_qp)/p%Jacobian(idx_qp,nelem) [-] @@ -1881,6 +1890,32 @@ SUBROUTINE BD_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrSt ENDIF DstInputFileData%SumPrint = SrcInputFileData%SumPrint DstInputFileData%OutFmt = SrcInputFileData%OutFmt + DstInputFileData%BldNd_NumOuts = SrcInputFileData%BldNd_NumOuts +IF (ALLOCATED(SrcInputFileData%BldNd_OutList)) THEN + i1_l = LBOUND(SrcInputFileData%BldNd_OutList,1) + i1_u = UBOUND(SrcInputFileData%BldNd_OutList,1) + IF (.NOT. ALLOCATED(DstInputFileData%BldNd_OutList)) THEN + ALLOCATE(DstInputFileData%BldNd_OutList(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%BldNd_OutList.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInputFileData%BldNd_OutList = SrcInputFileData%BldNd_OutList +ENDIF +IF (ALLOCATED(SrcInputFileData%BldNd_BlOutNd)) THEN + i1_l = LBOUND(SrcInputFileData%BldNd_BlOutNd,1) + i1_u = UBOUND(SrcInputFileData%BldNd_BlOutNd,1) + IF (.NOT. ALLOCATED(DstInputFileData%BldNd_BlOutNd)) THEN + ALLOCATE(DstInputFileData%BldNd_BlOutNd(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%BldNd_BlOutNd.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInputFileData%BldNd_BlOutNd = SrcInputFileData%BldNd_BlOutNd +ENDIF + DstInputFileData%BldNd_BlOutNd_Str = SrcInputFileData%BldNd_BlOutNd_Str END SUBROUTINE BD_CopyInputFile SUBROUTINE BD_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) @@ -1901,6 +1936,12 @@ SUBROUTINE BD_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) ENDIF IF (ALLOCATED(InputFileData%OutList)) THEN DEALLOCATE(InputFileData%OutList) +ENDIF +IF (ALLOCATED(InputFileData%BldNd_OutList)) THEN + DEALLOCATE(InputFileData%BldNd_OutList) +ENDIF +IF (ALLOCATED(InputFileData%BldNd_BlOutNd)) THEN + DEALLOCATE(InputFileData%BldNd_BlOutNd) ENDIF END SUBROUTINE BD_DestroyInputFile @@ -2001,6 +2042,18 @@ SUBROUTINE BD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg END IF Int_BufSz = Int_BufSz + 1 ! SumPrint Int_BufSz = Int_BufSz + 1*LEN(InData%OutFmt) ! OutFmt + Int_BufSz = Int_BufSz + 1 ! BldNd_NumOuts + Int_BufSz = Int_BufSz + 1 ! BldNd_OutList allocated yes/no + IF ( ALLOCATED(InData%BldNd_OutList) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! BldNd_OutList upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%BldNd_OutList)*LEN(InData%BldNd_OutList) ! BldNd_OutList + END IF + Int_BufSz = Int_BufSz + 1 ! BldNd_BlOutNd allocated yes/no + IF ( ALLOCATED(InData%BldNd_BlOutNd) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! BldNd_BlOutNd upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%BldNd_BlOutNd) ! BldNd_BlOutNd + END IF + Int_BufSz = Int_BufSz + 1*LEN(InData%BldNd_BlOutNd_Str) ! BldNd_BlOutNd_Str IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -2172,6 +2225,44 @@ SUBROUTINE BD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) Int_Xferred = Int_Xferred + 1 END DO ! I + IntKiBuf(Int_Xferred) = InData%BldNd_NumOuts + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%BldNd_OutList) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BldNd_OutList,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldNd_OutList,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%BldNd_OutList,1), UBOUND(InData%BldNd_OutList,1) + DO I = 1, LEN(InData%BldNd_OutList) + IntKiBuf(Int_Xferred) = ICHAR(InData%BldNd_OutList(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( .NOT. ALLOCATED(InData%BldNd_BlOutNd) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BldNd_BlOutNd,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldNd_BlOutNd,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%BldNd_BlOutNd,1), UBOUND(InData%BldNd_BlOutNd,1) + IntKiBuf(Int_Xferred) = InData%BldNd_BlOutNd(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + DO I = 1, LEN(InData%BldNd_BlOutNd_Str) + IntKiBuf(Int_Xferred) = ICHAR(InData%BldNd_BlOutNd_Str(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE BD_PackInputFile SUBROUTINE BD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2369,6 +2460,50 @@ SUBROUTINE BD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) Int_Xferred = Int_Xferred + 1 END DO ! I + OutData%BldNd_NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldNd_OutList not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BldNd_OutList)) DEALLOCATE(OutData%BldNd_OutList) + ALLOCATE(OutData%BldNd_OutList(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutList.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%BldNd_OutList,1), UBOUND(OutData%BldNd_OutList,1) + DO I = 1, LEN(OutData%BldNd_OutList) + OutData%BldNd_OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldNd_BlOutNd not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BldNd_BlOutNd)) DEALLOCATE(OutData%BldNd_BlOutNd) + ALLOCATE(OutData%BldNd_BlOutNd(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_BlOutNd.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%BldNd_BlOutNd,1), UBOUND(OutData%BldNd_BlOutNd,1) + OutData%BldNd_BlOutNd(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + DO I = 1, LEN(OutData%BldNd_BlOutNd_Str) + OutData%BldNd_BlOutNd_Str(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE BD_UnPackInputFile SUBROUTINE BD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) @@ -3706,6 +3841,18 @@ SUBROUTINE BD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) END IF DstParamData%NdIndx = SrcParamData%NdIndx ENDIF +IF (ALLOCATED(SrcParamData%NdIndxInverse)) THEN + i1_l = LBOUND(SrcParamData%NdIndxInverse,1) + i1_u = UBOUND(SrcParamData%NdIndxInverse,1) + IF (.NOT. ALLOCATED(DstParamData%NdIndxInverse)) THEN + ALLOCATE(DstParamData%NdIndxInverse(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NdIndxInverse.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%NdIndxInverse = SrcParamData%NdIndxInverse +ENDIF IF (ALLOCATED(SrcParamData%OutNd2NdElem)) THEN i1_l = LBOUND(SrcParamData%OutNd2NdElem,1) i1_u = UBOUND(SrcParamData%OutNd2NdElem,1) @@ -3735,6 +3882,36 @@ SUBROUTINE BD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) DstParamData%tngt_stf_comp = SrcParamData%tngt_stf_comp DstParamData%tngt_stf_pert = SrcParamData%tngt_stf_pert DstParamData%tngt_stf_difftol = SrcParamData%tngt_stf_difftol + DstParamData%BldNd_NumOuts = SrcParamData%BldNd_NumOuts + DstParamData%BldNd_TotNumOuts = SrcParamData%BldNd_TotNumOuts +IF (ALLOCATED(SrcParamData%BldNd_OutParam)) THEN + i1_l = LBOUND(SrcParamData%BldNd_OutParam,1) + i1_u = UBOUND(SrcParamData%BldNd_OutParam,1) + IF (.NOT. ALLOCATED(DstParamData%BldNd_OutParam)) THEN + ALLOCATE(DstParamData%BldNd_OutParam(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldNd_OutParam.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcParamData%BldNd_OutParam,1), UBOUND(SrcParamData%BldNd_OutParam,1) + CALL NWTC_Library_Copyoutparmtype( SrcParamData%BldNd_OutParam(i1), DstParamData%BldNd_OutParam(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcParamData%BldNd_BlOutNd)) THEN + i1_l = LBOUND(SrcParamData%BldNd_BlOutNd,1) + i1_u = UBOUND(SrcParamData%BldNd_BlOutNd,1) + IF (.NOT. ALLOCATED(DstParamData%BldNd_BlOutNd)) THEN + ALLOCATE(DstParamData%BldNd_BlOutNd(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldNd_BlOutNd.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%BldNd_BlOutNd = SrcParamData%BldNd_BlOutNd +ENDIF IF (ALLOCATED(SrcParamData%QPtw_Shp_Shp_Jac)) THEN i1_l = LBOUND(SrcParamData%QPtw_Shp_Shp_Jac,1) i1_u = UBOUND(SrcParamData%QPtw_Shp_Shp_Jac,1) @@ -3927,10 +4104,22 @@ SUBROUTINE BD_DestroyParam( ParamData, ErrStat, ErrMsg ) IF (ALLOCATED(ParamData%NdIndx)) THEN DEALLOCATE(ParamData%NdIndx) ENDIF +IF (ALLOCATED(ParamData%NdIndxInverse)) THEN + DEALLOCATE(ParamData%NdIndxInverse) +ENDIF IF (ALLOCATED(ParamData%OutNd2NdElem)) THEN DEALLOCATE(ParamData%OutNd2NdElem) ENDIF CALL BD_Destroyqpparam( ParamData%qp, ErrStat, ErrMsg ) +IF (ALLOCATED(ParamData%BldNd_OutParam)) THEN +DO i1 = LBOUND(ParamData%BldNd_OutParam,1), UBOUND(ParamData%BldNd_OutParam,1) + CALL NWTC_Library_Destroyoutparmtype( ParamData%BldNd_OutParam(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(ParamData%BldNd_OutParam) +ENDIF +IF (ALLOCATED(ParamData%BldNd_BlOutNd)) THEN + DEALLOCATE(ParamData%BldNd_BlOutNd) +ENDIF IF (ALLOCATED(ParamData%QPtw_Shp_Shp_Jac)) THEN DEALLOCATE(ParamData%QPtw_Shp_Shp_Jac) ENDIF @@ -4128,6 +4317,11 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Int_BufSz = Int_BufSz + 2*1 ! NdIndx upper/lower bounds for each dimension Int_BufSz = Int_BufSz + SIZE(InData%NdIndx) ! NdIndx END IF + Int_BufSz = Int_BufSz + 1 ! NdIndxInverse allocated yes/no + IF ( ALLOCATED(InData%NdIndxInverse) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! NdIndxInverse upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%NdIndxInverse) ! NdIndxInverse + END IF Int_BufSz = Int_BufSz + 1 ! OutNd2NdElem allocated yes/no IF ( ALLOCATED(InData%OutNd2NdElem) ) THEN Int_BufSz = Int_BufSz + 2*2 ! OutNd2NdElem upper/lower bounds for each dimension @@ -4162,6 +4356,36 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Int_BufSz = Int_BufSz + 1 ! tngt_stf_comp Db_BufSz = Db_BufSz + 1 ! tngt_stf_pert Db_BufSz = Db_BufSz + 1 ! tngt_stf_difftol + Int_BufSz = Int_BufSz + 1 ! BldNd_NumOuts + Int_BufSz = Int_BufSz + 1 ! BldNd_TotNumOuts + Int_BufSz = Int_BufSz + 1 ! BldNd_OutParam allocated yes/no + IF ( ALLOCATED(InData%BldNd_OutParam) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! BldNd_OutParam upper/lower bounds for each dimension + DO i1 = LBOUND(InData%BldNd_OutParam,1), UBOUND(InData%BldNd_OutParam,1) + Int_BufSz = Int_BufSz + 3 ! BldNd_OutParam: size of buffers for each call to pack subtype + CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%BldNd_OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BldNd_OutParam + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! BldNd_OutParam + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! BldNd_OutParam + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! BldNd_OutParam + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! BldNd_BlOutNd allocated yes/no + IF ( ALLOCATED(InData%BldNd_BlOutNd) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! BldNd_BlOutNd upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%BldNd_BlOutNd) ! BldNd_BlOutNd + END IF Int_BufSz = Int_BufSz + 1 ! QPtw_Shp_Shp_Jac allocated yes/no IF ( ALLOCATED(InData%QPtw_Shp_Shp_Jac) ) THEN Int_BufSz = Int_BufSz + 2*4 ! QPtw_Shp_Shp_Jac upper/lower bounds for each dimension @@ -4691,6 +4915,21 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Int_Xferred = Int_Xferred + 1 END DO END IF + IF ( .NOT. ALLOCATED(InData%NdIndxInverse) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%NdIndxInverse,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NdIndxInverse,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%NdIndxInverse,1), UBOUND(InData%NdIndxInverse,1) + IntKiBuf(Int_Xferred) = InData%NdIndxInverse(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF IF ( .NOT. ALLOCATED(InData%OutNd2NdElem) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4769,6 +5008,66 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Db_Xferred = Db_Xferred + 1 DbKiBuf(Db_Xferred) = InData%tngt_stf_difftol Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%BldNd_NumOuts + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%BldNd_TotNumOuts + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%BldNd_OutParam) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BldNd_OutParam,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldNd_OutParam,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%BldNd_OutParam,1), UBOUND(InData%BldNd_OutParam,1) + CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%BldNd_OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! BldNd_OutParam + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%BldNd_BlOutNd) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BldNd_BlOutNd,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldNd_BlOutNd,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%BldNd_BlOutNd,1), UBOUND(InData%BldNd_BlOutNd,1) + IntKiBuf(Int_Xferred) = InData%BldNd_BlOutNd(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF IF ( .NOT. ALLOCATED(InData%QPtw_Shp_Shp_Jac) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -5540,6 +5839,24 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Xferred = Int_Xferred + 1 END DO END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NdIndxInverse not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%NdIndxInverse)) DEALLOCATE(OutData%NdIndxInverse) + ALLOCATE(OutData%NdIndxInverse(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NdIndxInverse.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%NdIndxInverse,1), UBOUND(OutData%NdIndxInverse,1) + OutData%NdIndxInverse(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutNd2NdElem not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5637,6 +5954,84 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Db_Xferred = Db_Xferred + 1 OutData%tngt_stf_difftol = REAL(DbKiBuf(Db_Xferred), R8Ki) Db_Xferred = Db_Xferred + 1 + OutData%BldNd_NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%BldNd_TotNumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldNd_OutParam not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BldNd_OutParam)) DEALLOCATE(OutData%BldNd_OutParam) + ALLOCATE(OutData%BldNd_OutParam(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutParam.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%BldNd_OutParam,1), UBOUND(OutData%BldNd_OutParam,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackoutparmtype( Re_Buf, Db_Buf, Int_Buf, OutData%BldNd_OutParam(i1), ErrStat2, ErrMsg2 ) ! BldNd_OutParam + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldNd_BlOutNd not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BldNd_BlOutNd)) DEALLOCATE(OutData%BldNd_BlOutNd) + ALLOCATE(OutData%BldNd_BlOutNd(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_BlOutNd.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%BldNd_BlOutNd,1), UBOUND(OutData%BldNd_BlOutNd,1) + OutData%BldNd_BlOutNd(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QPtw_Shp_Shp_Jac not allocated Int_Xferred = Int_Xferred + 1 ELSE diff --git a/modules/beamdyn/src/Registry_BeamDyn.txt b/modules/beamdyn/src/Registry_BeamDyn.txt index 7858e60f3b..63feed3b38 100644 --- a/modules/beamdyn/src/Registry_BeamDyn.txt +++ b/modules/beamdyn/src/Registry_BeamDyn.txt @@ -109,6 +109,11 @@ typedef ^ BD_InputFile CHARACTER(ChanLen) OutList {:} - - "List typedef ^ BD_InputFile LOGICAL SumPrint - - - "Print summary data to file? (.sum)" - typedef ^ BD_InputFile CHARACTER(20) OutFmt - - - "Format specifier" - +# ..... BldNdOuts ............................................................................................ +typedef ^ BD_InputFile IntKi BldNd_NumOuts - - - "Number of requested output channels per blade node (BD_BldNdOuts)" - +typedef ^ BD_InputFile CHARACTER(ChanLen) BldNd_OutList {:} - - "List of user-requested output channels (BD_BldNdOuts)" - +typedef ^ BD_InputFile IntKi BldNd_BlOutNd {:} - - "The blade nodes to actually output (BD_BldNdOuts)" - +typedef ^ BD_InputFile CHARACTER(1024) BldNd_BlOutNd_Str - - - "String to parse for the blade nodes to actually output (BD_BldNdOuts)" - # ..... States @@ -210,6 +215,7 @@ typedef ^ ParameterType OutParmType OutParam {:} - - typedef ^ ParameterType IntKi NNodeOuts - - - "Number of nodes to output data to a file[0 - 9]" - typedef ^ ParameterType IntKi OutNd {9} - - "Nodes whose values will be output" - typedef ^ ParameterType IntKi NdIndx {:} - - "Index into BldMotion mesh (to number the nodes for output without using collocated nodes)" - +typedef ^ ParameterType IntKi NdIndxInverse {:} - - "Index from BldMotion mesh to unique nodes (to number the nodes for output without using collocated nodes)" - typedef ^ ParameterType IntKi OutNd2NdElem {:}{:} - - "To go from an output node number to a node/elem pair" - typedef ^ ParameterType CHARACTER(20) OutFmt - - - "Format specifier" - typedef ^ ParameterType Logical UsePitchAct - - - "Whether to use a pitch actuator inside BeamDyn" (flag) @@ -224,6 +230,11 @@ typedef ^ ParameterType Logical tngt_stf_fd - - - typedef ^ ParameterType Logical tngt_stf_comp - - - "Flag to compare finite differenced and analytical tangent stifness" - typedef ^ ParameterType R8Ki tngt_stf_pert - - - "Perturbation size for computing finite differenced tangent stiffness" - typedef ^ ParameterType R8Ki tngt_stf_difftol - - - "When comparing tangent stiffness matrix, stop simulation if error greater than this" - +# .... BD_BlNdOuts ........................................................................................................ +typedef ^ ParameterType IntKi BldNd_NumOuts - - - "[BD_BldNdOuts] Number of requested output channels per blade node" - +typedef ^ ParameterType IntKi BldNd_TotNumOuts - - - "[BD_BldNdOuts] Total number of requested output channels of blade node information (equal to BldNd_NumOuts * BldNd_BlOutNd)" - +typedef ^ ParameterType OutParmType BldNd_OutParam {:} - - "[BD_BldNdOuts] Names and units (and other characteristics) of all requested output parameters" - +typedef ^ ParameterType IntKi BldNd_BlOutNd {:} - - "[BD_BldNdOuts] The blade nodes to actually output" - # .... arrays for optimization ........................................................................................................ typedef ^ ParameterType R8Ki QPtw_Shp_Shp_Jac {:}{:}{:}{:} - - "optimization variable: QPtw_Shp_Shp_Jac(idx_qp,i,j,nelem) = p%Shp(i,idx_qp)*p%Shp(j,idx_qp)*p%QPtWeight(idx_qp)*p%Jacobian(idx_qp,nelem)" - typedef ^ ParameterType ^ QPtw_Shp_ShpDer {:}{:}{:} - - "optimization variable: QPtw_Shp_ShpDer(idx_qp,i,j) = p%Shp(i,idx_qp)*p%ShpDer(j,idx_qp)*p%QPtWeight(idx_qp)" - diff --git a/modules/openfast-library/src/OutListParameters.xlsx b/modules/openfast-library/src/OutListParameters.xlsx index ba2b2a76e2c5d53e4b06ffd58d481d588f2f20aa..dbe2be3caee0168f0f109c28516059cf662449f6 100644 GIT binary patch delta 58848 zcmbrl1#leAmNh75W?9V4%oZ~z$8$9BcV7!@(y*2_~m7WrBW9`l-vnM2w15jS6q%hIdR)IT7ttY zZqh*wp1^kaV8IPto3ddR7J8)DHkRRE$d&;qJv6ysklsTM*%%f!pO~3fV70iMtGSWZzf$Dsx;ePs7kc zQ&PrR!oF0RQoH_E*D8b0B7AUq_?b@MMCL$Tga4~gRTFFL&t?V0K^}Ma3^LMH+XE6( zO-}C#HwmF9`f}&S8_)bs2}&X|BJ2aSr{dAjiLx1q6t0Z2^*7U|p&VP#W5t^JiZ6d~*!dPzE=tuha7;O#T?3o_!@HO6geU#mfPuXh_*zy^<0T zYg-h=938ox-_^{BSyDUTROS9O(eG-JU?c}IY+bcqrHOy;-f7dyAL38?$Hsjz^F8|t zpJrpeI7mpWrbV?@!F3X=>%8uPPp{hQf`>NvKr`A1lTUNTH-D*n{Nh@hp5{5>xVuRMR4Rr&|uS43&8Hi>&xZMna_ zhdrzF?PtG{xjTNl>D9{*vr>)P+ww9umlNcx=E_<^Z3~y~cm)&u>X$9d`oqn*ab@2S zclH)LST~?;lsficLRup9Hb( zR~MhZaJ0KUo$(BR3$Ob+qI=7Ib55hWXROaa@FmKJRJzgjY9DSn(yj;bBHA02 zxPOnQ6-BcX%mX-OFd|bsxRa!pw1gm2yUIscgJ}i)ZRxTN?VyBAJ9lQt)VVQ6n#cN& z)8kZGrz_X-%@{9eMoHw}9{B|nep;NcV(3m`V8R-FO!j#}+2H zp7KB2Kh1dv^|RiOtv_}0E4!{|PgpeEu%-1--zhFJ&i?yMd7 zy=o4xlk)Edxr>>HFK?|5i$b$Z$&;@g>q42)+Xht6uDto(=kaAuw!07brp5mLf`pad z{GJ{(a!+p|oP>Q%8U+`{Z7|B_Uq&Rn+Cp;Jp-J*36Px!)NpJDA+^ z^lHkPo_Kagb%*qAO`B`p}`fJu98Ej5aT=(aXwTr(kmnPHZb-WKCJzxoEXuJM8_*FjFIb z-`2$4qiwdJUf9KW(~7km@nReM`&k~Kp+J_m^!?m^-(thB>GNq2@>p zfknzOxURp^81kkIUVbk4?}w!xv7HZ{;3e|?%@5jq^Xg)qgqvJCNk|iX4>UEbwJ0|= zc$MN+FCFn6{M|yOYkqdE=bF>@6T*(MmU0kOSTHdiC45u?;Sr?%7ARR#J2g99wSWi+ zP*Mi!xQMLvy-2Hi@psPc{SyoRV_+cFlpgLr8n7x79T{yH=7`{q=m2 z2ssE`g5zuRUDDha_Vp5=_=rk~jpCcGS_H&bP_zr*J*vV`6?RxeEOg9lgI0zJq-Y*^ zBR*Iaks!qSS1b%Jde#=P2r84gBEAFPnU;DG>;Nz`dfFuUC<84^&U(O4P=3n+V_Rbq z&Kee02(uL}-9$T;pl2PQK73ji5jp74Vks?r5ZqTJ8PxJ3&V&O+jMm?+R z%BxhGCGjh$@*eOEuMjJplB&epWGtiHE{ z3VK+`O^hL4okU3qGXI?Q3K%yk&xaRepdTI+xIEk+eeo1zK4Q|M-?U&pk^Pq#@zr0@ zeznb4#^K9;=ZPJ-^TiBHl`lz=1-$7;>o40>gnp$>hTcFc06oR4VIBux~~aKES!0R*}hx2F}(0% z4~>wrrglgqpi|kvEtPoP22vq~Zew%MDxPr-WZO7{{A4>Nzr2cnP;84GpLCrTT|o^& z9o|%I&2%Hvwfg7@5}o()i+gI0e^D(bEV_BH;$3+w<>*n8?fB*(jxuM82M%SVL}Xe{ zWLm$O*oyK`w;GwkS<`XNw^C&uiM3xFKnq_=ESyUL7GPr5CMsy5w3ZZ>vk-U7gGt1QELpkO*eyDcM18`~n-%o8*=O+l)-t4$iL z0tSZM&%o7=yuM-$7$H`&#_vEMm1)zI|Bt!`yV7~jVXf}(JZE{JnUj)9B z#&9sEN6~1aVqu*aLWuh8a9WC++I_|xGx{gl(1KS==R?0wj)a6lJ{L770b&};l>wiW zk!7sJd3Rp@>9%n2@HesOisi~eJLHJ!Q0ys!$WPAJ#>T?EUqve*U}nV&B;I|KzpLRU zsJ!t1n#2qP5{*jJESBdxBo+OPd>eR%qp38R2o2*zM+J}|+%Z`#&T>g>rGgrl%uaqx zw{O?i8-0QqhaOnYSsnidz#YBie6O1b==~c_ue|ABJBB2^N{07e!f)h%YMOsFJiZNJ zTG7P9`VD`Fxd;E{{;{sAZZY`Fj7|!uU&$L3r_!w?PKab z6-Wl=7iv%e8T<0w`9izd2kOTW{1Vj{)&pEBJMA%;HjA?>|7HTpX%Al}0Dq~_G=Wrx znuejzPw-%1dqO=dmwz6qQvt+ef(p&r(7JDE|%ZNl^A zZ;`pK%O}d8;--l6qz7V+c2XQ(!V%+SS^Rj=yYQ7THaPmIp1xZz{oyk&k};FKZNO=T z`qlYbM+ieK2vE@?K?vjBu%m8WVpcgl%q*WMbIOw`amZ$eRo~kj@tV-fh}l9>iG)>cfpP z`r)Hbkk&=?Hs7&?$!AQdG=<^oBp^v!k|4L2B)+cmNt%`)NoP7JS0G38)aVs=2W*cd>NTE+qFp`Mi0jN^8HsdFZ@1P-Xm;K;pI&P)HRzEheQVKA`WD{Bz%e_jm(EJ zUdXs>dzg64Q)m?lkSmP(d2kr#PaPX5C2=Ac7UjAQ0=gzyNaojAC1-}duRgK?(wkT* ztyn|DOCZ2Vz*G41=;vxtjnLXUzSneo=?AcR9B09-v_TEY8O1Pp@v}&fb<;7{6xNI| zOGjP9VH>pKsRQP4NH;84=Ad@K~jPN;SB66xbPb@dk2%6j+=Yj;MI@j3lA zSbaVtEF|)zf_w@^94DVw<0ff)=hYd?`6D&1DUgfXSeaOdhQj7d@%lB}Nl2yuBN;&Y zIXG$~ktm)S8(I-B)7iUzB8qgH8NuyD8;~JfEzM@IJV~BvH23!HGiarCRV!mshsas` zmP5pnXKrN}!AL&)y6FN_+#fH8CS8MeuJ<66nG;JwYhf|y>S~5{LwPrw=gaae2Wjy2 z*O}xx<%n=5pL^7y^%Ka^tda0o78^jw{?gEWAqjF@`dp-z4Xp{(J%^9YyRV}5qYOn@ z%Mw-$M>IwDAN9Gr>f>q#n~qi4plWFg@H-Cc(aYVQ%1GmHZZM|PZ;nmfQTcfs@uM=zuyAFAK|EhJoGUf@S;E->ig>PG-a0k{KvmcnO^`Vv#-M0$IwZA zbv`W^K*#VVvNZ2j>FbIrEvFfG>n_&+syU+pGvUA7(->v^?Uo=0tgfM@n^N0*+3dAE zfsn9mx0nIho7;MHwiDZgrMeJhzlDo)(pIF@Qobeg&M_qi)P;MpGoqJr`bqn7oj#0X z(V`n{%wla&s=E}h9)q2*wk8|o(rz1;Lc}uoD4ZRMvr=V{End%QRXFYGl@uG=QGHKB zWiac-S=NLJhB@f{g*>eZBAV?&Jk{3v#r@!s*{`7;D9llnEjVO!rKUE4px(*yg50Kv%72T z(m5@TERA00Y4YJNk=dqkg6IbR9E4J2%A#M>8`HW~y*TB6S~2J)VME5nYG=u^u5|u> zR(ZAIm&yaca9lf2f!kUK_$H}MmMT?Un{ZYh>f)b!RW7F$eKE1*XI_lGF0_&W6}8X* zzS>BWVkeuYaO#-CkNK^;bm{`gAxOLtQy7uSm`w@WhQ+v*S0~SlPoda?SI1WT1N<7Q zbrsRR{c!)cF3<-Dpbv+5rv5I!PEb@JwcH&vvqjDCeWV?e5 zwq4M+HrVc8A(G8Gdc_TCP?X)|9O?3fIs0yA7+#sSY-4&iMKETTz!0Q(#RL@=%ooU& zR|d^zCzYsF?GJRq`I+X5NBN~X2Uv)d+^b6h^Avx&pLpP|E6N?~gski+3ox-c9AwA> z@>affeLhrQIh<=!>WstmF7#Q;fq`{lnAS6c$#$BMXk9{ax;vg;@MmR zdSeYYyBvS;`&lFEWgzNeqtLc=4Ij_-b;i?b%62oM*^&Vp#LuZ9?Tm0lC z?*7p4eRp}bvIKVwuVx3G8;5TgUL8(0areJv4TL1_eZLPbv-2PkNqSBozK@zU+cZ>5)p7wu!1Y zO-?dxT1$`KF(?a(=8?i3U2RU zlTVcp4#$LDSXWQ01{z-z@fp|$&&A;sea2@w6*mCwny0POUs0XFgtj7{93FHFaaM+I>@RFRyVlBsPl+DM{_ zc&2FUv76o|ZNGhj7!G1HX!DN)qOQxw$%}EYxibm#qN^EeCVVz`^hobYTDrvhG$x^s z*R83hUOwaBP#=nXud^SWraT|y8J!>ZihO-B@sHbQTFQ2>svGdWhh@1X=;v>M*RIcJ zA^(`7RS|8W7wbdHxI-a+0HM5nP9}i>{6QS@ggVO184e(9WwzMsXm#Oe)M+pC(f4kp zuh&};_`n*=f`AwLu(o9PzJ|hN@O_LAy(RH_co-Qt&GitHxacC<_aHi3?LZp*6FO{21Wp??KEgGd*8Y6n?5Y zRb;whT5th)|F)sdpPAhWN0@njo>s4JL#|tJ=`py^u{KxvTK8-6`FZF3G`S?#!CGPt zCll?W1np5TvVrgLR0*O2LKix9?)1q<(Z9(-DC~=ApMqfio3p!T*-|0^Ee$QOLR45^ zN(mcnF%*O&O@~7eqhK@~EoHH?VX=~Bp>pBL21=vDOIs>`?CrMX>O;lz)4=mH5AZ2s zH9L}f)jO95Unqbr;=}m#U^KV-u+OtW7*ld3xI>80@OP4|aGMPDQ>q{Ji683;VPJ2A z<_hY4xpmNGYx%p?LGN&NMi0AHG{8~}r#Lh48W5qMcZ3Zvu; ztsL~PjtF!K>fdP?J77l))*k{>H~@{8I+nQL2?@B9D2KtX!w9s+gn5IZ4FVa7CziP) zP=f%KIVxZeg8m6Z3$`I_4WS%FBrJ|n5P~E_21DH&%=8^q4I)l6s=oye;$M7wk|-2U z03;v*g{#t+0qp+`SMopM{u`G5zrgDLM|1xT)BFbp_BjvkSwKudE@(`={^wlwj#XKQ*pnm1`pWYHg!t2*fpwXFl%sbw!F<{5 zC3gYYCwq)5n9o~qu%QO;!eJK9_gN1As>2woQoyViz6A5q>r{QoEJw~(g-gwr`q{;C zy#Hsa*Teni`%dOZhL@|2ZCwe&9=Fpl{^u_@{)4B0F?yKUX|e-4V!OC>;i>KP7zd#d zSBVmMU6Hw2?gg}$!XnaNWQT=U<1!G0Q3}edXs%kMs1Vc@>aH*SqPwS-u&%7csGij8 zGk{x)?;7)QI=q?QE4o`uoddfNeMEJO1ps9qYPUNfy02KjsO?ZUpX+`RJ=2xWSc?zaF2eT zzK4gJ5XUa(S%O}@7~6(7m-#SHR33w`U>}hI@px*4M`ud(PE0B72?dPgOhJpZqJ2uTgiQc=yaQea z7FX`>eFOp{U#F>cIqIO+B1jBWEgvZHUo!oS`zbZ}A@I45Sj_IEcS>w%h2dE@QrXn^ z47Ax`=38>72(I9y z2wFNRg!uULTRL6kjGLWVJYR!~k6nVG4AR3PO`*wq^DB7=ZWFkf#MJ+rbarFSj}@2Z1X#w zuDcYFt5Yz0kH-F-{%HY-m2Vtf2Y!CZ-$Zu@d`mLKN;bqyHpEWe!ARaY7>5Oyv>=S9 zXNyO#2WMLqhOMuQUh`qXWr*F87B6EgwYTn;uHY%8MudIh5EB+M?`^0vX($kI;-76W z@}cbsQrAMcn76K3ZT+21H;)VR&(4%1|J?Pj$p(hV>(8x5gt_3_oE{=hTS zf8+Ym`Q(t`cD+MDZI$qfO83YcJK-}Q_II}e7NEpt1(k2!3v|?m?8NykJvQ72) zVsYtv!L3S1GYeSmeaJN<0(s3#vOTa(G;H18NSssZWRmVJ8RT8*qi!Y4BBv-^%N2;v zKz~1+2gKfuwe$Vj)`;(Tta0nH5@^VK_kEaJZ*gA8F40u0{8es05ZnoAxXAF-Xg{Fo z2H#t&dnLaWY{dC~}YqxOow z-YsVF&Xc2=ab-j46H=AY_quRjx%Zv--_GG+uQAUbVu0m z3Gx%!ZooJHDzxBgv}1y+77uwC33SUXkND0rCJd9hR}87OYwpmmJ>H|EbCGJUif!uA zcy-2HwG06J<+0(?Vp=lKCcioWZBu{J%+ZvdhJ24`S%y;Ww2!wWFdK;p?IGwdu-@QK z^_^8u$ocI@?AB#mn3qwd1?Z?D@3O9qqm?2CH%8H+SYnGTqT_pH8}TQd`sd7eTxiAE zdS=H5>H7SM>WsoNz4+EA9ki?|))oYOJb6Grfi1w&L-P1nF4dC*OgJ4g(YEe$gLmQM zfn8u}CFP${KFze8A^(U2EtvOa@XNX%uzh@dm-ItI>z(ZSQu8m8TARtWt&Y0i2zZT| z^-b8fVENwpcdqbXdAJ3fYx%!LA|KL27qfPTr%5#_F5k>C27E5Ct^#-)imhbq`CH^!h~d zxmH?H)84D(-WEzL)?9zX!223=!`X|N91IQU@3=+%SoD~jZBc!@t6FG9T7yF0+JUcq zILJGvQsEroin>%D*E%vHKq`^Fg_t&VX=y5EQdNyU)8wapiWkv6f7d9TNW0g~q}^C_ z@b$~|Um*9<@4FUfd)H9HXiNHO1Nx`~NQXv#sR4m_G#uFxF5Q7)oOc-X=*(A$gVha< z1tCB&`aE2S)2Z2MzTZ7KDEg97FH*VEsL@qHV8?Y_>W;7tA;-t=09H!Szy-R1^gBBs zvQ0B`)K=W8>5nm;h%T}m%DT5v(A+XOdPpl_266L!KSW^-G$qV80cK$<ItXW|dwmJ=j{l7yOm}JoDcz8{{FXfk}yIwNik{HDoT<|}?q{DRG1}H3p z8}j{>K0jt`c%7(UQVeAv%upK|ouC@h5W;MwY-&$Z8&%Sx9PkZ5`gtSZqjksd&3!jb z#Ok0LSXVdc0W4MgJwt!wUT!NwrG%TreUt0>I!as6N#kOoJ33qWTauS{^@r_~l59{d zX>A8aR69{M9@|DK%ki=zYQ1mkEFOyJRz)Fwq{1iv7_Fq|BXqJB%g-HCeM&4du-5$9 z`C84mCatlI$Q!D=QV0%&79uF*s}pc5Jk&B5$g={1*R zzll6&LJ(=(nIF3J)n<=2H(jodb@TDgUTJr$f75S);rDsUbs+E%kxkOP=q$R+etgTe zHF5AZw)Pe-2P1;keykVi_7Ha$`qMY9gbPm*ii1SKiH2L6)NzSqp~hu^rCDdd@Dji} zHqRf!3P>nljm(Il9Tv1B#&Q=1G?ha~Ae75Bq_qpv&tCZmZPCtZn@5~VaqIB6B-IDc zg?NI{sYrJA%F!{Mr8Va08H*tP1Xn;j@HWFAg4XWynDjUDSiE%3H#z3IeC8V4FShcp zrcqZA8h#^z0nN!zS7M$73lND}bjxyV0W zlQp(_v-A+hRQMiGa!LCd9(6zU&izRR-H}J>d<-Po58~1ZsaM^g08fs%zy#lU$kS5g z8vL_AoH?*ZF{_RB2g{wT<*U&c*ajy1@6iUQGHqD!K;GGkXLCyRkL0il>uEUx2aiw9YRVFUVNG0hZ7r?G z@87o-?w<{usPGTQ6R8Lu6OiH*3#{rXu!>1eisP8txHDi`r&GZdAVLatEv?jp4P4k4 z9unE<+Z<1VL2D*9A*zxA2&3$&5LS1N(t1^7u@L1y+(nqFCjOp_%Bj&~IoSY{6%1c> zbXh^s6tl8z3W6=b%<47D$-mlaKyg4E_1lnt6;EGi$3JlQ%>=>JSHQ+JFH$piM{a?P z;7JITq-RgqCG;5Sf=<=+6@D)$sLH6WEzRg$N?}tqU)8MPN^(0n*s6-O4vY3gXG0i~ z&t=Ep;@Bo;E*-^-%KoyWq=yIygZlTtf!cnrd!T+`(Nok(bsup=K9&ndCF2WFY|~xX zUU3aIg!qs6FNG1c$-l*6d!?iB9&ee`Nfp3(IvMzMYpN^x_>*c2gTJ-L)pU85XylH=6DX} zJqN$FH0%%_41kl3Ib1jqOF8(H&f7{p)8h^Fhlme$|CY-s{`;J<)56T7!8%$e#FJK0 z8am#PlnZECV_*}n>TsEgTFJq0+WV^*%e5-J3?$;*HsaQH0XWl7dWoKMc*L3WIMm-( zcent@!Nyk8xu)7Pcs6za9uwI9dyHUcd-0D8|C+aGo8Xh2;T*FPfLjo!w4lX~4&cg^ zrzgxLuFT0*APLFS=NO8Ei?R0n!CvQB9y%ihR>_L0g8sVM0XNiww?k|I3-~yEYj8wu z4Po3e_VsE2PU+Pw+24O8iYoS&09Z?JgM+Q9B zXHZ=W!MwM!MM_i!arV}2s8(G@;VqH>Q`DTSi8TSzr`*_!|3TelnmKXFg_Ovs~%+R^6=vZ53uY1Hk>lj=MQFk zm1-{Ddr_&U;ZD{4qh<~NioQxGJ&Rw3EC_6asFyWToSfD7wNJ2K4x=&XBAv!yv6$R@ zk3u|92hnt(zov(6IsZ@Jw-Cvzsv=Fo# zH6jVLTR+{~+`80Z)LL~ziPbwxzGa^RG39n`aKe?YvKy!?03b+d%^ovI?KrJifcL1iJMIbiB2QV7BgvRCmPk%DyMgDKOB{Z1nC6Qty5J5Pt@tirwa2WsnhoRE`J zZso9KyBwgQi2dzI_4Hv>9K;b%mjr^Vh1AZEpRPgM|A;Dw4>g3nS6V)+(HtZ2uZ6zU-%1j(&}Uy4C0xQr^vCZZegQWhJr+B17X~XgqhT z8hfGqIgTzY#6oTe(k3*jjwUKiJ4s8(1N?aO>cs4jQP8_D3g^@61FCOpr<7J%o+uw- zgwV(z^_?H!bg1cE&q=`@KcQhDa>SrC>?e^2f|EgdF(x^Ub#F?jOHd;7(VJ0ONY-NI z<`4j$wgb2QktWzgq!@u;)YvKOG!7KFJ&radIwbd2p~5w(Ju#u!O59TC`;=H0uNe_n6DI~@9 zi*Y122AKMJvW6aZav7T(%97ogE}Tv$>!uZ~gL#@RcGOn~_o zFW!mI^kRFV;L=p9?x3x#(29LN&M^7m&6?8R?!fJLhIhR#KXX6TFDHlV=WI{$%`N`5 zTfL2hlt2UL54hc5*L8rJhT1}jX?NDQ_qP>r8MTdjTkE?R9Xw8{zM>CUfGV>fT95J; znd9^i8uFy-fb@gd$*ZR`C(Ns#Z|t~)Jh&5US<4sk@I|9k+gMIX2U{4QT%V0RNsadb zb}>V*6o>Pu6vvIJu{9XA1Zh3vsb?Iuy-dM;=5^Wn^@n<5u7?Rla9k$I9{Q69V?PUI z$6*BYCa4(cXko3lNe@f%09~BXIcKDZ9XF*J1GS(?XtW@N<{Yh@MFTq8cH=>JrRpS* zEr|}@xUI}M7R69aKQK4smyr~323Lz$)%M{A1cEn?!r7A^#+aM^8wDYE>pn2-^_K}D z2LyW_lZh@x$-APivx8Rl%CfTnX6gx%P?=VRHSiH3GK+G8vOg%k0O(1Pd5V)Aq)W&s zZBZtaLRVidFgJZt4l#2ymScD3d?CQ&jGI{ZgX3!@;h`{$lWHVQ7L#zgzq?Vk5=JVc znr~>FhajTaKN82*hw0LsMu>c03?)GZxk6aij6G#Qz8Fge!Vk>hP5z?`~5Vq_XW2Od^In@Nj1f+ z&%L(xS5WHj7mZQklxm}qB<+HvpdsOt%-b`XB&DILxH%>8>JSwJGF^`Vo4RV^to|bz zr(cm4GA0kH<73v0Kj0^`sBL;Rlfr*?=7(XWbX4h}YsPO^ZU7u5wCgZI>$^_&f;Uv{ zsbwp%q{W7NmAEg%R^RH`A^!~G(21@H^=*AKQCTjM4n7(mW8u+eeHi~U)-d3w$4IBl z*x*{p;`*()w6v=#)S$EAS8NE23u8?rc0U@{t(koCu9?*f7w-0SjBJa(NQtqM=|<>> ztcOd=B?Mh6`3}H`Pkv_9vuEiOacr$K+e?V}>)G(LwIoBp(B;fbm)m7ZCA#Z&>dy&= zhAEEa%+Bl;9cvXX^%Y8J_$?OQU+N_O=(QMNTo_d%mNQrxDiJ#&G@<>7nJPzc>tL#I z*V)V^DD5Pwa0Jr2MlwL%QlPGxOd*~Pyd2H2!(fUC;8&O&jjPGGK$_4e`3x19%>>1QD( zcJjN-p`CBeZScox`6hEmaaP)JeIApr>gCPMa~Z|5jA(T!)wL^hqG0A~J5EN@>>+J< z5*!`?YuB#X?xi;Nj*r4--Lud6+p|`LxSvjsZbzDL_gImR#-&EJIfH|G_ajCt#&mpZhm)#m@hgbO6ONU zz(Ga|Z3!=)8hTVFX-Q3?^;lumlgBei&gn6rvod@{51D_3v2nC2DUmN$Plfx>vy1dD zR1Q#_!;iYL0@4WWSc(D?$kg72|wXR1Aeq3;{aCcC}?_EqOcZdy(d#7O{2sdB-E(uI%#VFYCLC*a)^=szS*H z6s$-`B~1Y>0;M-}6qOl0-s_rRVtjyl^=cV)H9GRHaxb4Ed*U2vtHKtFJAA*a7We{k zwKOAm#@KwN<-#g$>@OdoeKCQ^Dyc+(BNb>2$!4T1i8o!yx%~c7Z7No!G#J=QwKyI9 zJ;l7Q+iOv(y*S?+T@Y(c=HNM{O2dbgpT!z2)_igGZFUvT_4mH!68v?$K?$pU^6i@^ z{5gO%#Vn{A#RXbbw9@G%52CI6i0B#Y7Qem;dKFDPv@J+TzCG$&DdmS*Udd!RaG3nVOrS%+ins&!zY0JYCr0PN?Uyo>S5?Vfe z?;OJIJwu-V>@fDfetuC_qSTt1Co(%;*~|FdF(8&=*l@3a9}xcIh>lYT;1@v}7Y#7a ztqBu^*s-b+do89-Wx7p;Hugo=gZ3Y6LTpgkH=I4GvC}(gp&lLq^@sOZ(dIsL^_b>d zQz1!@24}%iZ*)?lQ~NF_f2gRcy0~yQrfMGi#VU$>es9cUyfd~DZ*$ECw#uC7?_E1t5P0krhJ+zO-G3b*TzI5aG zOsK@vn3&o;1~RJOjg@pF34vHvvqD3EOHFQ1ZrSn-*9-99kAo6shh}40o5WzG8eYsN zql~;_lS$Y8zE4|70R2}qsI3eY;}?H(Wt9Gn;o97SCCzm8dz3U~T~`cOua+Cs=aw%O z{8gHp6O&^MG^KAtmzzV7k5{P|f3DZYuzu$15E%tunATj83@@W~&r@Qx@ zd~?VI{NV`p4>f0>poaJGMO~hmo!B^`YwyJqSQ`+*pU2w`1%#qDX$A*fHO}CRmVsIE zviY)d3j`?kPc0u{f=#rU7Q=lT_$8J+m%E^2@cIPy$wz@SPjl!3_5Sfg95U|xT(P4r|;}wlawR-Md#&a)BckP z@E_FbQmGT=XgZ!bewWZD+7z=QC0iG>hB?}e>{_WRP77l0rJSjfNQ4SncUD^D!#T-3 zRG<`#P=VmgN=VzT; zB}&owqaAT@$4MNUxGbto4ovB6js`Q14BUa`7WEl)R69Z#G??(ygAVZ$jkH$M+x(EP z4GY0M$2O-_1+H`z$@ohXJb+Dicq)>-ss`s=EA;csjX+am$!e-irdWM=P};` z&HH@C#}U{0JnFCr5uhC23^S{p#V)0mzERTjkO|48RVvR0WtY*;WB0@`!Dl5#}fSsM*>d?xG_S)h8Vzs)b+m#BH1^3nW8^ zDHew82%~V|iP~td0eH}XGd9Bfp5nDPWN9^i)0p+n+B&`1n7n$(5kHOml+Yy?csQKc zdxmxw=ZiUN4uyj)l+aBCi}|T%+izu$V}0ZDztQnhtP2KMU2SKu$Xu)@ZZK4 zqjqtr&#uK%Y+HJyg$#Yey3X0sMT@%&7_BPPffQjg89!foym35 zDP}{rbx$Mwn8CSV1fgJj$k->xPnZcX8{hBQ^~{V!(hqryiKIfO6kp3c?DGO1X|7(w z_J=K^0y`$Q1L>N!QUS&%Rq2#80jWZ@>v_NTl@4r4gGF7%+h%4&M(iNWN#f5&1A752 z#OyUilmm4-p?dNOHAS_xwmQP{<|_3Qcx0cTRK8>iQNSWHKpP)Si;39UxcOU5Gy8VM z_8SdS@3F0RT_bap?!t^sdP+}yd;PM)>nlufmAbSufY=X(7^b!4XWP9<5SVa1gI}{l z)m(SYLLgIhM|NFj{lwC}+iBo)ZB*lxu@oZ>+P;pbNc>bSt>i#KjpAAUetoRMcOyFscF6%2)OF{IMNMc}dTo9u+r_T4Ckj#Z zyPXa3Z73hW%`%od9+}*qGXJDzDbuKlU0@*f=0_tOSU@zWLQqFejq;=ctkZve2i9n* ze~P=-U>h7nFND@0JWbZ5XkmvhEXot_KNb8)DK|IGR#Gh2FIq=F_gP z?y3CK14wTSc`Q@al+L_-|CYsfnyjH}>G#vU0*I@sXcDycX`Xo*zJPk14beu2FlOBb*Dg@49xrnId!LpY2jCtqBdzI*UM3nKw>e6 zRk?Jr>T_COc#tX}^IGi>=*}XtPC#68r(Rkw zwN>rr#Wxe3*7s8kv*9yqX~jN^T?)(UGHEGXN7AnOrtD+dQg~3S^{u>BRKu3El6$< zBn3pIyBkD0MCq24?vDRnoO7P%obkTz^NxRv@B7BkwdQ@zYhH8Cd(E}nd$YyuC3cWi zN;+W^rQm%1yW_#L$aC(WlMi8gZPpPJ5&Sn8xk(AdY?$~95R zoXBuO5;Z3Qg&o^QYd@a4iK--%5n7Qn#-O`SVNnz}Tf7xZt}{@*pyWYs?;+KFcbBrB zeilQjt&tmtf+F0gBZKrt&x=>cYl7>IHXKb~mU!xXsir(1qxe30~8cS3k|?^LwU-tOcLjy!ez*OIa;s zp;LA!Lpf-K&=5jZT#aDF4B)w zZxOi98r@Uvij#f!LR}0=qASBD(p82%M))w}iG^HT()hRnGlRpAmS%spXL@)0hN@j2 z)H@VEX{skRNvEw8rL34>Dkr#NbKtE*QQ$D zs-C8zwtdZrsif1=+AI;Rv<#|tNkD!KbrMLlt8QO^In9r;@cD;otL9Nrzue@WO+6^fZEn6rWy%UzHTHX}WvAb^ksl*}`&T ztcOFj248jW`>OuowuiMH?@GVxUa!ueXqH^H?~s1|Fwz}ozv`2Y|@%&PBX0X;jVS1uXVEO z&Sh}?W$@T#?9Lytf|s#vE}ay09*#Y=cc|}dmE5%otKP~aNoYT&)(YH~ZtUv6FYf4z z@EmOQTl6Jv@0C6jf%Gs+-OMH?E09#3p{Xr+D1E6PLY}*8^=#gtN`5nQbF0Z}Nx82D zlMZLdscE=0H@h$CUdJ@g^+@xR(ZV@bVjBLGgRd$e(sjF`B7Kw-ys5Dom6h`ci6wbh{o~_{~=veXDe4 z!fWcNj(e@w!zDulp4?mXC3MgJ(-dTjejUn0?{gV|&2p&50AewkB5By7--TvN&nFOp zcRq@nxl&i|)v4ZGq*f0AIylrAgJf7hLQo3w_yV-cq_(BxTsg#W_+TLgH;6 zEXJFXDZccngi(sa4MAVf(+T+tBH2oDSkSLWYl4N1!xvxt9A-u3n+870Qh&)rt?3g| zuQn`;+)fS8=E|oj1Ii&SLf>yNlkOJHko{XE%q-AsBOFEpPtk(}(n3r%Tn$t=eenEE`oRbS815Mm zF(fb6rB8YmsYE*16&OKKKGghDjul+03^fv;9*|J(A@Iz$ho`R z14XrbB+0r>ZLAy=Q*IHx(5XGj2bFcD>(Gzu*`d$(bN=z3yt3rAat8o6!7-5|MSB!} zSFSx;N%+5jD5&Dze?>r-AsTO(hF*YI8SF8RYJ@CoAVbtOnP=YK`NC5-uYn=>I9=Iu z>6~W%w{uZw>gIfZ4^9F)Na{!E9jFM`5v}ufZBu)3Ua_*IxTsT##jz?){`IR~v-PQT z(dEbuZ_dMgV5azL+*XuN493nund6 z%`3X`c>9CTx_76h`;&C#p}o|jGOl7hdG%b1a^WF&AEgu0IMLnIqbnec59ZA7Pxp)E z9MQh&7N{rz7YjJR1-!(7`GKbO(cx=^WS?Egd_8}U$Q3bF&ST(v zx<_?}W?2Th%4-XT4_JF5mtSifxz5~vT(Lk`*-tWJq3=z> z5d2fuw)S7&mT4Ayk}B&~^fHov`C#`@zQ~#G5Q1Mt=t&3X*vx1J2VTC0U>Z@P)}u9@jcPIs9)KIC9%!v7^@y~n?dE3LgOD`k!MY*d%;=iBc?AN{MI zN{_|p8fgvm?T;8(=2I?zMKxEJp2$pD>)b1ZCEle12?xWgd_du6-#*Lauo}oqsyLSI zFI4#Ocq7w)eWF%@J07!cws~__aU|$#%9{M!2sDcz9<7fLgHu+xA+N^p`Fm3|y~k5; z=qAupcA#6a3JD2Nqfd7BTssj)R##*c#&^&2th|jYrncWsth`7)s)5-k0Gq_HnUV^d z5|zL-@PkbYr^Rg1*N!QgpL&n#;E&^r?e z4YBvuor`$B^zhOZ_T5rTs@l{UKGxWG8rvgwG~3{>EcBS#VlEzv$67anv_WAA@Zkr+b&cxaLIc?n$n|NzMerQL%YeQYty)$k2>!W_Rq1X1a z4Q?L?iPdnLxnrW6xF49MbK@0jvEw!0RR_=%47me{SDzivC)J9PPE*d8@g857&BM90 zC&GBIb%~C?{Jh%yY*0q*W@$5bCEs_+4_DV8e)FAoPj@8$oO;7fGn2;uZN=LJHM0N% zihh|#9Hq_l8QC() zvhjSO*D@H>kYqM?I<-26)c5yUaksrT8Nhn*df^__=adNzx?W5M>~D-Vx({;O%cI6!%&!>kPZpoI z1Yf+Imv4rDVmf`_BV~4fp-}u_WPAF=mtV z!GOLNhI;c1vTNj)R89oDa*n;wG{z98-*cPwFTd{lDSQ1m=+cd}xGz97YTRgY(Sd6P zIqY#6#L()FR|bvX9ydQpT9R<`xEq?sny2o>5Md_})@~_UTi%z|5i6>D7+yu>yrLz) zZ*kT7d}6CT;_w*K{Fpa!{Aj{-{mm@1oWE2B?$sMsHBob0r!3f`~}4!y3mWm z2D8xnui!sQ$3@rlBs@ZYJ6Wz(^(L4+9-uHh#(I(Dd9v@mUU|riziTUYb=|<&-=}Y!}kxi}mqsS)FvIea0GzLT!VpJhw8Oj=Y^0TW@!O$<|DzVL138}nl!QfYyZH$Zi*(!deZ=gI8F4wBNhP+qw6$y zD!>mhN(q=?VV-5t_?wQ&aLY&vm;_=?Brs6#t~ipXCT4pv{9Ajfr1_d98i79>$aFm= zp4ZpMbL^^g3DWKFVdqDOQd(aVTW3(S_reDasLJZHF~*Pk^Gxr^2ebYBSlFW7e4Lsq zgHP$y#g~&m0panz)0`))E;5T&dV;@Z`&Or^w1dU5a^PmnC(6-T!sF+<@NUa$ zB&XU;0zV{uXfu9Q{xOcVXwoN^XmCxR{Q`s-?W;lBO zzE!e8veCxSzQVr3ps06?^!%br;AW&Fg7<^M_U_@tg^cTAa>NG}=Xtj`FN`7QH!tR$ z-%v%XYVcpUtBBMVJ<}4Y-b4`yYQr37W2Cc53v_P?Vch;Fz#&U4rZ=%c9~Krm)oHzJ zk-tyi&fO}IWv?Em9!yc2yjwAZ|MB>yZ9SDlIu0$J-;mt__E#r|*|DDvzsu?HGQrl=+>M`p( z!_N=C^d!p{>c@XxOz@r<`1k^^_zKO7SiU9l<{ZgZa-@wW7OB66Pw1U4O8a*PgZlF> z-HX=w_sb8yAlWq;7}7L-Li+xvSlj2DyTD}bG_dX0>H+*JZKsLqc)F*~a(PX%) zlG}Lcn28RAFkX;NJKo90L9e9IhIjS#4L2;3eOC^emeMH&=~khioru;fawoLFhv zlOdNi*^ug5Y{Ku%@RxTQGj<;S(9}Dg1;5s>j~7)uX7gRcV-^vnOG~nIj|sYG z-899UWKL(fX%k!kwR;074~A|!%W-pXRtNJVBeW@y7TUN-ZS5O;DVny&u)q)&fQVqoy@3~GAJHi(L|)UOK&}9VG3^^N13^gE=@N#yN%@NS zZ)YXOObPy6V|yxx22wLS-p#&En3w_BevhwRCBmU&p}s*Z_Ehizn|p;#tny*h40lQn zq1AFnDDqr~_9`Zpar7pNlm^TA&jlJKHhZ>@Z#A{9VW^Uec zq61KbJb=DO;01VRofvCh(3&r?)6L^=6nBbK%8+HFj<-4CGQ}mavsB(~k z1sho02kbZDSNwj_QnJ-ahOuUusBBjM4H zkJ@q{0JH#jS>p3$fEXAOz*E|XkD4wifb|n)g1+FllTX9dDSXs17Xhr*i8XpNDhFV6 z01pQ6c#h$t#+wU3SgW4^V(IA9Ks$o(t;Ze9#WlGm&@$_^Gm;w4RK7Sb>)tv2u=06g zZ@JU$_&I`+g3~5R{#*6V;rN|g^hV9w!B_y2k^)dH46(rwPJ6)~*Dct>1x{3H;B14P zcVP%0K;AI41R#h@gt>XJ{t)&`z}{=HnhfxgM*!$P3=smTNrpd%{r&oWOMmCcwnOE( zE87iBi>Lhe^y5d{QO1asuMU3>vTNW^k3uWU%%CoKs50+mc{3YtRn7$%X14&>6mZQt zQO2UQ0e2m6TVengYM?I2E=?QrR}$`Qu=;5TeDtpy_*Flkm9cjN9ghVs%b>d;JQIZ5 zb)!^k3U6a{Z&fdL2FGFKt+|)p;xt(tQys&U&{pd#DNfA5MlsADvcOYb=#$6qPOj^ZyH0!nbptQ17vF>34&8u=t!fL z#BO!OxIh2NeN@0^v~8f$J=dK2Ng*J2fDZsx0GI(l7l_D35(Im*(m|xEkHu~&CW8?1 z-vyes}DV|_En0)`zhRxp5}2qS2~U<}9d z-=1z6aEC~ykGAa!UB?v2?BygS`zSD?B}|B;5Q!=U2TpR0pQk7=sy$4IEp`$im4fe_M0dX;Q(L+ z!2NCR>>+oqqqwQW$M0{rxD<)CHycGn2DB@(5FqCjDPPvU1i%acmI1)>fcC~ptjGgW zUYFP$QwWF+&KVSyxs>NyK2l#X9|;l_3vemXArS~3DLNIBojueq9^7ht**)viJ=%&H z&lgU>Z_Yqx0X}UR&IxfZ&|sQ37&2!8zykmz0zmpmzxe%jB|}a&wt7Zv&sh(c#``4?*%?A|Q(Zzy*-^0C@wD7XWzz zCUcEwO{RFR?CE))3%d_`0SemLrUvdYG*e8w+idc1DWJEik07};h0e3I&gkNZweuTa z?N0W@9|FJ?1`-JPg;oTCstpL40wL8P#0rFT zmsys6j>#JXT~vcEJV6)uivhhtpv}?*IT&gGLS$hr>Knp^B1ohzc za-|pGNCJ*8=o1(8Np(DvCg!eokU00SlG7??$Fh(uCcj+$w$p<)9~qKZ%(qQk1Vx%0 z+h>xr%pKJt_n+CjgtPtHrdKJSmrQ-8YHaXB2V(i0FytI;yw3(6L` z|MMwurT`~jy5t~EIsoJV5C8xa5WdvzBa?{4eA|D6fNJ8jTj0c29wO;MsM#%fGXdwmf95QZ=@LT#t^coFDa5jx5m-l}$NkROr`=o%trvHet zzHT+okT&srAwDwKRVGsz2y?pxdEMSddFN2p#W~{PP3B1 z(a}(TFrYKSa@lh^9e>kLT%z(RO|`}w z46eKLoEHESFaW*@XLi<}N8Yp7NZB7CUmLm`(x}-laAiediadwiaQ{l}CUk3TWpr?I%!Bo+2NhjH2OBDm^E> zs}gWLQ+#Ew+2rhZK=0@ef@FsbaC<%iGZ_zNlJ9IYdyl2sM)0S4?YFMpdPjk)t*07V z$Md~aP(ML3Upkmy1;C92TqZET(hIXgEAry*y4m1fodAO#_Z{5usX$Q{u-*dJb-<#t zs$N})_;MW-^$2e3J19yPR7n8d!!Eb z$nrM?kaU2=0>tF_>zAQ8U|0iJ_irlj=JojPTi{Fr7z8lAz ziGeywQ7udL6>F}A_~iP;TK0Le{?1@S9nP0yNAX3@!g{*I)*UU&?sc^sw6);FK?jdw z&5n%(&)R^eHPyPOR<9vmVXlkKf$pmDs1<>Eb?8=^y0NXpiK6G72mBOCTqa{h!{e4^ z#`9=#v6DJ#u1=1w(7VHp;?1d{Uvx1m1I5cn9+jgVkH6&Z-6G?)t*p@M$y;1(G32Xe zqisoEiscG+YH4xTNwQwdo)n4^Z8z;UQF?~qAS5;~CAY_X6Pch}; zVUvAFLU*OxTTa5piZIlS32}dPlD)FbA1sgO@?@=~gi1a3t#t0h6f4uUB&XZ+3ohje znX)|J;8@t(2-1LT+4(94lC5-OV&X8&Go+ru~MWr7}vO7Vu*#biQ zs`skTJ+}6zVndbBI=?dvHnB*!hQ(q|%`!(L)HR*VMx~R9iGt}-8}_7=_xYdPB{_zYyQ6;7CqE4MO&?+}7NvM2 zS&c2kS2HD{ozD(cJwNW~SR_+7nQKv?rCqUFa$YJ%nk!jt%cnAkt}77wMsM=?`rInJ zcg^Wc>rnLGZH3K%i5oorA2AH zZ3h3NYiaI*wqjqI=?q5^DI4!qbi4{5C!z6NZ5L#mjeSSN(@~u_AQF~Tn=#io%-V}W z5nx0eVGBL@hE0*7ukD`lAlvoXdW$j7Nng9z-ks=_=&&1MkCtzQ5SZOC7!(v0N-6e~ zG7-Jw_gO=pzvUxt)RQIF&wY2z6ZhHu#L~I%KS+5sC`_Y_gQjQ@8!PoAhrODhfzI$g z`#Zv?rg09B<)fMcpO9ZhB!{y5-AU(GfFs1AL}eTzMT59lsTV`BPjH^zpF!H+S+{!> zwsd3hM}c;!HP)w&#G(b2T81a)d!9=r2c2^@0s?BU-;2D^eYZ7+!{otFOaK+pGi_Luk%Sp5CdZjEiPgch88bl>BKGLrf&Jr+e?xny`urTA4mHIVRF zyr9$VuEloQ3s+BeP7I0`!eGR^CYf{BnyKm9^{Y>e;VWd=hNIau=IF+KpxXB&as zvgn0R_8^9)>$gd@f-o&vH??)uxmaKJ=9&#bhtdKUmowl$4M%h@5sGT?bpU+qQx=sq)|FO?R@535Ap)q_Y#rj zr24T5pCnPc?p3}d@o&fHu1tAt*Zl+!iM)G1=pO4(PAhli^&0|^zc1A^$Amv;PCcmT6Z$^S%T_T>pKV2!Sv+N zPf^d{cFZZ%#>3h5Ev+uGLmaGc$@XDWhR2Nu;@syYZl|Qs4nf`No2{^Qp@V3 z`pAP=uBzbV3^vcC)I)^_sV+B~m|bIK#P7Ua_>F}Ow_)}rM4Bccx!xH#Eh4O|vdI;&_;Mw_=#m&#rg5jSVv5~&?9cGHKJ>VTtV^S_rKj!Hb$CkMrH9Bf9(&_a!Nru69D_S@A|Z}G?&MxK(Cg?hg?8^$v8^uAIzMRBVq zxk+=_IhJ0L*u@|J>-VbW0fpP{_S~xhjd#$+))dE-z1+^zl8dkF;%9CHqMx>3FqqQS z*W992AgI-7>$$Et)h2dzWKBk;ow4EkCk@1ZwNSs;aZG<{h@a9>eBEh#=p?V=sGF!# zNEavLY<7DrSN<{S%KSa*CGaL_@XZ?seN!584a{$YZ{9lScVHU%sI7QO7C4z*TTP@y zpU33PCBM=*nR$ss(P8`|FY2svXrLc1$J)Q`T|^Z|()_2roqda(>CshaG5Cp?>LC6# zqe0gkEmC6nsnt4qk6p9RCs;Y}4c13IUfhazx0usZ|d8Jqm?N#9(hGhp;w-< z2F+zS$we_ATuZgbNs8m+p}pmaQ_X{T7uBR*E93CbOvycoovh^B#hMwyvfxrY(a4SkylfF zq|0$}ak0(>ahQEJ)`-dCnu(+6nqI5vf4}-)-7M#;XHlxcYf7fcejOnm@a#(LuFQ)XeAK1-XI;9`x*0lT7 zf-K{m(d84-zsk37Ja(l!j<(}cpLA3Yn(ENn*nN{<^BcROHE7U!{^2Bs%hKx(SgQL{ z%B~MoyFTABwywCP<$^440foV_V&@ef$6SM;8nMHId}2|Q1Lcg>JmPw%$>XBU-H%hD zKZ$I@@`>xC1zZ{rLGN%e0vT{IREwa^$`}soYK|6=PfXHzN&Pb4W$9-Db=#j=r)gK< z(4+gm|Lo(BP<8WvhQ4rLg48>pCBS?&Jxj+?-~B~A?_{39wOj0jaq8Sa3)R)-lqmi} zZh@DH>X1ElH>yW4y?EA4ahr%FJYw$!@k>QZ=v=i~^>K_QLurz^S@&4KzF8#tr$MKO zxi0yX4<1H({k)Qw$!D$alc_)$KHA4ux}amp&8L9+gsSrMV9fwN^!bK@gxQOspK%BE zjX#;O?_2(g)7<$i7#qiolKD{Qsre*3=2IlIX-E1E7c2^t&GOq)-e4@D=$EmA}V;IyJ0bnM@PP{(k z`4py_05mhHp6j@qvFLH35*sHgNNF>880hOSIwbnWNTDG&Gs(w{xh2@$E) zsvE|FBS*b^BjEF39EoB6?PR^W=-*X= zRHB1t6S~^n2fWU8H9swj;#$Qjb?P&<-OLi&6X=I5^q-KODx|xfi`1WPy4@;bFmiFZ zC!TDMmW7dds*{{&l0RFwum(xy9rQ{GhV0C*Fs|Plr^R;6*49&^@YVakPTQ_)RYWrT z#PPcM!-72Geie=ro20z`ZIOD-TrQzGjggPL#Z8A%Ch|W`9EJj|id?D_tb=7M-EYVH z59+Y?F6SXRC0Ij-6f;UR^|%t1g>`rn!?pATU`tphd~Ch_P^H-ws{KGIApA^KTjV_B z2jtpEpt|4N0*z;!s6IShj9zuo=<@zqxL=uzGa;y0b};^m(tN4@eYUx2zZvJeyod~w zZuiCOt@-Etq}32wJ{x1V^uy zRgzXJcML|w_&xZX45ide`hB=f>XaOI60@;SwUCxJb*^M=J;SQ%vUS!w|43UT^0p|K z{p0?S;b#mzp6@-x)mI!`^4_ZTo!gxrm;`Igm%9&qzWLgd^VGMb;IOl>PLh#FrrhX# z?)~($wz_1)e%G8&=js&hyV8}1w#h%j478TR1R5p3D}_ar3>86pyHfq*zeg)rSH6oi zTs_J-LlbvlxUi%UQx z2D7*9Wkghs*S~cpnaY??KW*xg-CADv>GX_>pSra`R=j6zD8;p5)$xk}g2JaR`geCP z&OL8-im90ia*$`Lx;sTY1~>LNC;xo?vh~twM$7&IM$>X;!%;(^`c~;IL(aG65C1mr z{b8zVC+7|>ZYxQVmCp!7za%4jtz!~3ujSHL_q?04j-7w(Xny`lQWZqxI^cI29)F8{ zT@SMrA|vaa>~41r7(6f%mGmW&5zJ&1iP0-^%N4J2Qqi8!$x$bxo1{>tO+hY)v7PN5 z&K-3c>gc{-c>*ciy!CW_@yuF?`cTG=FWEHzCGl#*%~5=6{r#a2HKMjfIOYSOKq}D&@0EKm!i(vy&864iOJmc%zR{Y1?UQh)O@ri< zvlCQ%II$q-nYB%z_q+3PdX2&M0NrCnkC5M5>}z%^z9TdB_g}|MCB-LO2c3O-Jg2@% zAJW;frmg!m>xkyb2T8+^-L2T44%h3GJk&)9D^syWgpQ8|`b*}s@Tyu8UNZa88io54 z@J37@Ol%qy5uU!G66-SY7PoH>V1K+RZ*|BGap0T}#9j@Tq`%tmk7R z-b2zuJL8Q3^?YNGcG6!~htKqicFL&424Yr+R{bA?PZLk8W}bSq4}Q6HrG2?{N&mid zkzKmpTi@OUuRF5yJv)yhLz>1nGwY0?+XC)cTqDu#_{qyk``fn7Y#GOq_{x{QscV-$ z%ce^on@w}ZF=a^>S0&H>vUy(-@)TlY&>T<~cF)R}%sw^?c)Z7Fs;ajJRQ+?8mCo(l z_V_F`kg{H^NG>lj+%&a478A$(I=R~`$WSj3W1{4I&3YWP=wO&L>q5g_l6=l?Iab4J*Tq+~sTr~3V+Uk0dEU9C|KO`-Vx2w|NR_Ev@_>{n6K4fez_TptwXVr8s%D{WNVI%T63hI>bpL0SUSHO>AsxMc1280dV3MY?>2~61zw{^ zf{hi~fHOWG`YXyC&O+cm45DU9U>3K}pHV^LZcH>9da!Et$ZCka(OPUxX?s&*Zkfv6 zgAoz^o$ziZ{;&}dgPo|ZQ8@FP7j8)Wf~ahQMtd((j{f{e+q#9e@Fa}0quU%Io3#lDi*58*h~**r3&82g~_e_$~T}R-%l~1qu4JrNG9KBA5CAObX;J`Ztxf1 ziFD9!PIhTmESTx7F}h8DmVO4iIvZgZh5_t~ymYAm7XcM;tu(=|=u6k=rON@h7+@Ff zSJ=e@8Ny+Vg|OlW;NyjT94)Y~^wMQ^>8b@TS=goY4R*=CfTM~oT{FO?4!Z0 z>FUCZGqrTbIu|c zg9&ME^!`UyG~~}Q{RiJfIOto@#6HLT>@GoB30 zc;5XZF23WMT9|m=c5ap-fO5MGrj(DsloDrJ27$3b6hO9t$#y?3DIw*25a84%$+xYQ zgU>$L%BL>{{VzEjRzODa$KrK6X)8GA!^+E?3zw9H%baH*XX<6nc$nOgTXmUp1*Wti zK+d(xoE4XPJC_vv8kpkhCEsRQ15!R?E8o5p?78G9Spyk4gNCpV7(sM*wJ@XTLzTUq zC9r>?umpkyt+KZbJ-@5SM@aJWul}{DYA17FN#*sa-0N2)D}5HP7k-znLMFfULE^ln zL3RaGX{?-W(`!@Wf>39P6IkJ&r%OGcBkPLWK~GL4`i&dwn_L*!qr&gafx}B%UXsdc zD7`2{eW9LTLAS%HAJ`nS0ht)sGw}d46N! zJdh?nOTjevO(3Ras6`UADa@et3mxG{=_!8kRk)+a^#StOP)1;2=}@7wo$S? zx~;_TE6BDW6Nvt*smwJ@_Xb!r?4P-aF$=7&QHfsegNcgBNAxYPp47`7PL$p9BJ@Qo z{634a=Hm=vlU8;>an5ztq+A2EGVAsmS_3S{=O3GkZltkP7Sum1rp3caYeHs9_rBm&;4_=ap%;6aRPa zcYz_a1mrQMaIs$`T?~?Yt>BBPoeCPoy43lD0U>Pz4WVf>(W#vGEdhGroaZ%hIu=U@ z*~y~0b!QjrV><(T-DVn`bhp`O;*guDU+_{4Sf{ea509PtA>=J@msf>MkGQI|Y&H!VmmyvX^`3vPtR+tIqkqWDegH1u>HJ70A2LC?Fey6M*XnZI+g68!VDnsSt;17}K=5Z=M*raSwfZhF4dTO+lD zdC_Bt{T7;h!Hz6ffmwx&qtD7Fi;Rj zE8F5T=qO(2T^v}5T@zhN#7FTR98|<9h!VcD6X^j(SYJZ~HbWp=U-HGJ|Dx6#fw%zc zo*Hk21hhbcjyQ&^=}UG&wndmg10+8F^N=+PLWvZ}=}_Wa7WDU%wNiQ?s0ch!gB zzt&^~#o&0gCeoqQXiiLazh88EWPKrxI&&Q{h8bn!jNWk0)C^e+v-*1kIg%iV)#*?Q zYORMq#NZ&l8R&woPj<;f&_g5$3zNTA`d|xDy})kbAhy*}8XW(%+BebN7EOWwF*ldm zRY#GqRYepex?~~=A|#Ns5quCHB`u0GF5-DnABk71X$(=IS zWwMB@?;f(`JgP0GH5~|nihrb^Xvn+_` zCY;!a(0?A@#US((E16-5<;U1FRndrP+rtAm@(3I+qZX&Q{!`dx?4Jj2T~sfJg-8T6 z?F^3pKKxPD-|GS8Wus4%ual2&wL<4N5R08V=O+@$hh$z$B)hy`%2QYO5|yX$_iB}= z2=>r&Vo-dKe<+*eRbgEF#;ZPoiUq>0P<*$#RIhl=u8>N6;Z^sz%KgqH@0ePjyjL6A zyVt;-RM~;BareNZ|M?-?5yc;H;}K2H3t0~l1|qMcQKk=FuUuR1QZ0wUn`p2i9z9Ut zK~U>mIF2qAvX|^E>ba?~!;v{p1@C<8TUR&Ywd7e+HPEXE(Qe*<}y3Nt{t%{cqI z(=v#kb*QlTE!dnyRWyB#A^_-QaLqoKk>tSCcDi5<}xqK=Mbcq#=8>k=mP>E3bTv4!BF!=vkym^Z- zt!)i~=Ri+%f|RD;_)t`kX{S&bQNd50!8b_n%c>7Dhg~ zUNMXEEkB#g=AZ?Xciz$<_n3qKm<){yg8S9O1N}-h!=CQe|4WVjH+{l;2>pjmtl+wA zIY!(7OhIQd*vEtU$A4@jEi>3W+MC*#xn!|eLz3XKG&v}bF-?26(j-Ud*E;8P6WU+M zR;Q8x?E>W0Xq-kE@6z z_F57=qvzO<&>OaKlL#$SrltLyl;hb1uTM%^rhW9?SFvFNv!?(D)e^%&4`K6+II7Pd z2aKU*COmtealjZ_X2a$;97R(T3^0cKYVa63VSoYNR|h6!7J$K0(&7znqxf6!z0>Ut zZX>GOusPsOIBMPqZleiOIE6Kwf`$w>UrS38f;le3u;1q+fdD61!-|CYTDiWvH zfKPsc!GFB$8pT7? zxDJ!H&bYAO5QJH!r2zG)Hvv@#Uw$Zj4y{TyXo=o{vi2%yt~aLA+< zVOP8%+y68m+Y2DupG*IMfd6VhY5NE6zr_AOLw~7TXx^;@7+))A4j$juU5V=KL^=*7 z8FtGfm#oef?OsZXNyX-!FS+n18rAD4t6Cmchb`F(SZx^jlUS&;m0(tQBe5LPVRnA zG8$0O9dM2Pv-7hR<(06%wfJ`@K&o6C@>>3HEiQGu?8Rr^xYZQT=pinCbkBvf)_HIn zCU`8-DBplLwt9d;d&Xd#Hj8D4^2Q*l!58%UXacVG{TNWkv)a3$WGP3`C@V@>xZg}5 zyf_33og9=2x4=wrCsi1eEBvbgxRZi;QG*Yrf&n&}J1JPr{%U|}0XhW)33zRQ4OX*1 zjqhMu{DHe^LJ2OgzZ(Br?EeNDFfj9M`W3#yaUshYDCB*t85ZV8QrM5M0ZsD{tAA>G zX=Mft4X7IGR@46|5IL#nskm{=Gkb>^vUKJ_4gQ^tTVwd!pjrR2Xf)HLX2uUm^GkK?=HW%iam}|N0E10r(p9m!QAQf#9loIg#>fkG}GN zcVILHp=eIx-m#;FqG^u>dK~P)u$qJ_l)dy15dH54l;+@Y413xSpbRjWe;Q!UgMir5 ze}Vkn08`!`3xMEYS0-^mb^d#7LPsy34%e90a-!P1gOsLrD0b5{u9mS?ofdhc(4zj5 z(6D+cnI=#(LwT^;{w4fU-ao`8rT2Xr0|a-}=jlP;fbV6>i4?{Jp(EBLE_B2Kd4F5* zUz_s}`2Wrt;D2`rchU({3CI6uQMSbCv6w1o1I4@|u!>Q5gm!PLEMAdwoLWJ}aO;7aY_ zV*!|Y=fDHk5_JN;($gd;pZ`o%f0*?B|BM4o@!ul^552E&?}CE=)c})899kVo53anz z1&`c+8vg?{@DCjeEeRbxe17nKdW0gZB^rEw-wt*9BCS9Z+7Q{56T} zHz8p69}rMt_xit=zll$Ez&k7|c zi~nefoDbPuQ7JTh@*Z6caGKOHlOx@p{qRz`H-e1Ac6*F7Vq0WfmtP59^Z2%5gV#`! zF9N|UN=EL0U6(81)zokA1<&Pya{}-t%8M21Ibb!eCC3CWvjU(?CSQoWf`}V<-Gm2D zsD*(bxe!T!NGPmDi3+^S8o&V&fJlgHLWB&5ic1Z;DkFogZAc+<4I(7QwJ7MSOa#Id zfCvvnIQ(~uF+ubM=q4x>B0dnY!)Q^$4HmjRH{K$ph`ZCHV8CBw81)Vv3CkTddr@bG zffR_<=A!nm249sa6aqc^)pgJftPmwAYi$G*yw_^S2p#ps0im~8!HdxW2}rr>G-wbn z#-f`T47}!>t$V*+V1^OVgjDDCUwlQch-+L60@f1W#RBhV@BD*s8}dRIt%T4O>pw`N zXFGWNtHcXj!v33p_qbS~;6Fi|6R~Cd6 z0vnYKcd$I^4B?S5DlY0q(E=GzH}JOkztiyl1N$3|Pgkdp7CaD+>jYBgn?jCSC7t8z zn;SyC5i$EA=#`N1$?+GcvtOHbsARO~oKJC5vSE1r>5H?|PA<-s-iD2f{A5OZU!mIB z9WQ5r*_CR|Sga28^$nh{_BVc+3;F^)BFV|&$Aqt5mBmdL4XsK)>Mg7e8>Y|Qdf`Tr zbD}NLxIQ8@`{O7-3ELXJEu$ut2@xK2oZmx#p?*eT53t@*On zgl0hCi92yUua$MGV#emWuAhJ9yAlq<_Ti3;hPh$BXZu_~`h3AWs1u|amvkwp^Xz=j zr8xvY!hy~(AMm_C-+#8X)h<){r>wm5=bya(m6IMB}WS_SlA0M=Ec{ zqBKkG>6Ue3EsvsV_^@v-gRz^fk3#459JvQ8nziI0nP$zL)w+i3LZy!27XAp<+I z)S(V(u%na#>fNIQ1oT}>Le^GFMhh&nko`dW@ZQ<41(dI$_lJVAN5l5HTgGmbIo{gS zt?MwYiWZ~!i8LFHx&JFUxjM@5EClmEN#MxLZm{jP&-kqP)q9enjs1MN4yJB+IW^kT zP3w|cB!$&(p&=xoR{tQtWqX^7l2I!pkm5gyn$J$atj{v70l>3`Znasav^1(UWJe4h zGd9&cUo4m#^VLdsNu>Cy-w^UN|N3q4m!&>-xY?w;oJnd{sfL?MifL9kAD${KwaoL~ ziKd13ethacC#e*E#Qzv%UB3&m)S>~1rvnXqSvCK@PSR+`ww+-=a>*r8*}2`NN;Rv} ztV;jhQ~hH7{3ooOI-H|x_y~3c^7U(_m`*pvA9p*KMDNc>=J9gqa0(G88#=e|t@?S) z-3)8W($+5)_p&`jH*y}W{lL37nX=o@p!+mdr!Vm;3O%2)g|}5l>vsu z`qMYL0EF*x%S3##Z7N{;B%gvl25CLByOaFvQP~y$4m5j2M_E}w2l@{9Z&5(UnMzaT zVd0c;2%U6_9T&{}wCckrjv zN~dapXx%C*uF2Ur51)bgOe!W9%vGtf%fCoND+f>*4kEZYK zaI=yasUhZvv%ByDp6`XlEUp-aOQD0#z2c5X)Sjpza-L1!_=cAg#Al{reFK%c2g`5zxnGdkWHPXC>Ic1s}5%fhovTWvj4 zUP=&1P*DZw4A`>-hPP3|MUplm4OAQs4CbePPIJ4xK?A$?QZpC)o^!oY4Ckkd^Sz7> zdJpvTu9_-mm5hv#|uavkMbU57A&1YS^Jwvd5L%NRU;jR>~!`71pjhxvq=CtaH zCzX_z==eRa@;HNp9{H?J(R)2y%*gT8y|X1RcS$b^;JITD`lL*kb2M$qw$1}s5x5a8 z5v$U3;f5NFC<(c0RHx&)bJ#32`@6wj{$5D?OZTHm#V)Q#=;U#uf@Q~h0#Rjr9kz4G z*^8P-VMz%-xLk9~+v6cool>*4^vxfD^^$I`&Tndh0E2{x9y@Yt1W#(Yq?>tT!y~Xh z{NgOxvF=(hSKPfj-4E49F3x&^3&ZfkRkdYW)lMS@VGdy2OgCw?_F|`zai=L$YOYrZ z_$~yPN{N@DcS;BfyGv{9WD|X56HCe8aAG!Wv}^Dm_k)$3VOpHvbp0myY=2l)Ft<`4n0#{8&%qpC zyW?sUs95j0Z^47Oj*<^VdYc`5XuAh|Lk|7gG^_udz;2P2yo_Y@<{OP4@9jJ)RlNY} z;)X1OCVmN=W_Vt~JO;=JQFmEZTe(gUVnYX>(_G&rjRO4`W_T?b&pDz_dZ(D?7%|W1 zISv`?1M!r9FoAz+KXL--^tlqeRel)9j@%&(*N@`PrEdtLF^hnYHzZdXsrs;KpP0+5 zWtK$cl$2=Zd_VFMm!wXhImA4IALJ}8t?j8)eT!*aoi;x40_g3WRL6IWx7Un=qWXjJ zPGX4##Y51Y^yi&cKA0DRUTy3K7xC6E#kIOkX7o~K#gd}SPCe_N50XnF!bK9Q!Pfe5 zGs#8bqbEWP$qto`ezQimHF9#!!y58|<)H?w+MbrI${|%DeVYop7>en&;Om~9Ce}xZ z1AAf_OCE|qr{kaqU084d^7t&zx=YD4%ni6^DfhXahUh_OEymgQW z!BSU?loM^16Ph-UotcYL4ksPkc71A?MAHkmh7C_;?@{bU)v zylb8M1H}+w;+3O7fVNwFa||E;We@1H14cQ$f`;*oj3F_L<1L-Li>Cco#nWzh%Cqf+ zYR#Qxt@eNg#B#j{i8{Nt(bLJ_HMvW*ocF%8beWbbuRvqJs1Gl9IC->*-MIL2?8&V0?T%25^y%$C>41_Z^)(wKm zv#{%@%orHIxM7G{eHazM$LVQrmyoFEIwc(WW>)CMMbN`-(;JS>tnj6GG2eb|zMXy> zmRKjAvs9dCrL+|N&GEvI?50vzC+zcFr)OL=#^IHls$_SFrB2U!v$iQ47!3^>BYH;> z!!^T8&GSd|hex|dNc7Uh>B01@AcC?W>tv<(0Q@-wII^>WxBvlwKSEe=u{R&F*jZ38 zOAH^x8QwYd@;%yodAxhRzK))soL@UfPw%$Q$NC+)_`Ir?>Idq5>b%Z&T`Di=2qb(P zzCF)D4-cL#?k}k~olvULw{jUVFcQ}+HaV)nR|eJFJLgZ%-t}CdCl@0|UG3FKlGc;9 zjQq|vTW1-<)ugh4_eKm2Qc36UqYVwkC2B8@ko&t!=ZNi}XO_b=QVGcL3zKhvmyf4N zJwrpnjE39urgyr_o5R1~+Z-Rx@82eUEp^h|Ip2w1QX4)|Q>mz{Jw9YQe{+7YyVJ^c zazUB32>y3eACYN>dLV1n-S-t~^&Dbxcl6rv{tB}5#_+KhaOmfW4}^wzAFmuVQ5nJ= zPA^iKjxUDVhV|G^FOv0YL#BTxb5SOf7;OP3e#Zrij2G^nr^lPJrs-)?GKaRc7pJ3J zJIB(~(kcx(HR{NwU9o2mF1&Y9R4v!fsJAadFV1%lk5HS(F8ld2FP~Lp?t~Z-7i876 zsxK`yH#rsnS&M@gL=T3wht(fTXg$0LkA6B_^UWZ7s6W)Lufdf5tfpSqK7IyZ*wn^5 z6C3Hbr|w3s6>zJwigptc3Q%6$LTw+(9xo_nZ=2pVAxyZ)HE6K;7T91THS*vh+->OP z=1R>ko7EX%7x#m#lL$t`a6rG$O^N>Scu}$obJ+VEaE*k7hLY)b)-@mB#{l#C(Q}&O z20-7p@;Fg`zKP1&^!B%J-^}|qugLz70I4=kY(y8C~R7(#oAVe_E&VH)3_uW~D-rTr!n z6|)Uc<;!D~z$O6s#6?ACrcQk`6uv)S*kV$Mp6=GRa#_n}<_r zDXKD0)QRIjkeL{1xG~2gTQ|_c6d@5BVs4QEyx+%-iTR7y#crxL0AISAr>%u}L{V{v zu55S5!!%xy57#BVGXAu7qwhs`KG3cisWkmmW*}922&bMlZCN|G+U%2g5l5zu;y^WVpDU0k5Y{0KsRl`e{n zo*KEw^A&ZQTY!JXe7nSf^^-e_b#p9CMiw<$@>aDuB5t)sw*`?(QRzUyu?-16Pr^DN!3b(ML))_!k)y$3g3Ara^x zRF;}&X~G7%H@BdT~5QEEm=H*E6Zr#84%G9XyHLU>iAKvX=P~USCVB% zn>Z~LL}N>QChJTXPy3uN;?6H00qYvL4EvD~o5ZGI5LvHFrI~MTmqa4vI8nGxKX@bR|zE`sL@9$t5!Qeyt z9r}#gy+m-O-o>wLc^nS9Utx-iV3XKxnV_TNlmKJpLcaFu9=dj5^wA;xDtwIukreUA#Oq#$C2%um6B|lD zA-ZlwsUI{=%Plvw1J!1LmvUYVUydpV_8oFnBG?+|fodrb>Gz|LNgkTLY_7g3C$5e2 z1N(iSfqK?~ebx0>_RDPPD=K+0&wi)Uh@E!1vX0XLF!lObojXg3blqk30wfKSt|j=~ zUANwj4B*SL&OE+RfHp8boDRZhVh^<92vff^S8Dp&Xl&Wp@{s=KDy0`EE$ChI)Km@Di788mG zr7`j>WXQ7GBf$vXrfmjnDhSm2^{qrhr9?qB?til087jSVDCK-T%keOc5oeA&)ib>$ka8m_+Phlka^5w!oc#14!{dQaWcl^*49>WO+mb3lzp zOkM`*`=KhtdTzzj?H}7ohC9%>cZK&M!2CC=$cMSz`UHup<<6h063js-KTcfP#BdPQ zOhgA~8XQjl4wUmZflP>hoG5{>nJAWM*E&I0H}_;keR61J&G7TkxJgGLwb?V9msvye z%N*;Q8H2m{-fKg2s)3;L*V)tME+}T{2P{`OSm47|^J!PP`tc9CLZ`6H| z!;!rzz=?0|<(0QXNY$*_A}z5}LVWEV+?%yU{B7wYcW-Kzjp}jOdSv+ciPFAGAtA z%Etznx7_r%X?iR}x&RY?<`r)`91{4zTE*ae-@8mx zXjL`noqDLzRtwkd5nHilVT({_KJH!qm6{CQuhB2L!pJ@AC=;e!Q-0{FMe#Vq1Xmz_ zTj_k2bK?qo`f3v)&9A+H>RYC% zv}s85^#HKQnpH1=w`3d^iT1jsX-(JhYofZ(i*0ZyN6>yuG}fHs5he^YWfC+gLq0t=Lxwv6rv#-m`v#(2jCbAp0>E_U(z%tg?nw2RmwoAWhtZszssUy!L+PlV}b)6B`z;UaPA(((5 z1+D?mVd6Sd&zV1NwGz$>80Mt_I|aFo!7Dp~SK@Y9u%Kh!#?HOS{xDT6w*H%Q6{y#+ zrcXE+X~Niq3t*2XqW_yJW`)-xF08?vn~=&v0E4QT$@m%qW*9Ran&e5NU32aE6FMvg zE&iuE`*y+6iLs^9zM#A->TmYq-OcTQUs=Mqgq@hiDu&60V2j1ayX#5O-6YmeA@ec?L^rIBqdb+tY38~d z81l|3@ct?@e*{NYD6Tin*c}E?5BXRMOnGPgN|wR*xPAn|{2f5xMD$~Ec|iKOiQ8CP zOUf#XX|tnz#pfxze5%5)C!U#cGvOuy31KIgZ(Q#82A1kN0=hAqeFl4``6krd2X(>hE)c zad*X(ZeE2232>~YjzN%b);lq{I!jYbUH~~~()d)l*7L>3zQq!3@x2)uP3frIxINMMgg!5xq^usOTl>w^^FS) z6i8=;!WaBF7?d{R>F~7gQSopK1;0bTjKoPI{x|8xCGqNn><7S3+qh?f^W8mm*M(gD$%|4yt z;U3Bpo6sl#JXD2Qaj9Sx(~^XFe$NtErnrGZ$nwh^^C^LdgZ@L!GPezPnBtw!`k$=w zzO(8hkW6uu^|q$@fbg{XNg$c$yqTRcYL=77W0jst>4R|z7D@aEY>V>7%LG~eRUAf0 zy+Qxb9}t*z*<(E4Uj&?6{`C(4u0sr(e#1E2bOHt%=kfBEk+i_AsJ!1jDIW!YVV9Kn z<0}k;H6R_w+;)TKTfd;D`6K@p1VP*H0sc-Gn6>P<4FMsIwbL|q-=Pa^+%QtUMqShu zX8mZKW;WvLu||2=483o7Jgs$c9e;PRzI2>sd5ct9VE(7K7TUX?Gj^8%%>LgR9Gk)x zFl&`@n|PArHbx&O?BhQod`s9VKj22&+e*H{qi3De+QumOAa}P-)ZE)T&b-RM^s8Oi zcX=FNR?;vo$`7EAW0o)na*Ky0Z}Jb!?bG!M)$2=_BQkYj2o$cjYXNd`R>qutacaxq z&Y)dfly3#22rK|tECCf>_|=K$<&a$p6NH2EcnEermDzytM zQ^1*K)!Upcl4|V^=bx?icQ1Rnj5**`EI>hjgFhde-*k#D%#LeZsNc5uwECkeBCmWt zrMG?IK)Ez_1lki21hSLuIQ%XKjh+!t`+%O}VO+)&*D3ZeM}wO*&p1;)A~7fGf{t

U;_e#rX%OCgNX5<4{U1+?mt>hE;K`QGCu{^i8Yi6$Ch zjWgh+3gxElQ^mk0WRRBzx<@v?S(+bV$?fRayyUc=GtVLD(0M`DtDhH&EC%O}3hmB%eG&&lfSJ3CV0`I~@{O0CQ7@_55ee+ z0I)vyVU-UvU&kio&6Cw3085`Sq&rypR=+VwIffFeIol~TyY1>TeQbk;rLGn+*qd5G$7&a0kgO6QEVSM`C~*+8H+~v)T~i zAHvIFQKZLf{eWcJ-PX(++$OG@6LE)P0gc?8BI#+?4zEaL3Z{ER4WR8)va3XuvXBT{ zzclkkx7+1*HtP6dMk~sL3$ksJckE!)$KJo}yTk3+hgWk>SgVno81myP1xAi{j0-by zd;#x$0YR-8vF9-3&(CLt1qQY>Qli#Qg}@8<;8;Qt6W3N3%1v|iY|y@FY{TEEYhDBg#~CvJ>e0og zl9W)!gf=!j=Ym;|yPz)7EVeT|-z8g(6`GXUuGDU+)ZpL-I#Se0z%H2n z?bgMk$)?oLGj+qr3R*{ zVFt%)6~ig>tcUw3szx1y$qEey6{Ck4!OtP_smvYL7z|4@pFMhHA(oDwCJQl@p|P+A zk6m<_ob9DHzv?#t>H!vlb@XKMP?O-`i`JhXM!e}DP+Q%0raBhzhZrwh3XC4yHIBEw z+YzTWGcSy-A89?@Z(DV^Y{Fs@T!0?8tpY^p}RrV00hIhZLnYnGhH_)-{oXMw1hJ4 z`*DU5!B_0zXmGYV$q6rq4`(}5*l9Yw1mWfv@3Zr5dx>V1#&^ZX%K_2doEURpJ@|4^ zYGXw^ZCeAzDOT%CE{;4kIn_X6JyCc7VsFI-?i89m@qK+Kk>)x&BZ=aj6#a zX0S09=?-7=rYeVdQMLRjG%nS^-yP1zb-w;yW3krXq4FxgVTCt+Fdmpb6OPg0`s z>>q5RnUFuQ=*5C!+ch9fBF4wz3GF7fx^2s`?ii~G-Agg=7zBk#3W;8Vhf6jQB`z;7 zZ5gpu!-iqi68_5)3KfzO#MZny0It1%YuAk`++JhK=OU_IT{8)@OPT~NHwKS-!8&n% z86PaHEi-Wz2O2whA?=VA6V?ioS?~?2Z4-q*>X1M1(x^MoeTf6Ct}YU zFQNtysyMxOr<)*o|DI<7ojJu3P-YS6s)D|dfkyMd>>Nl;Xsr~Qvf$v#VIK^1@2i`s zkd~o=&bD3+KfyN&vkX6u2PA62K2Xf~zB*Q?wL4&!3I8|VrEmY>5$9Hrs6+0hLR{`? zkJcdf$)-5jPlc52tjp3zsqL5W+@>VjEL)0}Clsqeu8}sHZ!vd&`t?nc| z3L)6Nj<}k;RCpHFAYKx0-nxVVf6q!&A5dLA>R2{A0=_p1-u7HOBlFf0luDnkN)N~q z$h&2Hi0T7#?;fQcSji_Cz_$>6)?!5B=DKo?ECdsuL78Tsy1@g#>pq4`dH)Bt^WbQp17SmNeIb_eHIVphd&^GCsCUS`#nVZq9!o z9-CGK3cdt~PbQuhFEg|TSQ`j_o>v#?=t48qmDfa1=vC%`zumXsR9}CGw#zAd$TU3Y z2YA^yo1LB739^@O3|NRYrSiTPAr{$P@72--ZUV2iQKJmj`XZDT>EGRhO?4xk4H(IL zj%9#^kHR0SZxdTm+{`QEqf@+CIS%?E0w?oXkp2=ToUp*D0&?#b`#n(-+EfJ;KMMDK zdz956t+3cpC3*`I?)I_j{DW7%6qN#s(mUTwl&4dbK;TYO6QjMl=-@-H`%6_cqUIjUovy;fXt))3Q)*H( zBv)uQAt&__=!x|z{`MZH>__Z?E1hPqZB&JfhuzQlAy?~&#Cdf!RY;jpW=FWiaN<#q zKG9-dB^e|X>mw+1Wwa{RBQ;9^1bLP1Xv5v4k-75yU7YLZT6*1Qw~4coI&t~v%)JS&vjFL9*KYw=#=+4scyUrPBY2y<4h_2 z;56mlARb;M$$oStjp)69pq;*h(5#H7VjVyHK{LJ_9LBR!xX)QDg-6$O;yV6^hvZ)2 zekE3VSN;ri>$q{83@v4^{t8oqE7h4l=a0mr1#P0m#>z+l^lJx7-1EYPm~Z=`tMSkI zS}7>NAW!?)1@cI*5fqreP}8^;xo7=yQkNVp>(7G!iVHZF3Vk{M9ys=|`CGj~YFv;C z{CjdxcKpE{TX!K&W9;*&;G31tF`=V*4t)7e_$W3Bk5a$KWW}IzhFCb^UJ*kGDn20Z-y*R;@@oDW9_va-#d8rgE`z&Dd`tP#AuYxTqe-u3Iyfg$$_g{vf z#K&4L9bu&N4@Y#et#BX1?2W}XO{5n){-s{j^B$9BgH_Csf0(hY1({*B^&ZN%Kk^H8 z&FLmc1C|Xu0U$pN+e%*qtq)cbmcjkG(hiZ0S^_kklkj%0dC=o<`S`+Rw0N*9abg7t zdhIMaalX-6tM^$Db@(j_$H3>TD}BeLSR39kUP2cPtxUu-H#cFbhf0F|gF|(kG)*G# zBoFwp9k9xgAWZDMgMF(N{IEyGNqUJ+)G-2=g)j%ahE>)>vxm1N6J~OJi zAN_AWH4BuSL*U0MgJ2e2Vj44bh`gL(z|udP2Ows!jGk}L>MQ&eC@2w@Swe_yS}MF{ zwtjFpxEA!7SGe~%O9y4?>QDCN`9T$`r5t}*Zi?2acvE6ERt}sjJAn#kCD}G~S2^EB z>pMQX2UfSlnRyi`G)!Ce7{87oARK1e=Uy^`&M7AjKj&+tBG6UB0GPbOdYAD zH_n%W5?bprQTvMrCv(B-jMj(5g5lw6hr%;D2?GnN9B4VO1d02Hgr;AceOzSdfAbtb z-a1~b)TnpjU$f`?f+P9%9q^NdN4#wJ@&mTQ6PNs*r2#3~KPX9|mnfyA&cc5SGcIcr zQJx{LqZ+j^vROpAhdMKyy^VQ$?iPHlN2IHkfP(@m>vBO==b&cBp_hXbum9m)YF7U? zp=lM5UsXTe_iNaoF;7cX%QJ9Y(aKyVsq0%XApuUBE;O{*@ML>ZM<;2mG9WI&BDEv?}MGs zPg%j;1FWA|qEOj*PLz29rJFq+RR2)XGN5-ro(Py$l`TBPm%6%u2sc^-Y5@a*&&yEw z_FABj8q8h$qXWd7n{I(r=$`(gf;E(Ef(~FvTUYm)llAgIKjOBeI^PAiuup4MrM7xV zwW)2I)stYT`22CYQcby=>E7>a#z`c%{^dx{&54n)VUqMgPzRtaK+*-QKij>rQu=2} zEeoMZ;GD8?#Dp{;3~q%Oa0e$E441k)$5lsY{fV+mp~p>7RFJq)U{oNmJTNLGU{pkC zso=*l%-7nHw~tG!&e&~x+6>PfzPj~GZF%$5Qp zM62wg?6p;>WG{ar6l=b=9X+dT;^_W$MW%~$m|pl6BD59d%X9aH%sVo zDbkV6u?qbtZ>`|!U0uhFv_atd4W0^*VRY19wW`|H)N@0jM24q^XTz4F5*ir-C8Fjj>=v+yI28D)6PF(Rrp`Q7VyxgjN7k2O za=VQ9Dd&qb`Qk*+ig^CVi!pE5J}DGipt|BM_!mjy18vkQbMY;U97xy=n%I}9O**wN zkdizP4RWwwP=867*PdNayx=}Mt8l(sPChGP%+7E8{hKy$?S%kuH>+$2q2=Cm9Zx%+kP|MNoH@~DwdeC@X3s<*<}Px_g3{m`abnYqjMSyzTFY! z>wZ9e&yc_7O6Lx)Wzkm6dRsX8fVb)c9}J8sTmcN*YqA>T6Mj^|AH_-yo*yCOZ|z__ z;3vF23%eOZ%X%jHNIj>Hl0M;W$|E+y2RH#MZ<6RmI8SqGmb&xiNZ=2yy-wYJ4bOGb z#_M2W!ltb4x=C7gkW;IO%xM3-pzjYL%#LmX0FKdP$CZbTc@or?*c>7WP_JS&9p1r@@hT*$N4rFw)C??pHN_RUaSM{5}<(6_d~Q+54l}1T&x^ z3wU$g@;_1i8B-n1{=_8emug>;YXT+9v%PO39;n-OSbG+EoH~v8ksU7y@>5Go+trG> z$2LFTkx2H_j~GRi;~Ch_DwbBa#*Zv4pWHv!WO-inPzv5zou+mGFn!<>Ib)aemnk1z z&e{G{@(S&irN631i8~N&D*9$42>HC_L>AaP!Z4(7SYcdC{3OVkL%D9|CErm~-ZF7I z{oLnpw7Y60gt69kV0#|r7u8ED6l1>MYrAA1H$L<_DF+pJbmGRD}y`zbPL6#Q6k8D}DJQz)VrOvNgni1~zO;M=j$%5Yyo6q&S|S^~@EVqE%XI`LDR? zi+u9+v6~WNoP9s_>T!-JTZHXse3$+`3FakEG0D8?hVv;u?Ml_@pREQ7h}M^z^;u;n zyT4b!AK2?$_x4p7YzZK2_1a{JTP}@LMg9UlP&iB6S6d^!byCc_fLpJnHhBCrV^>v> zb?@uv?l0D)mX9jB3%}X9d^+)sNss4!#W`R)$ozFc+`%94ZBs>y=zSbZXIof5*l<7m zN7&oJh=F!JUt%8*FYns~D36%>kq*nO`)WpmzOKp3BK~r#q8HKTyN}3L)*Q7>E0NtP z2b>-a&1!3-hjl&<+@li)53h-B7O^)hCUVu3iD5Cg#bsTI>3ui97g^rmL@C?1d!cA^ zNbRY@^>e7#GE#56f0oq}v9-8TTg9~x6dSl|*8m~yw+Mr*c<_1*b`JK?2!3x-ercMm z4zGOo?f6pFl;;7X*bLYFc<;NmkpPLen&z+6ku|g5M!pF<_PJ((22vunOBNg-BQq@XMOj9Z1OnYgNNJ7zH5uQdJA!B^>RaMU8D4~4 z2NJ&&=a?=Le-}mik(b|o@Qi54s~tNvm?-x#l4->1@klOdZqe_t+CtbTP1}NPvmX#630rJr?s(f2hN5}5MK+#*ow158Nl}YivRfW$ZppF@_NR`x91S8`?Whr% z-0!b8b#7~0b`RsTL<>AmqY*4*&Vy?M-o{S9OYiEgbfe#LM+;Nlc}M$s@ORKqtdUXj zIWErzk_aQCb&6YWeBg_?V zL#ng|$MwJQQNbMw2FXu2ZmaG#zu-`))}k$MiXljDTJXsd2^l34vS&XoU1pXLyqJaU=gHkd{odk>%dLx?%y&VfptWd%J-a#od*PJwrr;^3>5kSeLoL<&T1o+NyKXa4C4e%h1QaV*&oX|u2ZK1{G=T?5es1k@p-E%JtH ziJUA?r8SiqYn{A9mhB)b%XX05KR*XGsbp`w+V2Erv zj^gcILRZ?QEA{=?!AADIE&+~fYE;WD%CKItFN}$Ir;g-ZKikHw8b2*}RiXKL`x7;s z)%4S&!)b>=bV?@SI;pD)b*4)Dob8r|7AbI(W?8)D0}{*Rz59wj;|jkP7d%KKoT;Ct z3FrBhALPLV`H`+PtSF{Me0gfPERy`lnf%Ao_jV}`z1FMiuEv(Q_xf&YVUrONe$}T` z#-e@wm2g~oI%!bfh_RxzcT;EnN>4cumXo!iEhduie(@d8hwO>l=10^$ol6D^$J&DQ zPEK>%%B8dAQ*}hhY^zhcPwTU;-7CFf4x@guf09ry>Ct zD+&w7Tfu!5%K!_(brl4QB*H=wR9G=$!Lblt)L4X9aL@25=rA!b;1vnAl)c zr7itMBetdq{=lC0s~#e4w~aPI>b23{$BOv2ie+`v-o5DE-J*i_O(s$nEc?nxtb$Rr z1a{=tx1F1fH6*~x`d4k*thZS|y$(PG?K%WSFt%ytke4nQe@OdaF}InkazaI09`rgc zKPW@yMaFd-gKrhu%{-ReT6W3)KUp zOeP{->@g$9{cyWj!w3QQas%&GN&)pYYESCn1VyCT4f|)BEw==;@MtrVy8z-wnm_}Y zXY5TDj(p3b54JNmocf!4-rGI6{Onx?X$ysvE|BElS_)L)hvH zRP+?>qwhy|#lCdk&~di5qdV`R@d|q|dE0o}gzO@7J^dvy2>4@DfgZ*QU`&$d+iPRf+ScBX@a#5|{9z5d8&EEb!sOf6Wn3ILFxz)ksy1i9^5Y&9EXwJZ{6(trJL0z@D*FKd6 zKAD`+$|T7Zi4M1UJ2f>bV@TOH)LlS<({A-#S?%S$GWIwox0C9!gOy z%BhxYYf3LAO&qggQ68DZNSVE3oJD89@0{E@xd==wb8sAq$qKCJ6XptEquPjm(^v zA406RFgegH==lZ#;qs0Vn|ChgT2jd-lkZD4Yh&BzNHbqa*nKIV8hUot*QWM^h6N|X zXJqmF7Hr=i?m-Ut@p#0yjr~R2h`+QF(g!~_#{Bz^pwWEI;NmC!hEN^oP%Mkt?RNdxQIB4@ni(rS`O8O8nEMaR}sQa*_ zp?%0<{pl=MeeF8isJQgODvS3kigo-G&MR3CJO@UDXl0Y|;a}UldkFmF_)(jvQ{(g4 znU7>kuT>KO*i+CdL<=Mb@Zdrxq^U$ei7hjVFfSJ5n^W?_KXF0M;A`+Q4Co;cC( zX$Hf&B5tlQQ0qwDQE%@vX$tD1Wym3Ph`5nxRg2Fo?JRO`$~k>R=A-EAxY_#1!_9U0 zXtIlSve)6SOndEiRi)kMEf(B$E4~mRgGE0*6%7rtnrBN-7(S~?5iH}tkDW~%)Lky2 zuF{qJ27XyGP|xTxzFJ>?eg{KZ$^7-3YGbCag)fg!dyoA zq0NBfG*Yr@&xiQ5zsUhBgtb~W4BtiP`bJgcvOydSI3OlSly1H_TFd@9?bL@ZGZFf z-kGb71Nw~@2h2H1f|hnD9lTz_#L0_>j?p34EVr{b-V*|# ziQVW=YH_FrN$Jp6IH^-Fr5);EKqhU<*O^~BIcnuCUhooqL3FGQi!># z0g^(S+?@hIZ<-->GwNkRHXE|^d?Y}v~3;@W}aspk^6Ao^7 z4k{w7{N2hC3Mrn7(=--lp(GK6d$lsNvg0AaeRE&++BiB zEpAp%44J^N{$j)oTbnYk@9%rA*)otUh;<55MP^*QOyub1)KLCx;Q_Q{3RD!WA`%vN=>ezYL2Q$&k5sH&(j;_%keX+Y47uDVR3jv-Y+j^sV1&3`?2Z>ms1855$BHQs-R8^=~xF)P>zQ2yM_-Yc_AV`4`HeLz;ZuZy*=l?#X=NwBTX1WqBA^ze1Z`ceCG*!VQ+BFd1>$ zOxBxa-{X*p&}$*U$-rPXF?1&kfR`1bmIaFD6JXS`mk~+qA?Ph&x+5_mBrcv)vktAs zW)>0Y`ccSw*nCdnt)mB`Fqmgpc%q}bWP*)MMD^Wx1o*mfM|LZbRDxt`DkQ2 zfgb(>tuTcPJx(5xk(pq_#@dFBUQX;pXQ0}e!EUMf*w;Oshas*KSgo+?Bf;l{o+Wi| z0YDwuMLzd1$|J3mvhDkVeyh^>;SaMhe8-J<_jB)qcdNAAB6MDyyJ>${4XsNCBZaS@ zIQ3MQQFI1^sdisSxbOQS^+J$ux>yb6w`HlJXe@{TP77u+Uxe~3!pZA!l*g&<6=|3Y zH4klANF2x$0?t<-WehkKJB>;J<~Vhc&RQeZ>79?8+qneSZ&X8~!WW3JrpiPdt4&lE z;(_WSko9n~wWMo-zmQp@-`$}96l1_xn6Z#W|BUi1F)n8a@k-96#PG|YrA(HJTD7m? zFy_yh5AB90cx^lP{kY@+hDX#mRxl8dDJT#SMBuV^w`Op&bF?zFv$LXix3SJw8?{|w zL~8qTC{QF^5hmL&h1csEtAPV%gG4Ith>SEf!)@3bBCYKE;*<1qZwdvr?yw)Dc#X)- z)Qs&<4F>O5e|Fhn2gztp0}y64thmaZONaYAdnCvK4`o-!1ak^7vVX-?hp1YsAqLSaPjqCJrGcA|Fw9pz=n^fE}?JZAT2560U zF42-KAue!U8K+Dfl$fLKq&f*6ddzF$w&kI)Xw8Su;Ka-~nHbLpuZko3awnQ0=!%16 z$mkrKOx^)cB~=VgLC4?^m!-zoRaCe(ama5o&XNcF(aXF5N;ZO!q~6_W{iorV!k>2j zBl**Fq#AQGyPt-2l;DTYUhf|ITxLPTqyk5z5lkB$hJNd)v`a zI`JSVY@MHS>y{Bd) zIdKIJmf6x;mb0PUV6xf+n=6F z-qEvF3l2DH59hqEDOuP!u=MM2ta+pw)Ezmv@3&f{m;daVj2Ccv zK8>v6syOGF%ELEtr76EnH9>l@nrT9w$6?C5vOhW7`w9j_Z6H7f)GF;7ygz00jOY8L zFh!`8dW9oKb>%}G6ZrLS!mFfTolk0}ZDtE{G)v8UM^bctin{_sOCmV_L=vYD578)b z{7DfaNkR||sg|8+5f)HiZmA3%4+3(=1POxn&lk?g+`!SqSjE}V!q&{`<6C#?bK&KpYiPg=^UZGe@JjQ`gN;UWY%CDj@y3UWKT2B zcSm$_7K-ky>AM?u{N@SP4u>`4eF1{kyUNPUNnC~{3EBvuXlDO)Sa7M_Z3aN)3f`Q_`Sv(Up9spY;X4I={dBEOQ5q^dhCA7 z3s!Kh~SC`7EHD6Z&nLpg)uAi1cW@iiMcNq`PxQ;fw3P1ZL=PiZN9(Ft zW=!${)a?yS0E>Y=IqSqvi^=Ps1Dd+boU&etz^3Z;b4P5KAoW#kGHUqH8~>ERmk2Wz zITGI(JnwU=;3Y8$qarwmbC_3LIhG&5uZ07PMkd`JFCH948f6F})7yZX5(W-!wmXhN z7K+TzFPDdNTU-&Dl2R<28ya*?NK8Nb5Fr=*uaS)4Nb=V^1T;cXZlS3`!TOzl;0Os$ zxS0UbU8#DGsvShL_&f8yNBhrGvcv3NAtLxn9m!_l82;ercr4FE%}wDi zbb#(wy+G|vc$K^j zh95`B$`KPFyYtIERPV<07w5fL4L{)vDKK1d;vWJ>WGEr^x~ zQHB$^hU%p=`KJ^g|48}sVr@dR#;;Dyk~OIh!j5ezpm#G}9lEK5&}C=hB>@Yt+pN*)sO!KTAC-z~RX>mW^SWv-g2(aFM!M zxFClUpgTNIqA5&|!u1gN<#k z>hEh&`}@R_<;-KB*1i8jA=|g8Ve4h;M<~yq@_39VM8&D|S>41q!@Hf)I&M`9#qZ?P5$@3Gm8Z z&&$^vKHGHKe{#)526x@;=aedIE3a@qzHbZ;Mn!_8s8M@`Y~*U+m&}06WD0fagfLj9 zQSHADmCl6o>1p*asU?eoGoGIVGoGKqK|a~bmzTofGJU|{{6Hc3*@M??S!81}3+X52 zbI^gT7bfn0=6hh<0Th3)8E@f}6JT=rb2|33-Pa?$)McB1PP?D^= zz8#_~cSe6oe<@91Vm_t!aAhe>;yTf}_=?jDU#?+al&B3QSM@4^o1?aXcMu_j(+QOg zw>?1#z)G?eL&pcJfCpe%LfMvJ-7U?LA6FO4P95}mnFq}v zd{RQDFaYIIH)0>xeL|7P)k~ku`0jOc;zcl9iW332itB_iT38~*DO)4OfmWU>*Jr`5WyWzJ}@z$5`csW9ZkT-4D5|4MLo4 zz%fr4t6AgG7p@x-Q-dRUfZ+29=(o#t$)z9c9krnOU^FuW65_-@S~>t&P7n|n6dAV* z9Ur&@DeydBBC=3l_=bDiT}iaChvC+a-#l5Z=cN4Zwe29P*BA1v|F6OZL<&I}y7Q<$ZoSO<6*3 zK9WmDPoU;3(Z0;K?fwFA`P@;aeW|wQUwMMztfbK-$XzJ)05p>ZH!_VTK z4g)Q~@RPxv(6;x`Z7+@_eMl`H1Y*0;@OU6@D6O=9PUZ0sd}EF9Rm8W+epbp5S+|&Y z!p)mzf{eV?K6dO&Sn?{T(B_}&va`oaZ)CP_=g}%MaG|As}nhbW{CC6 z$e!c(hSNE(k@C9^w!tuA(OJ0%r&!&mv^739!zKrDBb_`Z)zR z>@7uuBe>sd0aFiBTRd%j5(OPz(LC3x)5`HD1>6TBahc&)HtAml%dXiwqHepvHrt+{ z0jaHf2Ln{Tf9A2YL#zYB&M$&Ayqq>*>f+_DqPD$MnK7EbhKL-EcnD7zIn~$3>HW&V z7_M|zy+p62yY`pY3b^5~Vbdb1D);y?evcVo)F@j&1Yl1oA;U?Jn(XZNYtGkwp@ z)6fpo6nBW@laXCz-GG&tdF`G7jj%RiB=WMSe&o~wm=Peb0Uwj3?yd_nryObk+J=u& z+#GRv?gNkm#(jI7e`3eVDPLq3H$U-X`cEnggLHjDIz`tPLsIS$m%M$H zOyHUarNTmQ7w3%B*%5v9^GMaaLeMyVvTEI22?%f``AjUDx*@J=R6!ucy_TD|&KR3mK`PsjTn}-+6D=qNk`eGfJG!_#JqjmAt z`*+EuG$J@vG(Xd4j^G%$0IY2MTXMqo)a>5o$8?<`yo&S@_qH6lmhSc_{3^!G*;-zt zI%8dAQWs|I2-TC0IoBB>p#Y1^q&NrxCn3>h4<;Pf3);Dl>7u6i%LHCZE!jTXwHT)aHf7MonEUcS{s^LjmI*x|Vd(~woJ zx`-WdTpV#M_O0Ld%-n;jK=312tck#0ttZqyQ@z`Wk9?KS0yDRG>QujdD_Jhb#@lX<|*fj)5@z2vj`w*xe9!Fk+4GMZ#;>xpC*HPk6yb zTj2(7Ow9IEb&e|4>kq(G2qDVmOIx77CI$#DHp0jpo%N^hyq~rgKe<7W?TrL8XwI2? z#11C46`ttK`rL+=mFrqFFdB{M{h5(7+%V&w?3i@+FzIqb6<_zkByHM^`ht8q=UU(= zMSFqX+jW%{TKr|_+F^S_|LW%fZJ6Wd)>tjVDkHx$SZv1~?xtBlS)iX_#zD=K3Ax&z zv?M0J$?1D$J@}YQDfV`7@I3bs#LpZV3HT^9-%U8F*}lh@{ky&_|puO`qA-0#BfO`&1c)v7p+~c;HLD_EB3ozO7$p;xonz7@EW8=~a#0N~nbf6W zH*p!%C?zQ^Egiw*dh)hh1(eD4MfxN=lJ#ad3Moz0$)c0>#2K%uIFgmandPLPoCXww z2*_7PHBk0c3z(g|iKiv4vpw?r|2DJ?RFU{jJHVO%ZhmVIkkTn7i2^Sga`k7T82LEn z7EvNcv9pX8(+P@eGk-EvNKLcM4lo5Zu2wH16|_=^WCK4GWJSr&9ktLwP~qv2{T@zV z7!i)5RKnaEvJ5JUJJdshfj#6H)4IJDFhbLj?W;JYCabQYBD-cel2VLvTDpKU!R>N$ zK0m-ZDh6na!b;q3kk<-d!L~!j)ZU@%w~4Z&tiTWf`^RoXYjjvQT++8{D`+ae0)`G~ z!%rz^~LeBXzIw;cDw0 zI!IMEiou$w#yMRlM_L+o46jO{Q*%NauFq0F+JwulxE)AJyut8l_y_-0_|I|dLMs`U z25VeGX<|z5{3@3zpx;V9TJs7R`FlY7ln~f4!LegXFXQ4$+-obi zPvse`NpD>8SXlk&_cPY*PgK($(A6*g(~qwIrypF&=Ju~4{Povr?`4pfq#4!Y2OSY3 zvm}Iz38sx%Mo18cQkxX2KpU89j92Y|8ewBI1IB4^v2s|P1=Wa!OByCKN*Q%phvByq zHUZ}ZpAijYcExm#SINs-R`K8`(sMRPf_Jcg%Fj!4` zSrFVW)*{ChSf2QkoTjJ$Y;6)0$q0D!`YzJck@f-LOFS2lE? zKXwzCimWbdZxhYf%2w*6gf$pCM=N$H*3puM0`i!-(Cn`Jkcvp7STwAbS3QES1F)Jx z52I)d$Fb3w?o@e#<-yhZn+v)z?Zpv@h6-HiEmhGAf%-TptaM}BXR#+pIU5}*g7zI(>iznK2OvV{l2geJ8m_ZebgUn*h z2C9cRMv7WVNdtcN-^kHH6V7~yB+-$X8fsly)u2@yw1WuMT1-w=Ph3lpimV%9g-V=9 zmp~WK)QJ>-+oJoc9wk<{mamixX9H^1sKJY8=!{l$8nuH2O@M6W0_}n5Cfi0>zY!oi zU%D}}+;z?NBL{|;Nm*+=wyJ<$V_~AhMYz8;k!n7|a4=FBjozBsHp?~xK3-=yI4!F;S4G(BxR={Yq!Cj6fFfwfHM^BlNyA!c;@HpTW>lV1W2sFE7jfs>0=F z;=v{I*6uzrmy(|#Tg<=1XD;&;`p=?5KsFH?grRMz4Xu5=b8Hd`{=gi_gA>WwD#w}T zi8H|~sV{Ii84FICr5D%g@}9r3*t>!c&IllzX`E=Ir&b4tM(-(!Q`0x%2X;;4_=p;{ z4_0XPvnG79swU6uE(XZ=mvtj}Zc$vZTt!4arxv-b@&sbS?^=9M%nb=HACA*8D?v1b zr^A>g7R1%oRGs}L?_Un?eb*fC~Ub4{KDtRt`WVP1SdL z0B%E?lI=!<$_lowb;)bL)7KjUEtU<59yMH=(2O(w&BHctmBhh1pqB=%Exad1nP-Fq z6hHd6Lz=3Wd86$zzjJV@5m})K9QAs8pvu`L>;gtV)!fW>?ss zM?>CewU{N>@nO8?wywcH@sTRD?#FPmOqzy>-^90`qyIs`@@-fvTOwsq2`<(Fn^Tv00yL!)moKubRWynFJg5#)Sw=0czdx)YQM5 zoVDRltM;C@k+qHNSUG$u8SAW}7lXgEuzAy5^H~Dn0I;}n?J}Ln0dfy75Ha_`3+HHc%TEI{}O@Y|NTZ@~!n_}4H zikj^;?rF4UE{6nfk~2E>VQ{r`#cJuJq_<(xpJm^Z_M=8G4^JJ?FK1p@u`->RcWc?o z*9g9dMlG&mgvsC7M!cs1e&b7N@)BzAT>1`sIQMaX12oiB@AcI8)@bMr>+T#sGq$kthe^1g>T81INVa!Z7nMz&G(2%Pcl7Urgf|dVci``GlXn~ z;`m0vJ5S&_Q`Ng;Hb_oyNZVQvONBD6G#!YZ`8W!%y zL(e*WK`B{_lbk56x^5Y*!iKvkaWUqV21^R-9{~GSD2qV0RcXyZ=G{)Xe)6;=tP@@^ z729v%u0AEyU+*~OPT)|Lu(2pXgL ze%MQoGS-DV4Bykw#;hAs#TPpuS3Ti-ru(fMLgwI)`T!xbW_LJQts)sjNWdJ+!*3PR zoM5(;3{esIDimptDC;$%l6DjWUcc#t?Jm^b_`Y+RxR_a;A72t#l~}ziIS~t71mH<1 zoiyq#5~#DlfH7#W41IXsm!j;3p0FEoD%Oz=1MZ$4yg+4=hd7w{)#B~PTt#^;!s>IQ^X2q zY27*nII@-B=joOfJMgkA9R7`2+4!e(i!-7%z#N1ljf^=LSln*7BK~;dUjKEkT71%XJZGCAXU({b{pd7~1IjB~jWvTk?dg6sQ zgJr1z&VDw2R6&n&$;!~HKd6Fqo9KYFP8b!qO|@{U`oM!(qH+QY+YIfC0Fs+tsy)vT z>}SOCrlJR$jM^)Q3B*4}d5*pL(Uw{$y`CN5a_yr$2U)RSY2d3I}>{QA974<-~m>2^H`Z`xQ-yGkHh^rWBTX96hO(T8>gbhnH1fr-&Cl*=_n(8$D=7C!!j%Q=8ad5_dJ6CQZsQ z4Vv?L?!hcZs#v)sPKYfh*(AS?jdh398U3A};JXvwH;uchr9q&z;80Y4lYv-9(&g3m2PvhokJo z6QbE7F~5jt>+FXr{#0@QxKa?50CPe^IM8)Dt(zc!Z9*Uh^>w4MeVXITowZ z2FWyqmldcYZ-z6#r_kU_8&J0Z-+0C%JLay)jSS?0F@W2W z*0iW7%Ltp`5U`3V9PyQP2~`jmkdya-;q;Y;Xdt4)Y!*ZpWC9y*4^*TwOmV#?I2xq= z?bDtN8n|bL&e$UwTyGYwVod{N(7w1RgW2_SK!t9KJ<(>2y70BsuJjIBm9q;>2KB3U zUVKMfWR<(djQxRLs?>^5IpK>n=?fx3QhDgb(+)$>VLOmxCOb@)*XFtaYJ6;Tju zTFPPY3tf_j1^t9ettqaII+2Pds=^dwLnL|IKL_8eZIzZis9dwza1^Avj+{6`^;H#8 zSR*#1@9k!~6VG!Rc|Qrz3UcvoMH;}|?I{07ME9zN8^_BL8hTCBuwD&ziG=0Tzh8)` z)aP(jSynqgC9#>NLo@seP)Zm{dK&4aY=)`q6}+()DVuv-to5Y9N%EwFb#VB;(X-}) zfxxr&Elv)Dde_l`a3EKjJ=!uQJihqo#lkY&GxgQI#9C2A1lfwt*Sm1hhPkynBQMeZ zm?EW}teU`zG{cY~FLPK&8_M5$ouAa8|re*Unn+_Q{=UwQ>@%9Db}_5jIJhA+{!| zw343QJqNPRM(45x_Pn){$oe}nxl>qGQlnq`hN^cv{Ho%6M(^*cG@xzE4L zlE2&|Dq#+KjWg2c1Dg3G6HXcpBcby;HkTu_Gpj%qFjPdac6zVQ4W#7I7QEn2yE9=} zK(fL~sBCJSa*%JBkkwfGMMSfBwMK@1&=bprtI*oxRo6D&sGfSqy{B&JErp(@pN0;@ z6B8OHK;_w<=91LO#z5`&UdZoqB{3cj#KX=$&=3WHtXsCa0$|EJTFOd7sv-w+^Rh=v z6A(u$=OyU73ruo3 zz~n|3oXyyZ19TsK@&+}HW~!9T_U2(PVZ?y59n<}b4JZ(utD+wjjVD^wQwAr?g)9j?*E4@;Qvnd6I;h?yd)Nzaz_Dhm%NDrMp>K-6rRk?vnDWJDOylu zI3<&o$Rr-P!RPpkLPip654fL~el(2o--ZGHGcF2+>?hSxnx2eq2}&_L^$t=BJGBwx zpgLMK)7{*u3X%LUKf0mnVO&nB<$WY;06ZP#;ki)N#v`tz=ekTm+D7SwHsbthC zs%Dj#29-oA#Dj9{s-(rk@%o^E^M6eG5 zt4x@jK&a#wpifOc+{-I;;OACLtw+s^-oV^pqW0 zn&wa*itdP2cD;>4tIe~^Psj7g1DETNmBhve-qWm;dx^lTOmhe?UrwPl=Gg_d<#_eE zr=f&I?`@P4X^U4{>SK zc`Q;veN;$gXQ6*7E?Zu7ub3cWRh_rVEHwzGX@aOPCU6JhT(68aA%6A$Izokd-d-ve zXwlgeHe*~k7h$pBiOxRiPjy#|u;rJKH?jSu?^IS_cZNFG&jF`gA~+Ol3*464uGg*# z2fRZV)toxwD&78|@}{ebv$2=_p$%1h^ka)bzLr4?(kRGph<2HOb3iP+RtpJHH@5U8 z)Wk~938G9#oqi(%7Ow(I)S`;ND9q?EJ(V+fJ;(m|a5|N<;E$S_?NDRk`HLdz;BsZl zjc5noLNl>m_JVgTR57#J?kL72&Qs&(13>i4XyQ}A&*^aN^pK+beyU>2rJt!cQXORV z2l2{+Wc%nCh0CiwJ@ILJOWR}zmn2fG6(7jZl?VInpdSLv(T(zyFR zj&8;Fp&3a%L|L;qW5~6=xJ=r>!yqnG+8A>CXndv0iYzb1L&~vFi}tR(lc+5l;3|H} zDtc&~oZIr8U1B5jjJzcoa5EHfMWx^@x(9iZkje>}XSt1ef(~0a;aNZ~U+g=tS-HES z;?}PG_smWbyuHeRAAVXV3A~aCchVi!SDs|=u3Ny58k2V6Ve@`9P(&q*c3~;C-o!bb z%3W<`uXbhFqCU@{{^ACJu7SZwxd!mu7HOa37x@Ae ze;Gwdm8eL_sP2KLT5MjGut!eOGLYV>YbE1wX`?slnGmG3n(DgHlz$r3A5`zUydi<9 zlP68}0JRGB3Dih?#7CO}SaUE}W+a{)V8>Uu@g93pTc1ikm+E|*WSuCEoh1ueaLuS` zs@k{xs`J&vj22KqFw|JwQh~hPI7`iAGtFW{_@|cE3-Eu#mhe5&+-w&T zv`@;M0R6o)%Gwd>VUZ**;~lDB5W_RuC2$*t>abd@kdFB)a-fi03)Ear_L1)A-nKm!NP{kN)jp|q$GPLXw?Xh}}%V8f0V$b1)Eyh;R)F&MNv z@c6WDm6Q1RRGZcExJ+T-NW#pA`LE?5@^33v_}>b79cW}`y{Sf z=B!LXTrT5ocqtF)apY(M42-1`GDdW>m@eQt{JouEl%Yg8{tnEjX<)DTG0VvXP*8V2 zKY%EQe{MDYUhpyLumI0q;5DMn;VfzdUd}O;aQ_)o5ZPOH>-wWZoBS=1?ArydcxXl$qfZO?**JAepJqKT@-tBwD&fUy zOw9g`?fgxH9Ct;ghs!ZhN+Lt%OECo!GbBtsMh9wl0>p3j-SyS0EJAfDQdD$xfE$O@ zjYGGcn5lQ`owpt*KX0BPmc= z5HSPO3q6TUT$!08xoIdkfH2_GHu}U5=834tIVyE=tH!3m-P;|~_=~LB`g!?v7js3C zDVy>lqIO?g6BhrGuch_VH&HNo(RPMk^73a;E9>tkxipc6OMl|z$4MUmzOe+UrM}Z- z4Z|`Jqv4xskF%E_sfLd)O~s}0z~Cu!eB-qa6}}S-c=6 zRKGU9lMe3E)_N4bBIn8h0BbbSxAkZ_4j20&%`XpE^Qb}HH6Luv@p}z!wPNIqyfw{l zMXh;cYjGu@I<^2v}#OZZ3GJvw}twUxFUrKS(Rl{K)Tnu|43 zsuz}~a+#bs;5PVMP0o~R>w(7X9-Z0ay(WVlS8wCwcaKr54j=Y0?TO1X7Nd2?V7n}` z8$cq9_j6>5mk}qr%Yy?4f6USE^I}jxtiGeds6#wI32!4r5@TCK1Skjlj=KzAbXidez zYe&vD5Opwu9t$+Pp9QM=u_1j+j-4N@S8Y3JZ74zL3xPLfTUQjyB(g>RLf;5ydFiAkz6TiX@$c zNO8Io+Q&a%%tOGe9wPipkcDYc`{4Rj zkwQt6<>ehKavflT!Uv%^m;Mln2G}Nya7oPPI8MZZQh=SX0N)*yyy^<2gepK`|3N$= zL@8c zrQm%dbIwI)h^Rbn40GxS{LS=||8S(x`temQD?3eEAb&9bMf?aXGpzx?@3NE`=PMKg z5@Zv*@IQV`59&hss#2xofm}MaheQkqr!5v^yWdS17nB_i z_p8wwyK0qj4r67{My^S?*tK`nRJ+hsN|LR`R%W!qjtJVi8FxgcJC~LjUFQ3{+^66& zQyw17H zu%!MjXopf~iQfBXJgQh(Q`}K6{r{BsyBtnu*1<}# z1_9T9mx@`^eOYgSj2A&gFjgZ}(mj7OUsE08x!f-=6^2whdkcliJkM$Gm89R5d8G@H zD;ZWD-330M$MJz6kOiDmdy7d2FMA7u1@D-;eH@)-;A8K;K&tfWp_C0WJH)r_Gf!eQEALcr6ndmG-jRS)PI{vCI z09Bu}KVk6{&sJ=z>7^7ieQ8Iq^s2HTQndyfi%%(j^=8XY{bF@nxM zNS!2cqM^np6<@)r<}<=QFuiC1^@T!}8CDwBSyWlJFCv{gg~W-kE-3Ryks`#d?_Zm` z`_N~nqD+F}yD9l-^6q>FjT}AEWSLey4}-oGMbl@j@XgookwJ@hW`#|L2{I%9zWMv! zqP?Ny&&Q_Adda7XK5l+q0s-_!j`dwghQ0`_CiF>Mfw*>lu8ifzPz-=OUx$ZezT-&_ zM>ODs*2v)~+=~OYUk$UkB4R0RYeiX4ad+UeKv-6o-jBF`nK_>G43-;Eh9-G|ekjy* zwt>(~Y21%}OYt^(CasdZPFg>Sr(bp8=!Jn2I0f*R2n8W$o#BY!wf{q}?}ii?DAp zLwVJT>M=nkI|-_2fDf_KH7%lI&Sk{D*WT8bZYB2C`b*kcEE#}40ug=quxb)}?X%+RVmo6=oB)w2%b>Op$ zK<$o1s*&4z*=a~06VY7R@<>8pKNOIXJ0_v=t0?C+rVV=F5s*BCD-e&-n|yK3@bGXs zKKR5H?CqlZHV<|^KYnyD;`C6C^Afq}-$qNffw#{Z&JLtyGMcI9wivFyd@) z$2>rL0HCSwWkzRs8x)I!S#)-hh|0yPP`$HGRWXJb7D`` zSYrVr?Trl;+^DxUY%lZ1e}z^=2O@F#*%q7=7)QvXtr^WYVymTnsM2~XiWp4dYS9hi z$GO!5mDn@X;rSAeX30IvPyoRu7xSVqYL+1;2fzP0ZmfMAp=gYj(Xks>IJ^4kX2)QD z-EJNEQNAAgHft!f8#~_kCG)ZQA(6>3?sMrF(Y+KqgLee-oU3-Ztas;JJBOiK*!jzO z1)`o5j@V(#&o{l#C|tk3?0(xg&6xZ~m=1i0JnRvLTg501@Sf)6g)(7ppTU68^L)7L zE6*$8_cB{K(RbJF#OV{E$r-2N1^290=%9>GYX5n%_hk)!btu-Srz^|>bJ)mf|J!eY z>h;ct*qc@d#w<3twXN^_fTxz^_J{t?$Kef8U)H|0vG-3B$EXj58C)-wYlp3^H}c-M z8JsXNi9#JvfCG0w&yE|e$MeT^RqrXYw{4N#tsfgsGoPU&8vb5Zu|l>$^Lq zCsjY+4|CR5xS)$HVK$BV@+toueErY%P|En$cqb1(7r;>OUE$O5a{0wv!~s7iegBX$ zv|IO9pG;yp@0&W5))&K^=_R}OC&WDQ*T+!rH=Nf$cJGY30@@L=eo6}J*26m$otTG} zlTGnG2vH3qBhCUQ*B_=&_S*r&aX{pHmi}npx-( zNu&qh&l%56^TpOA>(pSBsu<3988!JWY?3mxFWRqK^%JC;o6qKX6Hj`kwvMRs{R#pw zuO}{C?2dzQ>nHUxBNAs<<3sz8#cn zTCVrC_JRmcX^GQ*ccB5tD|j}~#38ToS?xSPWosw)PKX<_fdA2KIgdm-qCbDfYYX5? zhOvG0OCJk^JjOKH?vd@d^RD`F=_yIVm#iJ_u`m@4Och4eK5FH0QaF;;>XFuYcPxqu zrZ|%`M%58dp2Yg)SfPzCE>|7&w?%m8SSM(8T0$IV(4W`RiO_C^c;J{8%=AP3Z6}Zb z7%f~Pl!sr=82c0>{(=5Ml7PrkdjJtE(Es&tA1)_buf7+_C=EK864*1yNn;80_gzB} ziF86|6#ZY?X|9-t)|=f(5Wq~d&Q8IKQ+6u`p$?9S|3O<90Pe;_G~JMD>DL4Bhh3I} z%P%ZHHFng|XpIevp;IcBXI+jyZ3AYq=5H;D@h zCVm>yJ->;)i-fH46FyZR{H3G^|FG2rDwJ(fG3AQsc}o z^{D*adI))GQ|-llT@_8hEO53j6->ZI1vhwygy;Abl zD7k)N;mbM3;t8)L;2OwA9cB1ja8o23?O5^nns$phKWQGl?L`rNQ1S<+Psux>mr4AN zB|Y!aHP9$>q>l;>fase<^m?I`ArNEO%`P{|1<_g>w`xv=(OcF%a+5l_p&M&^p%f6! zG=}XQX|NDiVU9^9UJvPI+f#1_vpC4dLDv$YRNkGLhOyRPw4l$>@$Ed@$CassZOLgi zHxA!|D9+A;GH%s^5*x^Rw$-Y$vz+eu2>za6{4Z`tT(JcWRIp|MLVH7X+@-~rxMOn! zFi#t!xJ`3B{@ya7LCksVxq|?OgS21u9k+u|TSwVu;J)-*Sbka3?&6zfD4EEQVSzvh z{{s^LfRHnh$HJ|S%i^LfNg$Ka7w05y;(l1+Gn@7|ixsJ-^V>We=H5+W@{(MlLQX=z zcz3ga3Vgea?3%;?LU9m4Naq7myNry3vZDOlUDk9;zx>s~7I`er%o2}HxPJS#xmn^% zIY4U@m=YbBk^%xa3NAn3D5O6ioy#*FnBi&Ry&XXAT z$r>|G&<2i4jn2U1@M7iCDl76siI@whr0xh*n%V^_9Ss`@ZyCjZq@?;tsg8gemuXD{ z6|dG44c}QD2Wdmh%`aGF2{Y=2&;j3hZ!iUnSIGg!4~hWeC&Pe4B*4T23UhG-g#(>| z!n8+>Ib|rW){k;=71lU$@YZnPr%RVThY*w$B}D-h zB_#!v7z7Cg6%i@v5*4JB7+^RE0@5+aprjxMH3HHxbSj`oNlC}h-Td}Jz1RDBp6B!X z#^?LTowN3OulI_**FJO3eq9F}J72u%#@)O)JWrq?RGVExV4bwvzG~^BqvLV?18Jk z!*fWWIvomBNvBz84rs1573|7%G7drayfDCO6yH#G4mh%e}gH#aq6j zl{!_69}I4SL3kLM5AjKAiW<3N^c3E}`T(##2&}0dd#5rGg8?xZAYRLvEU9@{)+Ufa zKG$WbDOf#@(Ti`L=eAxxBwN>)G;Wz}y49kjcqS}3Ac=#OVMR`ySH;Kr_HF9!cibG= z>guYT$sLUWK*0wWT(tvQFkOqoR_sG@Lc!1zJLH6XqD^^k!Z-9^#$r-oJkv%z4#!8yEWOKNyxJT}r z_!JPH7t0w_&XPUZ$zvrI?*xjgK+!Wz_5_m2W+lZN3mF-f^waDJX$oAA zs)%vOl1#9jyCdGfo^7(><87_uvB1F^Wpt_Dca(_^Ry_qO;gdjh6IL-qm=KI~V2KHU z2Ydk-4ukh#6)UXr1FA2u%H@i02DAVq$jB2$Pr}}w!QM^*Gz?aqfmQz2IvV_aGl41C zoKb>9;mXZxG+l439m>UXF(i3BiN`-&XBhQ-sKP^Tt)X_&I3}r)sOPp8OIPqB5WeXE z+g4!P9tCU*fo&hK4G;vjPc9m3TPf#LW1XO=Cw=c~046u)`7l)kU@w86%}+!<^!EY% z)}wOq(U&AnxlSXLFNd95uuNi<`aK&DboHB?^V9NZJ+lw1Cs>?J;%$;wI2YyfjDnw% z&QY83RB8sl!Z#h=XYG9YPUlqR)7v$4pS?>0#!|r8v{7CmF4E`O6gMRuB&N=IiuV<; zmc9BcH#h?ixbfkg$)bsR{YX{P%LYHis~8%+G%KL!1&T_bc!8k}yu-!Lct8!wpBfJs zNWg%guO?QCH-V2=Kyw*r`~ih|v?@um(NEDok~UD1hdm1Wm{CGIr!k^=aV3dg3%ls` z)yZl1QPWyv2qw{mj_Xi>wrxbBOZVAB0i9Mrcm)LQdqB7kYs@9(+68Mlb1 z`OlU1Ov_~Oo8ws9@tB7vas5}?Y}fjln-qi$iLR0kJB9*b<_hVsSO^fhfv^$;gc=~^ z28I}~@G<%um)r=44%Vg}1=88@gSC8gK-dif8X6#U0D+I{M8#Am!;uOXv6FN`ori%i z$^isQAUuZ!G9V~&&{2(61g355@|G`+j+(CIVFV_Eyu1=cDR`eWb8{0(CL7Pq1$kY^ zi&8jkHFI~3NhKRYw!yc0x}=gJV`Ttkl!#KS&I70fK%KKeUNc2NF$oljddc6M#()q3 z5J7-kF92Q!fWiqV@H0VP!FfQ@#g$Kx81)F%9JY2Vj$)mo$sf3Xv&*V2@x$O7Ig`%o z-jy9OWIj6*)D$sx$LO7gz^$&XFY$q!0|ah-W9PZ2n}K-}FjspkXOeTnyD}t>%;%vL zHHDkA#Jlfg@nk**($o}ssAKf2OMp8Cth<4ADX-`c_Z`RUNe~OGu1|$Z?5X^9we+4R-v9h(R4v&Z?}#&=p@Z;Z~MR!^2?2 z4F)D*RCPlfEFlNvMUDqPHNU_}0n8bJxe)lD^O>l@;5Zma18YxUO&3m8Cx411q((vH zIAs8^W?T#maOzK! z_ND?z(jDafuiVTvMMamBc4h7c`nXI-|5GM~r)V*wifm`Cf}}r9rJy;nPHbn>f~BuT z9Y;l{ODziNx{sJ-6JM=L$DRZVMW6^9G10uO*p|s*w9PHK|^2n}qfAVPh0K9MIzSReL53GWX^%i@lVBb? zM~6GD;98x5VgV?|0iy#jO2NduYype}z`(mh+par6a}2IBk=+A4X+I(YEN{R%1ZIK> z%!K%Il`?ugeO9U=#=)RhV7$jvUBJi|cV{*_jNG4Bi1vt&5u16g*2tE(^p!|wRM@+T zMGp1qQMn|WCU1rJQDnMl%|H4sB_-EwT4ycyD0=(SN{;_u!9P#%B}RJ_v} zQ~*5~C}@C!xY1kT3x?cZl8g38%5^r*)EClM7=@U`q(nI>FzL>0eT5@M# zkFc5FX*8#rT&Mh2#?OV@{cTybXDGmyBRh)MG%nN0@0 zL%E{Nh-Y9@JyHH0rtFWyo>1T-0L3Cm1Srms>)%$TDd2t~VrS)uArT1R0*aeJkqq3a zUi^`i2-upVo`GK*iLgx1`g8mIPub_z(cEr<>p&WtwLj`ofTXusYm5ev*c;oR z2h@$TEH@ktabjqfZ?j2*pS;E13etAO0W&vXwga2J10G(LfmcUvDQjt~oiq26XjZB$ zsi*u}Hrr?ua^He2djm9NENDmx(2!P}gW3dDr$M`SIM?783DAtq@sN$2JcZ?^1jiK6 z(JH_e18mO#TV>F^zMtxFouMA< zfVbV1qelTK19ZDUckCOmzB$1B{FrpluHE+7N^u%m%r)$&P>!wEX^TMUY>C3az%e%}A1D1n$T#c+i zXPRaE(w0N+^Mspv1YLon8e3pn zFtl}xKTV6rMGekAs6>}%#-~Mf&9P>w6~(`y#b@-m#E%^19ljm+SVl8JUOXWUlQ}+h z)TOV%_3_StD_IMpC#~&T4IEolKJ;sUA`CF(4BdKQmnPd+A|Tl0 zSSYRS>$Y^;{vyOBnzX(8>V}1t9G?~z6sv9fcsk9&X=iI_Mzb)oB3~kKVtaah3%gnD zUz1idoz&}o`t(?g{4UR)y%Z#h`TQbJ>eD#n3LPm8P{uuGUG?=}%(>`-y;}dER7%QT zg=b)rza-rH^*!EY*%+QSIb;k?o7}NUckbuckQq0R9mqdqGT7h zh#%SiwgchNxzrZ>CEXYjcMm_i3H?76(>T}H- zB7*}0c{!s_$vwMqnF5VN6HR<44kVu& zUwwr^Pnq#v=3~Fk7WeJ?G4^lQD%0&kg(4iT@5F8Pg$rs>=yHxH?8Lh@gdwkbSXkNU<&et28Ef5 zNd!!RBwx{=jjTK`>{FX5oI?L5tdeWew0AU??aTG%w4Wdn%=Bj1Shx`ji33_9(iDqC2N&dG6TP!O}! z|JdNO?xJUG4aLP!j~B6PV`~qZBgjYiwdzsZO(P|phf{x>Hvnrx^7p@;zlEKjd;2nH zgy>=*g99>245ucO(zDr&`nq^ytL!qR{o6{<&E`GXl9z5r7pG3*kPDIwe2x?f%p6`i z_xqKeo`g<4dwy44f%zmD-?;o#7#=b!L<9JJKb=XyLDQ6}%TG_=;m@N#fm1vN-Z6jB zqsap69%N*m2z=nZGXAk-HFNiY;gPf=kxZ6LhG=}r>NjmMLH`3Ne}=_l>!Z1EKcu3r z^4F`Thjq3J;$#>!KdYL`8JhZ(D0!e}cv2w1rCdD1HzKy$WTi%}xfG!jhSfQV^EWbd z3wZkyTkTa+O@X?;v-n*@ti6PjapX+L14Dd>$Ni#&EywH!MP~b-T>GDdO<055|9k|0 zmPkk@aS?J0#~KA(?+Qws<1UWHSaldi>(gQgQe2(<tuFJZ zPC_EEu;iY3iN_*wKcS1dQ1|nwSjD`J@|J|;jZniMrx%#kua!Jn9~;kRF7q4QimQ^4 z#nj9nIT(MPRub~F^l@CGM$a=G z4w9W@!`Cc(&q2o9_t)0Xjj_9LkPNfSWQ5Bsp8M`31D%-@HhRn?tERp!t+;@RR#>|B z^y;#ZzlZ6O&uw&PPYzx=c;@UEX)co^B-c!%0bKp`>Xi#e6#cKBZ@Cd&eGtRU1z<&! zBS%6=Z$W^xM1NMeg7Xc))wH6YK0Tea{85P?jns9-UQ<&Skx^`je5n{XN#S$!?iaPs zNj2_1i-&TUU*G*=S}9NGqf4ccb5GdpRb(Z<(tF*H(b+d|nlKK3&wm{h+MyhA9Nz?|DO7^7BPETAla!yqM~mI$N;M z=YoehP!r~Zt6u^$7veflVaro5K;8p>L&`#9 zDg>ekG<7U~e)MBFZb++>-8TeJV90UQ4qvHpKP5=?1Y;-19|62h@V*Xy5{NP--5VuWB##;-Pp=TX*iP z=<391LtAPN^WN?-Ub}2EXzcC1J^wyva}7#$yE0lQ--`4==}Jeix#on$osKLEM<37b z@lT3S^xSzbWqsVVB7P>Xq80b>e6>gK+z4*XzE0_Xue)(Jby>iqYJIz zT_}TugizipDU?kUltFToP##HJPnOX^|i6U{vBZ|uTqVD4Yw>rQ7vqa zbtHJoeXymQ)+4o$VB_=sC68+B3Ms`NZ)QqyPfcg#s83(f$>-+|DeFedZBDdbTcguC zSJj)dRjVVu(N&-SMr5Qa|DNg-ZVNNN^>6Zb1>)YzcUPm-0$&xx3))Hy*3U|b_a&Rk z6h{vT-JE zc2nJ_&`fiRunm2@*6xu>(=$TFhcyi&oV(ag#Ugy5GfT^smX^g(5f9s>7F~8rb5F~( z>vw#}mroeBmN{k86XA{_qqZDxg+B7dn_Fc@##$uuNWdTTR8TV?N+ z5zo$+dkWQYTx7*%{4KJz4HXtiL!K%>j})r8rRO3JCAXAlcT`yV#`!F!T~dPBH=m1? zwP-h1FQ~kbUgooKfD&+#?}wj@peM8&myw1%?9kov8I^F&?|$f%i9-c`e75Y6%clhu z)DJ$}(l)ok#k}HM+gkl27n?69Xv~f__ROj*=%Fy=ZXik_me01Buf}%tdi*kSnQzoE zvt%Zd9{)VQf0D!q)ppb_lp$lFF{Xrav2{EWb`_(s4FO-Hi6GtHrsw&6&xi6C&)Npc z{3N5d?d9@U=uzl-6C)m1;@MX>x(#?d=1RbCl26LvPrT>)!Dhtc!DqYZwE${|ld-u0 zCnM1e%5)Ia?sw7-0P)-lQ_`HVDBu|{Zie+7UzrD;)srbfu=t{=i%R5VkV$sk`PNMhJ`WjaKZ**LHb(U;d%xtjrH2~2+wb|neWBsAn*5AkA!`%7Rw#GZZ9NumH1Xn z(VLDE4VpJ+ueL_2UQcwwy8EH9u3pxWp-bQ&#ec>Kj&)XTZ|-i0wUkFEn9GZP0LnI@ zF^TeRUszca4FT<=ETBCqGA2>ET?=a)Vbh#!pwti@lc?B!11npA@|FxFyKR9|?=~a! zx0Ddl3@#+ylN&N#}7hmuV1p@Qp{rw*)bVP((9k##GsYps54qwXpzDYSO9zvB63 zDf~p@WcA2_b-7i+9z0pivQnOG#Ezf*3u_yd_t8biP_FszS+u9}x>xi)_HM7beeZ2N z>*R>Ae4Z`EHy4#wQ}afr-w^*5Jz?JSmat)ZGDhTKS!NB`sw13{PEX%wJceEz<;6BF z6c_3ra~N4I>G^o_GB37PRaZEyftz|^y>Dr>2ASXTm2ykdpt;$?x%T_glEa}3TQ71C zNE!C(f9AdFv%_Xl8}~3jXDNY@1I~;YJU=`fk;S|7wK>vBxTbFvmlnL7vz&KFz3(v> z3q?B=duSA{e!GCVD3{q?{#pQ9$Ed7qqdYbS*L2J;*Do$Qcpy8;Zd2acC`KBz7}lXb z_jv2iCHUAK8*l1V?0r-qb7Wepuq;aCAYMd6I-<1KoUb-z`c%hDV*{So$y%#}(gri5 zD39DbMvv=rvgIZ%eHM6HLf*AZWzzMTFF9QtU<`EFxFb%TQG6r5-GIvg^1N{j_x#5F z+%iMSS58HDB~Rv;*}#%h5l4O>W+B;k#Z^?y#_3&Zfy=hq+r8yP_SETwz`X*swX~P( zEqvWe+0h5yo6S7ZV<@tZw4N($JKxa?ozw1Yeci6#80zv&spRF}_|QhmZn2A04}DC# zyf{x(pGYq1+;Hsfx*8WG7`Vuuz4cM0+%|wVv4%Y$d4P$p`{AQ=4zD6Jcmye5T$8-QnNz$m}32 z>L1NW+!;_Dxa7C&4#XD`0_Se*XimUVP}w_Tq2;G#IrMHEcp}XY}%a9vQ4`+aN!5Z}L4mA1SnbbuHAW zWdIk|(>+8e*mT`Fl$-W|lA>NTAcJ2zx$8uaXaLlANCrr?q5(3G+?28`6CDc`@B?;$81JUJ%Qw8+b9?=ta1t!lv78)~N;8<4hU>1hvzSg%EUffwxSp zNp-{LMc`0-A31i1TLQ29N$@UVp!%s{e_vz``z{B5FJ*FaZ)fLr6gvHzotDt8wDs9j z31DLv7+5z#?E|eFYJoFzluz3=o-93~!wp&0UDgTq6a8C!CFO9*h&}7Ut zxOyGrdS-V^(M14nzIF$4nM*1tD%QaXAWK9OrRBNW+0{1*3k^%ynxYc^&XnDV+d6N0 zTeb!sUzqn_eSrL8_?f%wiRMSv3+2-|QIy+|IYS4O%E!Q67qa`2dtjQ~<#z1U1sVFl z$#?57$=2>r&o2D%NUK1zN#7H5DfjlvAfrXiziaJUv-L zsSqw9hiPCS(@5LWDGMLhrXmMaQr#)%$-X_jcu+oj>$8Ov7Ii1lHX^r1F zI2P~HLosQJT>X|*4z(PXvK;lQC|2Ji(qq>`E*>SjXcm^kdu3tPb)ook@b>Ld_Oh?o z1Qk@(NSbVXuZNJ%uIDG?%1ai+ERG ziU~b>WuXs}*~)a`bWl9%@_2d0_VxWHO_s-j7e7N+$Ykm{sM+tHs+cPttTI2dP9otR z-9idY_|j^`{|N1!H_@Ws&SFJgi}jMVuktI@oPTSxF0>P0e|P@e{Ago;8qTn3GvZuz z-~9VB^YMog?x}*^xNho%DOINp$EvrR5gF?Hkh1zdB?_J9c_>*jEiei3KoJc5)x;dAbj&{{WEKJxwDAi|O{x zL<>w<2s6eigzKbUJ9c|?b;_zMyUaIZD(wWaz4L=6Iu}GdmY0fiTEC6S3E?`Wlrg2+ zJZ*>$zSGh9?iZZ94;v+Gt+dl5OkuWxvjR=@p{3HzWBKVg`?SpmejuccrqK+jw)UrQ zj6x{a$*XCb5uZTFui0g1e}#Pg)91^NKSKrqt2ZE|(rkO@M+@|Iy>@LW_f*{dUp^o1 z`^0<;<$@-UPE46C&Fe6KMz6AcK-G`Y#nf5He?Y0+MaPn(2pSj8pFV*e^Xb2$oFMc{ z;_H|3ixa_*mnRRo5H8cgP_-w3n3lh=PEIUdbUl5-Af3$Cz)VT>>lX%tWhKcXj{tyc z^TGIc4i`cM+sp6}fkfETC@;XFq6<%f0oJr!Py1$T(BsFY#HHaOnKX&Oz|9^QxQh31@Qh&7-yxP@7N*%NoWoOqcf8fpWgiG4-%c5V^7renJ zg$$(ia2l9=4AwFdrF=;LN2$=yS|28d<>#pbR}Yi-?SQK<;&A3Y+%8tEilCZbBiPkX z6R-af0`xx^;&pH(<vg3rT6k@GjZB3Y4fFLKv3(FK9h4^SN!w| z)E5kx#}X~50TgLyYHs`bG>$4F|0jkEfw7ue0QIw&0m$}V_%A5fABN6X!>lhR01~VY z`vqA&g`wmMnDxvUKy&QBp(`yw$>yIU@im;hbvpR*h`k_66=Na#HQd572_7HfbOSl{ z*8#Km%-^v{Yhc#;2f(W1gRM-+ez6#!RVB&nvSxs5<#e-7)_)g9Sz&yn^d2VPo6SL$ zkDZKBwr0ygRgUqz$PJe7$53IOK$nzfHM@fzj~G4&dG@Ad1GjFPz|VIjdqsxHd#sAK zuah6r11wJ+^c~Pn(ofcx@`A()wJkt7YpHM!`|LdRf}D2ofH7nYxiwohs(MT~hRZrW zLbr!|Bm=Y;yrzFQ%6>0V^h4j3z6605{G+w@ZGQYm#{U@MoNAf15+s>D(gY?f${n7t z2tiO+DeD1H=fBD7e)4jTy!~hAeD&7ZIv-<_V7B0n8lx(t(Ddahq{y^c6;gOwgb%1RhI1DU{B62RES0oLIIV|-OG zmb(v40q8OeF+PJK)oK`0G=*6r!kem=Fr*a#Lsm5~)V>e70w@rMqJm&3uoi|a%wSd} zfN(Hm;|d_?Onxbhu^PcxhTx`Z+kUWcnATJeLq6s(bW3DYb*+QlDBZd)cPmT2yTndL z&xUcZQ{Q~4vdFLC;On?vNudukR2d|v3FTdqLRmD|HayQiCR}QfG(H>|bKmNz+)bNz z8FXZFh41r}m`PJ|mJSx?=0P;fq@%0fkC_~f)U)2V$$@R|FG$PVp|Fh^i2rlAAUa`wpq|VH2%h*yK&i=@H-F{g@8>{yy!ST!c+hwm?k9d^n_d z-+oB&bI5RBov=+f5s3MHKc@Y@!?ArERu|Z083AIt?8hA4cNn*C64ejf1XX&ni&E0d z-pixmmOK86biwmTHHpe$T5dV%MAE@a*2^xJ_PqB0E9c;Lp6fX1o!E=lJ5A-~K;A-e z+BDhku~~8*2^mH|#uOuiy?w1?YgDe_JR=}4c&@@e{(0H=2s{NYGe*h@iMs}Y41(E| znMuu({phm33=?@Lrgw-|bWPATu2W*<67M2Zo4VF_{58253AyY5%soaA!p&=66a;{L2k1`ZLOIY@2_ z=IcB8f~TC2bmuroZeBkDBwFT+orx(^a*xun+%>h4}ENExLh17{m;t> zzp+rKLhe=prUTz!U`x&$uZs%Of}j4Lw=`U=L~Qzv(V~1Y=5djjgm@MKd{O-TF4k)I zLp0q>+3zV=lMHUK{qxdwc}ck#4yE|S2@@XAz}Ub_TF-YLsvg8^-`kyNfpD$cUlR5( z58^#AE^#adSn<8_IP8wBz|0o^&Sheg$%Gja6`gHAU$l8woiEz7>+L;lqD!bon_}Nm zTd+11h+0cSUPM;{>OF!3VnA5`8a22bfbaeJ6jb1QV2(Z!Pl0IEz^Eq~Vmy+>lqioy z?Uo)u@M}*{lt22|bV#8%_R>EuAIOP3oeG6on@g6vWw%5H(W@G+ zffTVRisL|}@{v(D?e!BQqWFQn_&oi7{68 z8)^TS1n6f7FT}e{=JV3T^NffO=CAk=pz_tMvlAKj=@V=Z%|AL$^n>7XA_V9OcBGz5hJL@%Uk?5v8hem>I{tD1 z{d5jvo*Q(Cj(<4+Z{qqnQy~`){>VCj$mdr==ooPsc61V%qvKq3jmX1R9EU8>CoX*h z8Sev?AjL=Io=amdrQmSAMCIED5rna0L_bQPLM6ln+e|t{bBq-!V(By@9bADWjQxf_ zg(5!K{509&Ihol*hbRky$^dUJ0Y`^`(OFo4J^alSk|i!L`t9K_=`WO0~$j^xL-E7{Gdu{-&Q#*)IQpE_sK&04YTKx3>H~3>)#1mv7;wfVL z575qo<EXZ`DW3rpT(&( zY)X2i%*{@Vio zQyRbOgZ`eM|Cs{svX%!XY{wvM`}=#-@tb>NV^uwA$#wnop81#oN;@-|yvJrT+V*BL zVUA`py7rKnOau`0)Xl`n3$o%Hi?Y~Q3)K;p-kwJf*ySC(07Q)EksQ_XVB!l~q_Nzd zIU42u#24HSz@pwI|89XFN<^{LBsb{GyG4E|5XD~K7sV5+r&;Zi5zWm+Toga1PuL|P z;-?1!e_n!anu;GTP)De(^ zdZp#m5#5j1y@GczEw#vW>*)k{acI@V!Ytu?SC=0{@WcVut#7rph7#8Fv9uRV^ zP#_92!a8LJ6Qk>WE~fYrhFk6qdb$0cxD|CxO@> zxc=?#H=%8Ti!+G{0z`Hul#`e&1vu0=Kh z-~J9Sp8bb}E|l~w_>(ikW%gm=Qpml7(K_8-vdq@gRgJZ~6~<=lTIZ9P_RC%^GWl5& z^sAl>O(5@oPSJi%R}=)h{xL=Sgs^9ZAO0~#f6Qros4OI`j%cY% z0CPJ&tOllWX@6FL_dqh{(jThN3Gj3~oPg&!(>q6ocufkqAa$f8ul7`^iEO4y`*IaP@bTzp9{9x^OgCDi7v16b^gO9=;Dhc{5_VZDdPqT+4KwBo* zB|!)Q{QSum=jc7&gC;vm!PUrhp@%y%8clB#sb=SN3vMt$AJA(~8n7tqb0p_gC1_1O zUbw;DSAt&a*%!0q{kwGsL8MX!IFbPzX=h(Fc~xzl1@DEklyD2@fKAY>v@hn~G=*00 z!0nt5hgj8vL)7hy`k1 z-6Y7mRgj$}h_{{|4p7?m3Px{Omztzg(QBd{97aKo;H4!7%r@bhv( zM)N6+T+H}Or#vc@Hb?;)dFI$pd$2AGl$=BGa>MpQ9`NcJf#n`%x>5}<_X4~l{&Rp| z1P(ep*h01N7W#t#$AiEg`swdiN&l`rTdHT;i+t z7G_2s-CcDI!Eoh^O|^y>{+Zgpi&PLFy8fX~aQ+r>2G?nv#Qz0UW8n`Hg8p9@_+RU@ zv&Flt%*k$GmHQ3)GjLFZ^T+(@pAN|hiM-JG{6?6OV zTPP6qZV5zpZ3(C(BWBS|XVejEWq}dgf6<`-L*D-cZ9a);7D6+Pru@oU$k5*9?eNhS z#R-OlEhgShy}EPQ(pNd>SBWf4am?c2V#a>+*X8^vM(b&YDkY-c0d2To$PAu_oj3+i z;c3PnT}FBp*Z>{SsHYi0V?Bd=*Yt@(HGFf;>50pM`09eWnUNFda7-||Tk*7EMXjNbwKWdxo-tpz2njgxLX#&7 zfI`fSgEuuFysIcc=n`Uo7q}8bI5BN_lQMwXT@D;spa7MWz?J+#;2dHAl|U}A*FP9n zs`)@EKmGm92z#atO8MpQF9HW0oY)@;>=Q1Ty4468?u?M1#A<63LhqFpm*Dr-gTHID zXNI!bgtB=!qnBql`y@J@_Z~ygzXwa57?Nn-+!=7OpCAF|7SM)tb<4Gq4260_5>G~ zMcR>5CH6V8B;u=<<+Zz1U0n%8tXrbSW)PY6bPFQ5;2^78cox{bOHrW8EtD$U?IkIk z6vq0b$G1?FM!W)*VATWRRX+t*z2M*xdpfY{`cJ{CGns%kQ3P#bPscfQ3aom;L9mAV z1n4K@O0^NEE}nu(Ez79(;}odG@+QC; zE*`2?+|LeK@pmo%C#69DTeW~h{+vv>cv64+@PyqaUg(SB?lzMy+aM2Bzd?LuK~_jM zE5UTSRnp#(Z=Z&8O@aPco5IiK*iAOT`fJcg71MqNQ#tNP~vZ&A0iue9C z08blTzOc8;{#n%EdFSWgpRS?*4d14$e)$T>ah^|RJ!H0B(}BXQTiiKW55Z$*WOr9y zMJ=+?+Pde`X&@OYfhH@=2L;5s!HMmQK@UC6W*<(Zn6h4rR1?apP}m?fV}_!;{lXlgT7(9~UIpr`WojR6YZ`~D`7_;-n#Usby5qx2STD*FsIo~PCe#*D6=#LuSP3HOwJyG_Rz%>nuuc@T+As@P(FH2d zT`s;yhFNTW4K`ir*{c_*@V7Te>qH}&TkMkEy?|-t8OeCKkz3&2wd59#2hYgA25=)o zKRv1hS%T*O@7%kuOONTW9xL(MaWGs(#;YZ65F?3mzj= zy1MGH!4R4Stg4atss(ef3s_Ymu&To>px0dBUWV#)U(&O$ zx{w+2#_vBav%rhm0zXv#^>g;TzyamkQ}6+0TKP6NDL7|(0v|%M14cMGAbcZQGNS?JB~QQ! zmKA)s#R4C0k$nmk0tZ-M4geE#7}A7U^g^=n@B!8lU}8@SpMSxSZ29&C5paAFHlYR( zL`MR!kKpL&0Pq|Op8=hQJ(B}0i|A7*)$#tI@|<8imTJDazUW?d8O>RODw&QEIcDVy zNjlEEVKaj0n=()YK6QNbc?QnGMgW`)KeB?uv6OH3YQu-G+FP#JredphoqKsj(eEWZdM@Odg3$O{<$hRV0=;q$nk zCVxTT9G3)C^9Oq$0@Z+d`hyJ|LvSi0b}n@YT8>>qk@6lU0_Ueq$>?-kAXqZv>@op? z{VIzJ5|JX{%#rhd(eJ+7-wCgXP3zPCE)vdS*71T!Icm>6m4%c{8z4*2XlQwqiM9p5J+wQs zB)GQ67LRvdjH%k9wzWZ)luF)N=;^d&FOw~DkDjC37}&`s-*{V(cYiaK6~M(CpX%~v zs4#$u7rF8Il}f35>X0ZysHU{~!tEMSh8E3|n+pxLG}uO0Xo(xCv7l3PltE2XT4O=K zhLR!S$5j=ru2Di~CwN4+vgj|{tLCk;D)|@371Xb>YMTF|elnjafz$k#EH<~+_I9dr zG@`oO*X9HVO3~<#En#cy&}^n`*0*JO!GtW=Pg94|-loTAxi(K7NK^Azv5KAR!2F=a zu_JpkaA?* z1Wh9=`Dn2BVyzr%c;eICVr|7TEGCxN-~7vh5+djNTyz_%9DO2Kg5?vW6Tp#FHa%@3 zc+TG%T$JP}(NE6?YLLzZN{mD&jyqgc(%LXRo_0$r3_aqp+{T_e~FxWO4s-MN) zf|b4BP_`K1h>E*bXl`KmRzpA++j;1@YR9Of$|$T3DFA9NP6*cX_`~{JLlFiR=X9|W zA!<1N?D+l!8bkBpb^4|=gh?(z50o+1qiEietA9mjaMol`q9vxMxUxTaE#h{$q3NhTACx+k^kd_8yJAJoq##NJR^5hGkUy+zdk3Z-i$M`NEH#9j|wApn*TA!VDooNp1+HN@2-nMuP7ccIs zRyMPm*%MW`;xsTpn7-#;HE)y%6QIc2syz?iE_E!TC+4gYwlEi_1x;&%PPY z(z<$IPd)1ENsH%cyE_ODQ4~A*j|1W}0%Hft)e!aqazpdO1AFcp9t(B5Gdmmeu8(xl zItGT*M(ng|EjS}vfxU73++JQ;iHj_<1S#V#TQUoD-|buct1-FMpsPKeJXx zsa-|b`aGIHyim8&-o7=QztdE;$I9XO-sW)gFEx1 z>lK>LV)5_p_Uk{))W4p9M9N4J?^)tqdZ5C>?UbV3-p4UbX=?0MMiWrNn(RQs9)2F0 zH=^|$*rwfcDJs<8Xys#YW8eL;x8bz#ac^;cYi$^UPI&Cr?QRhAlL>vzL@ptOxA?rR zHRUz($L;R#q>S2z2aBzmcjjuEa@Y^e($3FYuCI+RwJr2~9^JfLI-8p5JjjHf9SB`( zDQj#BtQ!~z^~3J5dZ)fm&5CeMt=^H+yrs#W>hxSgS+sp{H*Sg$hWnGeQ(h~zp(9EdBIqvQT2|SWcbPA2oJz^+s$#RN_{V~n_6|-Z_7C~*-86h zk!oh`EOoNQmYw_h^1{sgQl)`?CdmLKy-vt4a$*=79IW*T-KilT&@Yn35H_48p6;!G z+;my-WAzEusLlv^mzp{z=WG_XB^94$FGmg0ey>c7BA+q7S?4{wa?$_jW>B+hE>io^ z=&shdY;f=%ddH}ybBUi2Q~s*_g>7^lAsGBx1VH4f54E>TAWB|AadHA z)t`Pl=WQ#{v*h0!Pb0)8Og3AaXoB2nBhpe?{z^mUzgwm}BQZ3$@gi32va>e+L?5{* zwA@BSc2aqjS)o;pT<5)EkSR0g7xgWQIM}4~C2X>9k=a=+{46nn=EE)TOMY@kPUPZR z8+1ht2QgZ*JW&El!kdIWb&}(`=TJuV-7@tq&r$`|=3`H}COIS--2|Na zwP#ZF->%+ciu5`=-jpbDu@$M)s4jS8WR?DLRPq8M{4~m#i?+8(5{V(1UgpCVMoZ0z zD{L8>K{l^Adw2qZlU&0@X@hQ+65mO0SZUF9aCqPI;F=_9U_p7l#y99llMYkpSN@`! z3#vC>J|c*Y+lgg)&_N3`^tsg{9l6y>dOA=vQRP!C1QIq%ph zlgL^2KGQzM>{b;{QKhqy3d^P;{k}!E0*bOcXEi!R+7*>iu~*G`0Ca-Nl%juA&qzWZ z8+~oE{x&xF>TCA+_x8{u!$l+^PyT)#$JdY<`ZLk5hbrIYz9X>Z7QFCYm*&c*Jbkp0 zmn>Y`UtvqPK~OX7QH?2$&K zarmZp5`yxcy(lg809or0#REv}RKcH6Z{D3@{6Isbb16`rF`WJNqqt-5mN~SY^EAF4 zp{%DwP&QJU?nLCiyBRt)ovEDNU(9&1dFJ8+!}$|UUl@!~<`U0en$2p;BuvsFOB|vO z*;qvqr(4_+RkSbU?3^lS^hvseO=N7~_@UaRYek0aiFZqebQ}1;@69H7w7xy|Fyq1- zA*Hm7Z@A;76)$FYP#$Btet{R2yESm`ILArEaqhxr4(9jKReP;g?-zHS%TFo|*ih(A z(S8)78;y1>D|1>haP5E4rP-f85*M`BS7{Ql{$6Cb;H6l9Wd-j;UPp9L06&hlo&7Az zwv|}nqwHODz8zF>Pm<6$UB=R`<515PpwacU;EoGt#dw--&$;8)4S3y#`}r)-UBat4 z2^to)_F{x0pUc~a+E;{A=TG@v{mRNQ>G)Xx^GlmSW6GtKJ9ig9zxx((S*D*ff6cgG zk&;3^MEBdd;{q?I5??wiA2J+4NbGu^R&MFhZJ|Dn1lke^DgW?Jiv@JegtBvk-l7=! zUAN`j@oO!F+>$hk-1{^u(_OE}H7t}ueyU@h$2#k!j|Y(OZxQUpH1Ceoe_e_qpw8fE z_oP}M)tG!;dM|QXIVwKCFa<4MRJ~w@eV$O}8}6Qx9*fDs&^N=7N^|imaT33)EpHoxj_bPi+soiaRt6#R%~zXMKP%^# znOo;Qj{5)FdJk~8x-M*Z#$W_9i0Gq52~i`u=ur}#=p;lPz1J{G5YeLyf{>_DqW2o2 z2hn>*ixwoJ1i^Pkp6_{|@4tSo>zK3l-fORQueI*IkC{0~nUXTU_QLzqmy%VM609A; zY`-_omC#sIV!6cj!e>|OaS-`u00I^$%T3>&!)CypMrr7kH8bnQfS&rSDZ5rVzs2#V zhF0svUph4;Q3cDTU#LJQXPJiDi$A}Z3>dp#Hc5%ZfI0!-2P0sdG6^n22`-k zNunJOUB)h*Ht-PnWCr%G&$&PCHaso1Nx$$$1u;?3MIdn}jS$Q#CH{fGN`Z&W{%0=n z1@}xn4gT{zN?huH#zyWo+!xWN`m;xylMsjFlB#G{`iZP^ykUK7zE>A<*@V}TKh#_! zDwiUDY?4XWV1_}}F-?!B)ln+-YOiM%yR+=6o$rBU%X~5XlJO{qt$CZGsyO!1$zBhk z@%-FUEdtFhp%Asq2yV}#FE?Zt#h%Zmkh!GFVM-OCqw#q|Qt3?90yFR$&gXjUbE2v& z)8oFq+BS@8WUINfc6XU%$fgK{JsB#;XOwhs(;OmZiGkB^rJtbMDdHq1nZ`v#7v7RA zH3Bo;=8aSiTd42e{Bu-Y0fIYtVnyMz9()|Q9LuzT2l6T6XSOeyrc&e_@o`^^|C(He zaH?cN%Z5tF@h&B(mF*Za)G~dsSb8$li+kH?hi%Q@#+_@qi-kOI2%>M(kmt9JsyhH& z@wL}_?upgs#^a$)CFi(hv|(8p(>cC2XpD+t8Qf}ifVwn&+u{}xbUfc{q!Pp-9s`Vi zJiO%~i`km*vy>RO-oSe;em46}D(?7W$q>Fy_#sEJ$vcT0c-?y8FO`BZvi;E_@k$-w zJ1bc7Yi0D-+XynB8?O2GaN$ABkG4=*wm0@_<_@)Ghxx{{1|EXGIv9)lGH!O9Rskb}U=9|=v?Hl^^Qw_uEP^5I#QU$bl0beGa6S}eXcyO?Z z)8X3l3kGOfvIO)wmk%HLzEF}iOdy;mc%*xosVZNR!zJe#0O<93L1U}KFHawFC zi2EFkWY4*pW*b_9UzN(XyE}m7=%PXiOhrOmtn}w zUNvuKF3TcP@M$_zWK{cGIkml>yfpc42RsHu*YrDWSMK+c3ZJ+eD9*ERtm5w|sN~JB zX>UHJ_yJ9?4QD!4Lb~m-bI#J)O-R0#>Bcp?2DH$*YB=F8^_Ly}3O9l=v0EJ{XZE;0 zvyGH+XCVNd^x0OqAY-LJM58mU9haKaViZZ|@vh@JpCX_48k%ftBJ(ZcZhk#ps!RI7 zf_7=w!^UJ(I8pOF(eAu^_D6e-L{6uK@LH;4Tf;~NPcE3g?{!nnbxE;e>3L6 zMsc#ile$rtB7I}t9={1?h@gdfxw3`!nH^ioY^k8h-h_Hv#bctF2S4RKQ??aL8jX?l z8y{-6Zb|-s@@+lD^cUEfx6z#7b;OF`bhLv%_Y+@%CQ3*rCATqrIhYP^Kjg z?UKl_<5ZuD4SOmt9nXyLuc9*2iLrZDycy$mHP}KNo*{5 z;Ly|S?N&6OR`1>NH&A^B|K0pT#*dnpJBUHim4Ld7Eok6XY@drdPLvfl^x0zvrgj(b z(|7wm)A%^}hd|^0tG*a@9HK8S?du26L7k{1JkUE)T;gRwXVHMAZcngrgKH=F&0T67 z;woBD^fD>`3l$LBN+j`C7H$e}*91Z-sD}ckr6>8C*@}vtNAn3zJvaEhX5iSv2-sBT zx+o6u0FK#>2)`>!+;aPFX&jY%FqVB2#fhfWHu|eD3Icu8^o&01`%hL>`N(LKUF_>% zSHlw@Po@6+2*LM!V3QQ28r=W70UHDGVO_;EJ)$5j#D=*C?=?(iSX!T%22OF8MJ!7@ z$Cz9@2OMl;Wz^CB!A$ubccE!fm&HER0|i(Q-1Tk8Nty00&kgj(Ql+YW<$0nccO{!Q zEL4>Ujn~e>A}^Vdj6~s`wT3V#8frFar%kTHd;O_X@Y=go?VUnPFiM}_hLW3s`TIkR zHt&7&qqa2qbw}W=c0ZX&BsV6F@}&y#CZN}i=7zkH(Ni&uJLUZ{^Hd}l@IKr_FP|dg zlF*OZTIDoUGO>b*akQKpBy4TuPM6PY3V7%ByfQ*JU#JI_z!096;zyGg;+V}a)L$J^ zV-`pv@87A{I5)5BK2IDyU}xr#L-1#(W7gmgEj&CNubtoc{iA%LGq&qy29zMcztz4} z5br>Bw)s=8a~TtoP$3=@y;hA{7OSy_D=cgC@iHllk&l*wI?^e5iGl#r|ADwH(hW5V z_>E8s7wpeA0yzv;k2J6b4NO*N>sxSrCGeIco~(8;Jh9H98|_vl`UIp8&{Sl>)xw70 z?*&@0BQyhmsHoZtIACE=6*Y@TE>(i2Q;|79nwqH%{7@iqCKrMFz2HZTlpie%GBs6uZ<(*z zRL?+H+D7q+U`-CjR@+*#$9;N!HuVX@-*BU4IpQ}hb*QXF%6))cMi#WN_giSbBepMQlEHY1OW&D zGQs30mF^E0W^=Kxd=00=y3&ji(-7o_Da;PABEmZ0JrI42 z)e^&Pyji()iZ5ji7OXW1s-r5vno?j@T%vFrwV^lj@G^D*(2_ediI-cPcZUiSo>*GB zQJC$@mYueoV(a7orS;n5#FHtQccVidEaEJKJ8<}ZIx=(lugjU-*-P6v{rbW0P?J3V3#D}k6hw}RK;{?b91%V0buxCuD zwBsU=mY0m4GzG?OvyE6)C&RD7shf|;IE#aq>={u;DP{q#m`Xvy^qAVw2OZ#0DhC#; z2|addfWliC0DS>?mT_xe2VV<|+A^yk>NT5mf@E zW^TqKo&007g|LFE2wpItZio5cE1=HasOzbS&1eWionDu>}lZ$&}SRz@R<-to>)7j>_eR@9elDRsquZI)YyHDH9& zjaP;X`W>cq*%4Y^cYCMk==lxCLR#AhsB3bhgVkr5P^qFWhWU7sfzT7)YzV%+Q9|Wb z0LOP0Vqm2+`sEh_th7Qr8+iA6^`+>60N%8kuos(lrUrGYauJ#U3z1|f^n@Yr??75= zD@|LJ@>SE(0jVDm$$p+Z6j*U?S_$#@SCayEzr?}X8|o9kmm+Rfo=?G9ym+TWss{iV zs}DPff@D8T?cYJ!nj}CAjtNW8%Gz9KMe2NuP;VXGp7Ok5goPCwf9zPhC@;H;kbpuh z=-qegc)kj8lvzu@LM+(=V!U9*1%VTurdJ&iB~VH`dy{1UvnI4;s`{zbTEsVOlf97^ z=50ZQr;FvJywM_0f~Y{Qc?!PYbP96GJ(6Vet!gnm|1+(D6YVWmTxu)D&{G_Q6XeiE zJzp0Zy87M3k2^nTjjPZ}d0UlBn-cVnm=L^fX@v6pVZ;k$#b>6kd7ka!V>f%IbJ@Hr zFrv5_iO7lGZ!-caSW7>wiJN626D)2R1Vq7mm@yfu#fs`9lx9f_#QUcD(2~16ZVq7T zn&2RJfzsI~sdZ^y`lwBNgY>$1Q2}Jmpe;z!VW9d)!+jg%>Mh3&b6YCO-ec6>mY5R? zKQ<{@ge2F&?GvQuQ*cxk!{mstU%Xc`9N6w8RAOTUpnVFEM_LN%W&Zci(9Ok-AX#iE zg0<)fM7hQYvqnxTad`@$NYC}4!*oh9#aldUoZ%~^{LlQTRd_-_xP$ozQ*!N-Ad~h+ ztJ66Ac95$b8+jv$+DZf!dH~!(nrSS=YXY)iZjq0-9rdJB!QM!yI)fp1B^rXCrk4xs z<3n7pssVG&6k83iKKzsb_8GEGTe7?8>4Zw6%A{l@p2h}_St_zfl0>LHgS}^3sKg)G zg~*<5|BlCU*xEt%(Y^6@w{(O>`_?ybZE(1t$yhogN~9|6H?5&ModAz5on-IS@4fCV zc|vg;qxzD0z6xLuB~Lr4#2`WhY;lN;)Jg1y^ivBoETl?XH$_Ke<$0?hMwp((T!qxRo7dEAFgJ^ zKlT#731lV~v+*qGbtRw}k=YTB8YDj(y8P=mHqB!kvgUxvn1IBzM()!;yxPA;W7z;@ zGy?aFcdlt-E`7uB%EDt5r@dQ<$A?$T?2Rr3_j1@%J2H(O-@^6!h6rF;7?Y=lmYHLH z8>o)|Ttzp!Z_j>(wgE};YbbDu5w1aEk*N2>eyGhjr1nebAJJ9QE4=W`fY1)JT@h<_ z3}9sht$})?1yMVyyCC8Rb_GqNyt4kUoY-K2;iK?KJWz9Au-j!>i4ED-?!9n9gRzfR zYk`sUoUe!S%maQhU?c1JZ)A-(%;)@#>Vc&R;3&s;|Nl_|M!Y*<`fBGbPkT=?8kMA5 z7r_rV?fkK6en5*=w|S+`9r55EW=#H{xKu|BL>Jp{s7Mw{lCU}fC3A)R0Y3oYaGIXy z4lnJT^#HArKFNORk;HYSpe2dNZf#xgy5Jxzh3iOK8yU9$*vy&zr8&$yjZ2N5kOVf) z*<)VK5vX-lE+T3xS$iOZvSKQ)@$(itF=Y1%Z!MJwm6|;T(w(EpusF_ivI;E>u)k2b zs~XX%XOF+nP<5prb*V_H{yw?tp+lWokgFlg!DK8XWziKQHb&Tv(%b1=IUIX3cYd~V zG2y%WL8@M%5_ogU>C2O?KJz))+nLxl<4AW@OJ=8fs?#a$ul&G^``J>f?6+w=KWv{4 z!hfz4b`ZTLo@R}e&=676A>Guc!x?`K&-`xSz1YnfDYCJfG;DnmVxbw-v~^bNfRPk6^|!Z>f=WE?5tSSNHatBB~HLi>bXi#>5oFOoJ9rPtpFp6%l? z1IU|0<{WN`-dC&`XMDDt{HE07Jb1Mw@rl33N`F0nC#;qn@#|GIcFZQpiK}8y@Ho9I zbrr~|G!sL5+BVL}o8d;#;f+wPMv+Bm%{LTzg|H}1I@|B&FZ5|}io>h7zVz{tHo97w z&@TbLbT#&Bqg*7>jKm%YXi)sJgq99GxlX>=4r|DwSqO{9a7%|EaA*AF;v9%)L90pl%1Hgw zzkU55=)h|pXisj+y34#-di@`@96IoyCQps!6RrMZM3}&u<|$Y*MdDDmlD0d? z^%L#)zWjhzUfPn_z5z*TP*OE^M()37oBWaf9O~eFEpP34;OS7Smxgn zbLQ_zC|FaQ1@KwC8#om)V{#KnNzX|nd z*vSp}SQhSDC~W{#EFizAOp^cHG!jJVO1%f<#+A&gJV}0SXM_)s9cGB6VtP?y?tA+W z#gYPL=%&^EsOw#={>`~QE-a27!3zJu(HoHYN(g!@U=#c=j>e_e;hQfo-%Nc_yfL`* z^#cEf7@6$0;Y+n8hT&g)^9%nSB1X_$ZQGZi03qPaxSe>$CGjbE1yvpR0w^iqjSrs> zkNTMpS#URwx!0U7=wsy()v|R^(Wk%0aW!;)HQEB>+!pD#$IhAST$V+@brB%)2sHpD&RA|q=Vp73wfIvq9KneBsoif}ud{yP>s*<5SF=B7 z-L!B$s55`Px#I@#o{z|)T#{RFvm|cn>6HvOqWaWi#GO$c3n}BUx)bkLA%6IvehJV! zE6cx5wLj;Zsck`|sKfC(%%1-fD!~)A_+xn1)9v+ zf4?glukP&@QAei_kc8_xIDRV*h;D7FrAZ%bCKj^b%>ti0_bnXm!j@I!E4RXCdL!MN z04-JF>zrd{FJ56wO+7ht-g>7yS!>u3@Dk7X z{QM@cVEkX%9{vNd>cI9h_lBvN7%r?@a>S^noB875(p@FKI(BEejooP^mQF+eD%tB( z#wt;x!;;cJlj%iWC02Gt)>cd=vzKr-_}6sQbZ)k7>y7Wc0R zEaM-UD^OL(61j+n(%H;UKOE%=D~5g|wV~Db_1oQnb4H|l=P=&HQj0zR1S25Jyv`Y6 z;_RHA{EzSx76gxYm%@M|mu)=JPyqUMG4HVa)#~=5vk;JpVuLg#`Y{KH#fV-R5K~t~@0`M4 zY}lQzcn1%T<(+?Ii;h>}pN9dwV8g#KXV3)>4vkbuD22*1` zY1cN#>^-_=fII$THncN)s<^fzB_qjr|6d$3=4uXOCP{L~TCk`wiV2nhHg_?WwR%~& z%3}3k6^}5&T>uhgrpthWp731@bn=p1_j0@%fkKI5L76d2`aA8{+vhN3u5${#nD4S$cXpSLj-@f`5+M)8O%v9%>$L$pz) z_}^OSi>razC;^+4MzGCHxTN-L%$oI)A8d*BR)W9aLaH3?!hnWrQ(~@JZ zy7_&&;oXDm`vavOy9WjeT|1^8=OxYgV=HnTZBskyB)32O*{YI|)JxcBYxTRV{mNKJ z(i5S<_?5)D2Sv{qi#m&{J4e4BnDcWF*efgi8PU|aJ@)J8$q(^MpY1>o{gH`=`GPoU zhSuH7lOIQiCx_?DXBSc1mlM#b0O#Q+EfW5}FMB%Ueq5S#|Jh#hx!0U=u|0ROguMKA zIbhoM1Rk-nDQ!a6x`^6|YrCu$ZI+aHvkFDAi=d_FY1$<3F;bZlO$}>^pq(#$-hbpg z2R<7{*(-J42C8EIe!~YXY6WIR2Pr`C>ddXcJrF_y&cpG@@^>Eylhg@AnadMGlxq@78Gx zX>kH_az>I@E8vrUY6m(*pY1w|zcj_Vn+auwIOXct+c{u`JpJe%)Tf6$c$-*j$cRq!IF3WoNA77vdTVE{>g#{V= z3k+Q|atkkPrj>Z<1#-Bnx>>5KhoX{Lg#TE)L2Haga!Sc%%b4}4)X>R2ukH+gau<9N z@xmnAIg*L*AX2c}=*!N!XG6R0d$$~MwNmxuuCo&%HWj_6G#HSw z&6K8EhoOC_@_LzrD0Cq!(GoNEW@=?Ek6vbKc8aic_eXwJ{Yl_UX{vsO68^!Z%3bQw z^CtwW?&{JH$T0B>H78pVYnG4Y7dUNB$I^m5mQsh9&M@DSe@Z1hLx~6J_v~#dohs$U z{Mrg*Ps@tm=Pj+^MUhZ2c38RZZZ1dcr5`{=&kMZEIEfTEVEz<8ybt%vV#h7Ha879^ z8Pju2ZM5HDzDkIglw1oFc~e5tqIoFL7}Ci0hr8HlR;$-`UgwWyB~I$ID!xuhj%BmO z8UX?Lo}OOa4qSmS425UyJ4UKSq{fnG#Cu&*Z6ys)GB;3VwMXgfLT&z4?k0D}0^%9P zYr>(+)X^t;8lxc?Yq=xPM3wXU0VYk1cO?B~(?ZYvuW^@MVurxSZl|dBd&8b4Y@GeP zb%I}$JQnO8_&$dW+BVyGGxB2ZvtabPNRh?;NkM^oRA-9cHP%t#d!O@v`O+H43Y|^b zKWKf+Ttr*&qr0L-OD)IIu;yd!&BfiR>n$Qk4A&)eI^cT+xxrMcBTbS0OgL3`?+ctM z5$&&D--1P2e(JPEEJ%|yIi}Svcm%Ndpjee7In6Um#fc8}JCykY6bY)To;U10)VP3v zK$n*gkfsU*_Xa5O972HJa0ECijtSr>GAFPb1kH3Gc=^H=OoR^>sY~((ixUuO^QEO# z?immI ziSvN{*WnybxmMkCrDojMQg)0+;^No)KcDR>>^A4>W+wO4Y^zz9B{C$sq3PdD?tVo% ze&sPKa9UpB9U8D`^!hqF8-P07<`el~byzBui(HWjw`lPqQFAv!sug&;DM!_3B^4YH zBm@{zxI&&37a#-PkNVuAqd0jqX#J)7Mb*1GYXej8bKXQ3}_?os$Dz&M5L+pTYeS-^2%|1ah2Sy?5TZLBn8HP?O(@t|FFP@TS3k^uur#mg6nJ3UYybv(!8A8_jvS(YBz)c|0C+v z?LhpjF(R$QUug$=UVqU2GkIsfQDV-!1Ao3cOd%$BpH>odG8qj9yHowCdUnq9ISUSp z4{xe$Enb*oFD2iw!UzRJpTAM`O5a(9_@l$5Z;(YeLPfUH@NM< z%?UCzq^|cuKD(3VUzHc9(56kiVL3xuX4=^>YMjz0wfCyMM&+hiiK+8F$0j{^k=lG$ zorvzqR(ldCQ~%A=46|km)-L8{dEsBA!4<)dQfBXJh$IO&XuA&vcD`Gm;&cjbl6v!e z43%n>xi?IH!}IIgY|God1*q&8vKyKsp=39-NAwCl69kNtWr-M@jH>3?qWe2mij$ij z-@%o)O1?$WDq^ExFZ-D3Ff^>yd9QaQs89=h*OPUGCxNU48l_`(fG+@$DBdewiYYPkw7CSs2k13pFE> zitb2tt(l1mw+ORLPiexrgzWeDb}g16nw|KQxre0o)vWfD1d|5-4v(in4~uH1yepp- zLWLa6utUQQ2eX7iJSQD2oj`e&)_2E4X@$$#OCtq59K{wP17xiIegrlKi6nv)4<1ee=7Y`Y?m&RTpd!c_zCx_~FAa z>tmZvk1|q|Bm$j6qOynAMYL}1K#St;3`%^sE3cTzMQ(oEll?PK42d?~T3G%2FVITN zK18yXnp_=q*XL;!(V?;$EO@;HF76^GXOGw zDHp&C(V?BzL6Lla@7KV;Kq9^N7{%`fOD-`*mt=}b`1!S6I& zUPnL|t{6p7FO0juk7q(hU1u{b5eAcgr-N&9GelgWolR~zbgbgpm$5P@$3mLSnPC4$8Qd;Q!?fH5*X};TvIMYwAdBvF!=jt$J{}@F_=4H8dl%V9X za$3?RQL9!sh7QKO{7@#|snSDN;Kddti#?zqhDp2#kN;kdJ3~ z&0USC>w0)Y%s%ed4eZG{`L}e+7q^JrE%JkGu6-FEy1x7Do!Fp|ng{>wxdwLFGFgAL zeDa-smOoA+9e$cR_=hhVQ2E4T`IbL~jyZ}6NMY^_7QKhT{0dF(WpVDb#puosj-Ghi zn5B?nTyw%sJpDc~7{zJ4EAG2!`L~`g|A-Qr-&PRTtXmiKI20?t8%n-O#)T7!AO5I} zC_fnX@lm)#w$m`O>_gn#%KA~s4_uqMww?(cuaZoJ`lp{=)XI-`5;!XV5U;Q8^RfnT z(}@yGp(NTbS#w?BLa#xk0fxfsd_G+PCwviem*B*okQ?aYa4-v4sBSnMtZ6}1@K$&j z!373MClF#+FR)ld^B%aac@IaM3oKYiLI(-L0}Ir}GeOW0@SQpiR){GC%wHFN3-X)j zTBWD*D;gXS$f}N31i}qQsna)>rN=+`6m%{3Bk9P#f$tH_!1H^rFwN%F@Pmg0_8ZkL zGsh-x{C6up^er$aa6l}=^v<*WDewtyjF}WVO8Xd~_MXAwJs-K=t_cZ@4~6Z%jbrTn zxN#$z+$^C$vzGCDhKfJ6ac$`HSuPT;xUN~&@srY-r}RA`9m-V!IH-Q$j*-ouTwJn6 zf2bRg<5O7hxnHXE3vnIH^mu0Zb&%2I7Tt&z|7s;jK4@EP5z!6Be}!RJZf>L~Zz1E2 zlM8umT>13T#}RU+JIRy;Qh2?%w&t@TgcdBX8Xn^hB121je%3DFZrrNT?A?UY2!-5U zx1vB!%yGpme(Ld`D1B|i&EAD8h;=vIuk3CsP|(@o5HV*LimQsU%{vbme8HdUI$=C%O; zLhK+>{rtYo2=6|HJU#0TzZ%Gct@dg?F%{{<%c02AZ&Ezbn!81Q9L|gWVsaO{=Rae^ z#UB*)zdLbzrt!m7X*bNTmSoc?u6cCjMHaNrP6_5BJ#k1d1s3=@hP0Fwn5U@fh!b-T zUY7SQ2~?Bz(_dO2A-trBq3$TSymJb}<{6%dey_Pnovk>89gI@Z=;SATzNh>rqW8GV z>%ANuTM=&It=qac3A#Q{&j|~9-JFX*`nq!O8i{MQ&C%GP-O9uR%0;McBKo$hAX6{o zlS)EyKnO!sO`A+sh3YlEB*N<+_@R26YYKzKFVM8LjU_U3i0F0Y{`<`jM>=M2f1LgS zQMSfe*HoWRHWJuIW%q$bX z_%~3#JhsRSgl%%9&bK3z2K9h>PU9cyh=p5;aovq&p?;IyE+?FUi}TXey5}ZBO~9R% z4Su|^H>(}r+%_(XeN{xQA@v%Ma&S6k?vNMi>YnvG&^|Okuh`v6HkUc4>z0bNi8XUf z?@hu^H1)B2XkVDEg!cm(pE8AUPllv|nH|$wMM>u+o%AsC`?R?$=c&#{o-#897jNo4 zMBfbE^;;la*I5QB&y9TL<2=X3!dw@47ZL%X2IKI6Zh-JX1RxNI8RX?~Tdold0-X}0 ziKQW0;9uy+(hvqZ4CUh?b3lwo1Om|l9sl=3jYdmDc4=b5` zij~|({O7XZ|KpsX{ogSq*fIWCKpEWrO7`zVm`VR%BwkJYZJLz_I;$%HomWBV3cwq5 z5>{f*1o^L(R``G0;EF)oJhu1wwZ9Twtb|1okQl@MO2iZZi5*sgBtwTQLhj*+Tt~|& zLs-$y+z>qUjv^4)Q}VwONhJuy?SJVW4+J9pA2Prz9~ubA(%C}O&Dq7B&)mi33PHqG z{R7#S0xS_^|4;uO1RAUiVL@vv0ka!1{+*-zE(DKKQw0yWlmdYmf!~)vF7Mm~vJv!u E0D;#JWdHyG diff --git a/vs-build/FASTlib/FASTlib.vfproj b/vs-build/FASTlib/FASTlib.vfproj index 011fe32a9b..32a1d83009 100644 --- a/vs-build/FASTlib/FASTlib.vfproj +++ b/vs-build/FASTlib/FASTlib.vfproj @@ -425,6 +425,7 @@ + From 8ed374fa8c974a158295676168af040089ff86a6 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Fri, 15 Nov 2019 22:23:27 -0700 Subject: [PATCH 12/72] Sync ServoDyn - remove prev outputs from SrvD inputs (for DLL); store them in misc vars instead - move call to controller to UpdateStates instead of CalcOutput - rework some of the DLL capabilities (move data structures around) + HSSBrake can now use avrSWAP107 (or SrvD will implement a linear ramp--change comment in input files about this); - trim case logic for linearization --- modules/openfast-library/src/FAST_Solver.f90 | 21 +- modules/openfast-library/src/FAST_Subs.f90 | 28 +- modules/servodyn/src/BladedInterface.f90 | 836 ++++++++--- modules/servodyn/src/ServoDyn.f90 | 747 ++++++---- modules/servodyn/src/ServoDyn_Driver.f90 | 72 +- modules/servodyn/src/ServoDyn_Registry.txt | 127 +- modules/servodyn/src/ServoDyn_Types.f90 | 1307 +++++++++++++----- modules/servodyn/src/TMD.f90 | 2 +- modules/servodyn/src/TMD_Registry.txt | 4 +- 9 files changed, 2185 insertions(+), 959 deletions(-) diff --git a/modules/openfast-library/src/FAST_Solver.f90 b/modules/openfast-library/src/FAST_Solver.f90 index 84e64ff318..37af8fccd3 100644 --- a/modules/openfast-library/src/FAST_Solver.f90 +++ b/modules/openfast-library/src/FAST_Solver.f90 @@ -703,7 +703,7 @@ SUBROUTINE AD14_InputSolve_NoIfW( p_FAST, u_AD14, y_ED, MeshMapData, ErrStat, Er END SUBROUTINE AD14_InputSolve_NoIfW !---------------------------------------------------------------------------------------------------------------------------------- !> This routine sets the inputs required for ServoDyn -SUBROUTINE SrvD_InputSolve( p_FAST, m_FAST, u_SrvD, y_ED, y_IfW, y_OpFM, y_BD, MeshMapData, ErrStat, ErrMsg, y_SrvD_prev ) +SUBROUTINE SrvD_InputSolve( p_FAST, m_FAST, u_SrvD, y_ED, y_IfW, y_OpFM, y_BD, MeshMapData, ErrStat, ErrMsg ) !.................................................................................................................................. TYPE(FAST_ParameterType), INTENT(IN) :: p_FAST !< Glue-code simulation parameters @@ -713,7 +713,6 @@ SUBROUTINE SrvD_InputSolve( p_FAST, m_FAST, u_SrvD, y_ED, y_IfW, y_OpFM, y_BD, M TYPE(InflowWind_OutputType), INTENT(IN) :: y_IfW !< InflowWind outputs TYPE(OpFM_OutputType), INTENT(IN) :: y_OpFM !< OpenFOAM outputs TYPE(BD_OutputType), INTENT(IN) :: y_BD(:) !< BD Outputs - TYPE(SrvD_OutputType), OPTIONAL, INTENT(IN) :: y_SrvD_prev !< ServoDyn outputs from t - dt TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message @@ -762,14 +761,6 @@ SUBROUTINE SrvD_InputSolve( p_FAST, m_FAST, u_SrvD, y_ED, y_IfW, y_OpFM, y_BD, M ENDIF - ! ServoDyn inputs from ServoDyn outputs at previous step - ! Jason says this violates the framework, but it's only for the Bladed DLL, which itself violates the framework, so I don't care. - IF (PRESENT(y_SrvD_prev)) THEN - u_SrvD%ElecPwr_prev = y_SrvD_prev%ElecPwr ! we want to know the electrical power from the previous time step (for the Bladed DLL) - u_SrvD%GenTrq_prev = y_SrvD_prev%GenTrq ! we want to know the electrical generator torque from the previous time step (for the Bladed DLL) - ! Otherwise, we'll use the guess provided by the module (this only happens at Step=0) - END IF - ! ServoDyn inputs from ElastoDyn u_SrvD%Yaw = y_ED%Yaw !nacelle yaw u_SrvD%YawRate = y_ED%YawRate @@ -4500,7 +4491,7 @@ SUBROUTINE CalcOutputs_And_SolveForInputs( n_t_global, this_time, this_state, ca IF ( p_FAST%CompServo == Module_SrvD ) THEN - CALL SrvD_InputSolve( p_FAST, m_FAST, SrvD%Input(1), ED%Output(1), IfW%y, OpFM%y, BD%y, MeshmapData, ErrStat2, ErrMsg2, SrvD%y ) ! At initialization, we don't have a previous value, so we'll use the guess inputs instead. note that this violates the framework.... (done for the Bladed DLL) + CALL SrvD_InputSolve( p_FAST, m_FAST, SrvD%Input(1), ED%Output(1), IfW%y, OpFM%y, BD%y, MeshmapData, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF @@ -4890,12 +4881,8 @@ SUBROUTINE SolveOption2c_Inp2AD_SrvD(this_time, this_state, p_FAST, m_FAST, ED, !!!CALL SrvD_InputSolve( p_FAST, m_FAST, SrvD%Input(1), ED%Output(1), IfW%y, OpFM%y, BD%y, MeshMapData, ErrStat2, ErrMsg2 ) !!! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! note that the inputs at step(n) for ServoDyn include the outputs from step(n-1) - IF ( firstCall ) THEN - CALL SrvD_InputSolve( p_FAST, m_FAST, SrvD%Input(1), ED%Output(1), IfW%y, OpFM%y, BD%y, MeshMapData, ErrStat2, ErrMsg2 ) ! At initialization, we don't have a previous value, so we'll use the guess inputs instead. note that this violates the framework.... (done for the Bladed DLL) - ELSE - CALL SrvD_InputSolve( p_FAST, m_FAST, SrvD%Input(1), ED%Output(1), IfW%y, OpFM%y, BD%y, MeshMapData, ErrStat2, ErrMsg2, SrvD%y ) ! note that this uses the outputs from the previous step, violating the framework for the Bladed DLL (if SrvD%y is used in another way, this will need to be changed) - END IF - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_InputSolve( p_FAST, m_FAST, SrvD%Input(1), ED%Output(1), IfW%y, OpFM%y, BD%y, MeshMapData, ErrStat2, ErrMsg2 ) ! At initialization, we don't have a previous value, so we'll use the guess inputs instead. note that this violates the framework.... (done for the Bladed DLL) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index a0e5721a6d..00ccec81a2 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -6390,6 +6390,7 @@ END SUBROUTINE FAST_CreateCheckpoint_Tary SUBROUTINE FAST_CreateCheckpoint_T(t_initial, n_t_global, NumTurbines, Turbine, CheckpointRoot, ErrStat, ErrMsg, Unit ) USE BladedInterface, ONLY: CallBladedDLL ! Hack for Bladed-style DLL + USE BladedInterface, ONLY: GH_DISCON_STATUS_CHECKPOINT REAL(DbKi), INTENT(IN ) :: t_initial !< initial time INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter @@ -6496,18 +6497,20 @@ SUBROUTINE FAST_CreateCheckpoint_T(t_initial, n_t_global, NumTurbines, Turbine, if (Turbine%SrvD%m%dll_data%avrSWAP( 1) > 0 ) then ! store value to be overwritten old_avrSwap1 = Turbine%SrvD%m%dll_data%avrSWAP( 1) - FileName = Turbine%SrvD%p%DLL_InFile + FileName = Turbine%SrvD%m%dll_data%DLL_InFile ! overwrite values: - Turbine%SrvD%p%DLL_InFile = DLLFileName + Turbine%SrvD%m%dll_data%DLL_InFile = DLLFileName Turbine%SrvD%m%dll_data%avrSWAP(50) = REAL( LEN_TRIM(DLLFileName) ) +1 ! No. of characters in the "INFILE" argument (-) (we add one for the C NULL CHARACTER) - Turbine%SrvD%m%dll_data%avrSWAP( 1) = -8 - CALL CallBladedDLL(Turbine%SrvD%Input(1), Turbine%SrvD%p%DLL_Trgt, Turbine%SrvD%m%dll_data, Turbine%SrvD%p, ErrStat2, ErrMsg2) + Turbine%SrvD%m%dll_data%avrSWAP( 1) = GH_DISCON_STATUS_CHECKPOINT + Turbine%SrvD%m%dll_data%SimStatus = Turbine%SrvD%m%dll_data%avrSWAP( 1) + CALL CallBladedDLL(Turbine%SrvD%Input(1), Turbine%SrvD%p, Turbine%SrvD%m%dll_data, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! put values back: - Turbine%SrvD%p%DLL_InFile = FileName + Turbine%SrvD%m%dll_data%DLL_InFile = FileName Turbine%SrvD%m%dll_data%avrSWAP(50) = REAL( LEN_TRIM(FileName) ) +1 ! No. of characters in the "INFILE" argument (-) (we add one for the C NULL CHARACTER) Turbine%SrvD%m%dll_data%avrSWAP( 1) = old_avrSwap1 + Turbine%SrvD%m%dll_data%SimStatus = Turbine%SrvD%m%dll_data%avrSWAP( 1) end if END IF @@ -6569,6 +6572,7 @@ END SUBROUTINE FAST_RestoreFromCheckpoint_Tary !! the turbine instance. SUBROUTINE FAST_RestoreFromCheckpoint_T(t_initial, n_t_global, NumTurbines, Turbine, CheckpointRoot, ErrStat, ErrMsg, Unit ) USE BladedInterface, ONLY: CallBladedDLL ! Hack for Bladed-style DLL + USE BladedInterface, ONLY: GH_DISCON_STATUS_RESTARTING REAL(DbKi), INTENT(INOUT) :: t_initial !< initial time INTEGER(IntKi), INTENT(INOUT) :: n_t_global !< loop counter @@ -6694,17 +6698,19 @@ SUBROUTINE FAST_RestoreFromCheckpoint_T(t_initial, n_t_global, NumTurbines, Turb if (Turbine%SrvD%m%dll_data%avrSWAP( 1) > 0 ) then ! this isn't allocated if UseBladedInterface is FALSE ! store value to be overwritten old_avrSwap1 = Turbine%SrvD%m%dll_data%avrSWAP( 1) - FileName = Turbine%SrvD%p%DLL_InFile + FileName = Turbine%SrvD%m%dll_data%DLL_InFile ! overwrite values before calling DLL: - Turbine%SrvD%p%DLL_InFile = DLLFileName + Turbine%SrvD%m%dll_data%DLL_InFile = DLLFileName Turbine%SrvD%m%dll_data%avrSWAP(50) = REAL( LEN_TRIM(DLLFileName) ) +1 ! No. of characters in the "INFILE" argument (-) (we add one for the C NULL CHARACTER) - Turbine%SrvD%m%dll_data%avrSWAP( 1) = -9 - CALL CallBladedDLL(Turbine%SrvD%Input(1), Turbine%SrvD%p%DLL_Trgt, Turbine%SrvD%m%dll_data, Turbine%SrvD%p, ErrStat2, ErrMsg2) + Turbine%SrvD%m%dll_data%avrSWAP( 1) = GH_DISCON_STATUS_RESTARTING + Turbine%SrvD%m%dll_data%SimStatus = Turbine%SrvD%m%dll_data%avrSWAP( 1) + CALL CallBladedDLL(Turbine%SrvD%Input(1), Turbine%SrvD%p, Turbine%SrvD%m%dll_data, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! put values back: - Turbine%SrvD%p%DLL_InFile = FileName + Turbine%SrvD%m%dll_data%DLL_InFile = FileName Turbine%SrvD%m%dll_data%avrSWAP(50) = REAL( LEN_TRIM(FileName) ) +1 ! No. of characters in the "INFILE" argument (-) (we add one for the C NULL CHARACTER) - Turbine%SrvD%m%dll_data%avrSWAP( 1) = old_avrSwap1 + Turbine%SrvD%m%dll_data%avrSWAP( 1) = old_avrSwap1 + Turbine%SrvD%m%dll_data%SimStatus = Turbine%SrvD%m%dll_data%avrSWAP( 1) end if end if diff --git a/modules/servodyn/src/BladedInterface.f90 b/modules/servodyn/src/BladedInterface.f90 index 2289105bb3..23a9f79447 100644 --- a/modules/servodyn/src/BladedInterface.f90 +++ b/modules/servodyn/src/BladedInterface.f90 @@ -29,22 +29,22 @@ MODULE BladedInterface IMPLICIT NONE - TYPE(ProgDesc), PARAMETER :: BladedInterface_Ver = ProgDesc( 'ServoDyn Interface for Bladed Controllers', 'using '//TRIM(OS_Desc), '14-Oct-2015' ) + TYPE(ProgDesc), PARAMETER :: BladedInterface_Ver = ProgDesc( 'ServoDyn Interface for Bladed Controllers', 'using '//TRIM(OS_Desc), '' ) !> Definition of the DLL Interface (from Bladed): !! Note that aviFAIL and avcMSG should be used as INTENT(OUT), but I'm defining them INTENT(INOUT) just in case the compiler decides to reinitialize something that's INTENT(OUT) ABSTRACT INTERFACE - SUBROUTINE BladedDLL_Procedure ( avrSWAP, aviFAIL, accINFILE, avcOUTNAME, avcMSG ) BIND(C) + SUBROUTINE BladedDLL_Legacy_Procedure ( avrSWAP, aviFAIL, accINFILE, avcOUTNAME, avcMSG ) BIND(C) USE, INTRINSIC :: ISO_C_Binding REAL(C_FLOAT), INTENT(INOUT) :: avrSWAP (*) !< DATA INTEGER(C_INT), INTENT(INOUT) :: aviFAIL !< FLAG (Status set in DLL and returned to simulation code) CHARACTER(KIND=C_CHAR), INTENT(IN) :: accINFILE (*) !< INFILE - CHARACTER(KIND=C_CHAR), INTENT(IN) :: avcOUTNAME(*) !< OUTNAME (Simulation RootName) + CHARACTER(KIND=C_CHAR), INTENT(INOUT) :: avcOUTNAME(*) !< OUTNAME (in:Simulation RootName; out:Name:Units; of logging channels) CHARACTER(KIND=C_CHAR), INTENT(INOUT) :: avcMSG (*) !< MESSAGE (Message from DLL to simulation code [ErrMsg]) - END SUBROUTINE BladedDLL_Procedure + END SUBROUTINE BladedDLL_Legacy_Procedure SUBROUTINE BladedDLL_SC_Procedure ( avrSWAP, from_SC, to_SC, aviFAIL, accINFILE, avcOUTNAME, avcMSG ) BIND(C) USE, INTRINSIC :: ISO_C_Binding @@ -54,13 +54,22 @@ SUBROUTINE BladedDLL_SC_Procedure ( avrSWAP, from_SC, to_SC, aviFAIL, accINFILE, REAL(C_FLOAT), INTENT(INOUT) :: to_SC (*) !< DATA to the supercontroller INTEGER(C_INT), INTENT(INOUT) :: aviFAIL !< FLAG (Status set in DLL and returned to simulation code) CHARACTER(KIND=C_CHAR), INTENT(IN) :: accINFILE (*) !< INFILE - CHARACTER(KIND=C_CHAR), INTENT(IN) :: avcOUTNAME(*) !< OUTNAME (Simulation RootName) + CHARACTER(KIND=C_CHAR), INTENT(INOUT) :: avcOUTNAME(*) !< OUTNAME (Simulation RootName) CHARACTER(KIND=C_CHAR), INTENT(INOUT) :: avcMSG (*) !< MESSAGE (Message from DLL to simulation code [ErrMsg]) END SUBROUTINE BladedDLL_SC_Procedure - - END INTERFACE + FUNCTION BladedDLL_CONTROLLER_Procedure ( turbine_id ) BIND (C) ! from Bladed 4.8 API + USE, INTRINSIC :: ISO_C_Binding + +! INTEGER(C_SIZE_T), VALUE, INTENT(IN ) :: turbine_id ! pointer (address) of data from Bladed or ENFAST that is required to be used in ExternalControllerApi.dll (as written in Bladed's API) + TYPE(C_PTR), VALUE, INTENT(IN ) :: turbine_id ! pointer (address) of data from Bladed or ENFAST that is required to be used in ExternalControllerApi.dll (using standard Fortran nomenclature for ISO C BINDING) + INTEGER(C_INT) :: BladedDLL_CONTROLLER_Procedure ! an integer determining the status of the call (see aviFAIL) + + END FUNCTION BladedDLL_CONTROLLER_Procedure + + END INTERFACE + #ifdef STATIC_DLL_LOAD INTERFACE @@ -89,39 +98,120 @@ END SUBROUTINE DISCON ! Some constants for the Interface: INTEGER(IntKi), PARAMETER :: R_v36 = 85 !< Start of below-rated torque-speed look-up table (record no.) for Bladed version 3.6 - INTEGER(IntKi), PARAMETER :: R_v4 = 145 !< Start of below-rated torque-speed look-up table (record no.) for Bladed version 3.8 and later + INTEGER(IntKi), PARAMETER :: R_v4 = 145 !< Start of below-rated torque-speed look-up table (record no.) for Bladed version 3.8 - 4.2 + INTEGER(IntKi), PARAMETER :: R_v43 = 165 !< Start of below-rated torque-speed look-up table (record no.) for Bladed version 4.3 and later - INTEGER(IntKi), PARAMETER :: R = R_v4 !< start of the generator speed look-up table - + INTEGER(IntKi), PARAMETER :: R = R_v43 !< start of the generator speed look-up table +#ifdef STATIC_DLL_LOAD + INTEGER(IntKi), PARAMETER :: MaxLoggingChannels = 0 +#else + INTEGER(IntKi), PARAMETER :: MaxLoggingChannels = 300 +#endif + + !! GH_DISCON_SIMULATION_STATUS - Flag returned by simulation from GetSimulationStatus. Descriptions taken from the user manual. + INTEGER(IntKi), PARAMETER :: GH_DISCON_STATUS_FINALISING = -1 ! Final call at the end of the simulation. + INTEGER(IntKi), PARAMETER :: GH_DISCON_STATUS_INITIALISING = 0 ! First call at time zero. + INTEGER(IntKi), PARAMETER :: GH_DISCON_STATUS_DISCRETE_STEP = 1 ! Simulation discrete timestep. + INTEGER(IntKi), PARAMETER :: GH_DISCON_STATUS_CHECKPOINT = -8 ! Create a checkpoint file (extension to GH DISCON documentation) + INTEGER(IntKi), PARAMETER :: GH_DISCON_STATUS_RESTARTING = -9 ! Restart step (extension to GH DISCON documentation) + !! GH_DISCON_PITCH_CONTROL - Flag to specify whether the pitch is controlled collectively or individually. + INTEGER(IntKi), PARAMETER :: GH_DISCON_PITCH_CONTROL_COLLECTIVE = 0 ! Pitch is controlled collectively - use GetCollectivePitchAngle and SetDemandedCollectivePitchAngle. + INTEGER(IntKi), PARAMETER :: GH_DISCON_PITCH_CONTROL_INDIVIDUAL = 1 ! Pitch is controlled on each blade individually - use GetPitchAngle and SetDemandedPitchAngle. + !! GH_DISCON_YAW_CONTROL - Flag to represent whether the yaw is controlled by rate or torque. + INTEGER(IntKi), PARAMETER :: GH_DISCON_YAW_CONTROL_RATE = 0 ! Uses the yaw rate demand to control yaw. + INTEGER(IntKi), PARAMETER :: GH_DISCON_YAW_CONTROL_TORQUE = 1 ! Uses the yaw torque demand to control yaw. CONTAINS !================================================================================================================================== !> This SUBROUTINE is used to call the Bladed-style DLL. -SUBROUTINE CallBladedDLL ( u, DLL, dll_data, p, ErrStat, ErrMsg ) +SUBROUTINE CallBladedDLL ( u, p, dll_data, ErrStat, ErrMsg, ChannelNameUnit ) + + TYPE(SrvD_InputType), INTENT(IN ) :: u ! System inputs + TYPE(SrvD_ParameterType), INTENT(IN ) :: p ! Parameters + TYPE(BladedDLLType), TARGET, INTENT(INOUT) :: dll_data ! data type containing the inputs for the Bladed DLL interface + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + CHARACTER(*), OPTIONAL, INTENT( OUT) :: ChannelNameUnit ! OUTNAME (Simulation RootName) + + PROCEDURE(BladedDLL_CONTROLLER_Procedure), POINTER :: DLL_CONTROLLER ! The address of the CONTROLLER or CONTROLLER_INIT procedure in the Bladed DLL + INTEGER :: ProcedureIndex + INTEGER(C_INT) :: aviFAIL ! status returned from Bladed controller + TYPE(C_PTR) :: turbine_id + TYPE(BladedDLLType), POINTER :: dll_data_PTR ! pointer to data type containing the inputs for the Bladed DLL interface + + + if (p%UseLegacyInterface) then + if (present(ChannelNameUnit)) then + call CallBladedLegacyDLL ( u, p, dll_data, ErrStat, ErrMsg, ChannelNameUnit ) + else + call CallBladedLegacyDLL ( u, p, dll_data, ErrStat, ErrMsg ) + end if + else + + if ( dll_data%SimStatus == GH_DISCON_STATUS_INITIALISING ) then + ProcedureIndex = 2 ! initialization call to CONTROLLER or CONTROLLER_INIT + else + ProcedureIndex = 1 ! normal call to CONTROLLER + end if + + CALL C_F_PROCPOINTER( p%DLL_Trgt%ProcAddr(ProcedureIndex), DLL_CONTROLLER) + dll_data_PTR => dll_data + turbine_id = C_LOC(dll_data_PTR) + + aviFAIL = DLL_CONTROLLER ( turbine_id ) + + ! these values are set in the controller: + ErrStat = dll_data%ErrStat + ErrMsg = dll_data%ErrMsg + + ! but we must also check the return value from the controller function (i'd think they would be the same) + IF ( aviFAIL /= 0 ) THEN + + IF ( aviFAIL > 0 ) THEN ! warning + ErrStat = max(ErrStat,ErrID_Info) + ELSE ! error + ErrStat = ErrID_Fatal + END IF + + END IF + + IF (ErrStat /= ErrID_None) THEN + ErrMsg = trim(p%DLL_Trgt%ProcName(ProcedureIndex))//trim(ErrMsg) + END IF + + end if - ! Passed Variables: + if ( dll_data%SimStatus == GH_DISCON_STATUS_FINALISING ) then + dll_data%SimStatus = GH_DISCON_STATUS_INITIALISING + else + dll_data%SimStatus = GH_DISCON_STATUS_DISCRETE_STEP + end if + +END SUBROUTINE CallBladedDLL +!================================================================================================================================== +SUBROUTINE CallBladedLegacyDLL ( u, p, dll_data, ErrStat, ErrMsg, ChannelNameUnit ) + ! Passed Variables: TYPE(SrvD_InputType), INTENT(IN ) :: u ! System inputs - TYPE(DLL_Type), INTENT(IN ) :: DLL ! The DLL to be called. - TYPE(BladedDLLType), INTENT(INOUT) :: dll_data ! data type containing the avrSWAP, accINFILE, and avcOUTNAME arrays TYPE(SrvD_ParameterType), INTENT(IN ) :: p ! Parameters + TYPE(BladedDLLType), INTENT(INOUT) :: dll_data ! data type containing the avrSWAP, accINFILE, and avcOUTNAME arrays !REAL(SiKi), INTENT(INOUT) :: avrSWAP (*) ! The swap array, used to pass data to, and receive data from, the DLL controller. !INTEGER(B1Ki), INTENT(IN ) :: accINFILE (*) ! The address of the first record of an array of 1-byte CHARACTERs giving the name of the parameter input file, 'DISCON.IN'. - !INTEGER(B1Ki), INTENT(IN ) :: avcOUTNAME(*) ! The address of the first record of an array of 1-byte CHARACTERS giving the simulation run name without extension. + !INTEGER(B1Ki), INTENT(INOUT) :: avcOUTNAME(*) ! The address of the first record of an array of 1-byte CHARACTERS giving the simulation run name without extension. - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + CHARACTER(*), OPTIONAL, INTENT( OUT) :: ChannelNameUnit ! OUTNAME (Simulation RootName) + ! Local Variables: INTEGER(C_INT) :: aviFAIL ! A flag used to indicate the success of this DLL call set as follows: 0 if the DLL call was successful, >0 if the DLL call was successful but cMessage should be issued as a warning messsage, <0 if the DLL call was unsuccessful or for any other reason the simulation is to be stopped at this point with cMessage as the error message. - CHARACTER(KIND=C_CHAR) :: accINFILE(LEN_TRIM(p%DLL_InFile)+1) ! INFILE - CHARACTER(KIND=C_CHAR) :: avcOUTNAME(LEN_TRIM(p%RootName)+1) ! OUTNAME (Simulation RootName) - CHARACTER(KIND=C_CHAR) :: avcMSG(LEN(ErrMsg)+1) ! MESSAGE (Message from DLL to simulation code [ErrMsg]) - + CHARACTER(KIND=C_CHAR) :: accINFILE(LEN_TRIM(dll_data%DLL_InFile)+1) ! INFILE + CHARACTER(KIND=C_CHAR) :: avcOUTNAME(p%avcOUTNAME_LEN) ! OUTNAME (in: Simulation RootName; out: string for logging channels Name:Units;) + CHARACTER(KIND=C_CHAR) :: avcMSG(LEN(ErrMsg)+1) ! MESSAGE (Message from DLL to simulation code [ErrMsg]) - PROCEDURE(BladedDLL_Procedure), POINTER :: DLL_Subroutine ! The address of the procedure in the Bladed DLL - PROCEDURE(BladedDLL_SC_Procedure),POINTER :: DLL_SC_Subroutine ! The address of the supercontroller procedure in the Bladed DLL + PROCEDURE(BladedDLL_Legacy_Procedure), POINTER :: DLL_Legacy_Subroutine ! The address of the (legacy DISCON) procedure in the Bladed DLL + PROCEDURE(BladedDLL_SC_Procedure), POINTER :: DLL_SC_Subroutine ! The address of the supercontroller procedure in the Bladed DLL ! initialize aviFAIL @@ -129,9 +219,9 @@ SUBROUTINE CallBladedDLL ( u, DLL, dll_data, p, ErrStat, ErrMsg ) !Convert to C-type characters: the "C_NULL_CHAR" converts the Fortran string to a C-type string (i.e., adds //CHAR(0) to the end) - avcOUTNAME = TRANSFER( TRIM(p%RootName)//C_NULL_CHAR, avcOUTNAME ) - accINFILE = TRANSFER( TRIM(p%DLL_InFile)//C_NULL_CHAR, accINFILE ) - avcMSG = TRANSFER( C_NULL_CHAR, avcMSG ) !bjj this is intent(out), so we shouldn't have to do this, but, to be safe... + avcOUTNAME = TRANSFER( TRIM(dll_data%RootName)//C_NULL_CHAR, avcOUTNAME ) + accINFILE = TRANSFER( TRIM(dll_data%DLL_InFile)//C_NULL_CHAR, accINFILE ) + avcMSG = TRANSFER( C_NULL_CHAR, avcMSG ) !bjj this is intent(out), so we shouldn't have to do this, but, to be safe... #ifdef STATIC_DLL_LOAD @@ -147,15 +237,13 @@ SUBROUTINE CallBladedDLL ( u, DLL, dll_data, p, ErrStat, ErrMsg ) IF ( ALLOCATED(dll_data%SCoutput) ) THEN ! Call the DLL (first associate the address from the procedure in the DLL with the subroutine): - CALL C_F_PROCPOINTER( DLL%ProcAddr(1), DLL_SC_Subroutine) + CALL C_F_PROCPOINTER( p%DLL_Trgt%ProcAddr(1), DLL_SC_Subroutine) CALL DLL_SC_Subroutine ( dll_data%avrSWAP, u%SuperController, dll_data%SCoutput, aviFAIL, accINFILE, avcOUTNAME, avcMSG ) ELSE - ! Call the DLL (first associate the address from the procedure in the DLL with the subroutine): - CALL C_F_PROCPOINTER( DLL%ProcAddr(1), DLL_Subroutine) - CALL DLL_Subroutine ( dll_data%avrSWAP, aviFAIL, accINFILE, avcOUTNAME, avcMSG ) - + CALL C_F_PROCPOINTER( p%DLL_Trgt%ProcAddr(1), DLL_Legacy_Subroutine) + CALL DLL_Legacy_Subroutine ( dll_data%avrSWAP, aviFAIL, accINFILE, avcOUTNAME, avcMSG ) END IF #endif @@ -175,12 +263,17 @@ SUBROUTINE CallBladedDLL ( u, DLL, dll_data, p, ErrStat, ErrMsg ) ErrStat = ErrID_None ErrMsg = '' END IF + + IF (PRESENT(ChannelNameUnit)) THEN + ChannelNameUnit = TRANSFER(avcOUTNAME,ChannelNameUnit) !convert C character array to Fortran string + CALL RemoveNullChar( ChannelNameUnit ) + END IF RETURN -END SUBROUTINE CallBladedDLL +END SUBROUTINE CallBladedLegacyDLL !================================================================================================================================== !> This routine initializes variables used in the Bladed DLL interface. -SUBROUTINE BladedInterface_Init(u,p,m,y,InputFileData, ErrStat, ErrMsg) +SUBROUTINE BladedInterface_Init(u, p, m, y, InputFileData, InitInp, ErrStat, ErrMsg) TYPE(SrvD_InputType), INTENT(INOUT) :: u !< An initial guess for the input; input mesh must be defined TYPE(SrvD_ParameterType), INTENT(INOUT) :: p !< Parameters @@ -188,12 +281,13 @@ SUBROUTINE BladedInterface_Init(u,p,m,y,InputFileData, ErrStat, ErrMsg) TYPE(SrvD_OutputType), INTENT(INOUT) :: y !< Initial system outputs (outputs are not calculated; !! only the output mesh is initialized) TYPE(SrvD_InputFile), INTENT(INOUT) :: InputFileData !< Data stored in the module's input file + TYPE(SrvD_InitInputType), INTENT(IN ) :: InitInp !< Input data 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 ! loop counter INTEGER(IntKi) :: ErrStat2 ! The error status code CHARACTER(ErrMsgLen) :: ErrMsg2 ! The error message, if an error occurred @@ -210,61 +304,71 @@ SUBROUTINE BladedInterface_Init(u,p,m,y,InputFileData, ErrStat, ErrMsg) CALL DispNVD( BladedInterface_Ver ) ! Display the version of this interface - p%Ptch_Cntrl = InputFileData%Ptch_Cntrl - p%Gain_OM = InputFileData%Gain_OM ! Optimal mode gain (Nm/(rad/s)^2) - p%GenPwr_Dem = InputFileData%GenPwr_Dem ! Demanded power (W) - p%GenSpd_Dem = InputFileData%GenSpd_Dem ! Demanded generator speed above rated (rad/s) - p%GenSpd_MaxOM = InputFileData%GenSpd_MaxOM ! Optimal mode maximum speed (rad/s) - p%GenSpd_MinOM = InputFileData%GenSpd_MinOM ! Minimum generator speed (rad/s) - p%GenTrq_Dem = InputFileData%GenTrq_Dem ! Demanded generator torque (Nm) - p%Ptch_Max = InputFileData%Ptch_Max ! Maximum pitch angle (rad) - p%Ptch_Min = InputFileData%Ptch_Min ! Minimum pitch angle (rad) - p%Ptch_SetPnt = InputFileData%Ptch_SetPnt ! Below-rated pitch angle set-point (rad) - p%PtchRate_Max = InputFileData%PtchRate_Max ! Maximum pitch rate (rad/s) - p%PtchRate_Min = InputFileData%PtchRate_Min ! Minimum pitch rate (most negative value allowed) (rad/s) - p%NacYaw_North = InputFileData%NacYaw_North ! Reference yaw angle of the nacelle when the upwind end points due North (rad) - - p%DLL_NumTrq = InputFileData%DLL_NumTrq ! No. of points in torque-speed look-up table: 0 = none and use the optimal mode PARAMETERs instead, nonzero = ignore the optimal mode PARAMETERs by setting Record 16 to 0.0 (-) - p%DLL_InFile = InputFileData%DLL_InFile - - p%DLL_DT = InputFileData%DLL_DT - IF ( .NOT. EqualRealNos( NINT( p%DLL_DT / p%DT ) * p%DT, p%DLL_DT ) ) THEN + p%UseLegacyInterface = InputFileData%UseLegacyInterface + + m%dll_data%Ptch_Cntrl = InputFileData%Ptch_Cntrl + m%dll_data%Gain_OM = InputFileData%Gain_OM ! Optimal mode gain (Nm/(rad/s)^2) + m%dll_data%GenPwr_Dem = InputFileData%GenPwr_Dem ! Demanded power (W) + m%dll_data%GenSpd_Dem = InputFileData%GenSpd_Dem ! Demanded generator speed above rated (rad/s) + m%dll_data%GenSpd_MaxOM = InputFileData%GenSpd_MaxOM ! Optimal mode maximum speed (rad/s) + m%dll_data%GenSpd_MinOM = InputFileData%GenSpd_MinOM ! Minimum generator speed (rad/s) + m%dll_data%GenTrq_Dem = InputFileData%GenTrq_Dem ! Demanded generator torque above rated (Nm) + m%dll_data%Ptch_Max = InputFileData%Ptch_Max ! Maximum pitch angle (rad) + m%dll_data%Ptch_Min = InputFileData%Ptch_Min ! Minimum pitch angle (rad) + m%dll_data%Ptch_SetPnt = InputFileData%Ptch_SetPnt ! Below-rated pitch angle set-point (rad) + m%dll_data%PtchRate_Max = InputFileData%PtchRate_Max ! Maximum pitch rate (rad/s) + m%dll_data%PtchRate_Min = InputFileData%PtchRate_Min ! Minimum pitch rate (most negative value allowed) (rad/s) + p%NacYaw_North = InputFileData%NacYaw_North ! Reference yaw angle of the nacelle when the upwind end points due North (rad) + + m%dll_data%DLL_NumTrq = InputFileData%DLL_NumTrq ! No. of points in torque-speed look-up table: 0 = none and use the optimal mode PARAMETERs instead, nonzero = ignore the optimal mode PARAMETERs by setting Record 16 to 0.0 (-) + + m%dll_data%DLL_InFile = InputFileData%DLL_InFile + m%dll_data%RootName = p%RootName + p%avcOUTNAME_LEN = max( LEN_TRIM(m%dll_data%RootName), MaxLoggingChannels*2*(1+ChanLen) ) + 1 ! = max( size of input, size of output ) + c_null_char + + m%dll_data%DLL_DT = InputFileData%DLL_DT ! Communication interval (sec) + p%DLL_n = NINT( m%dll_data%DLL_DT / p%DT ) + IF ( .NOT. EqualRealNos( p%DLL_n * p%DT, m%dll_data%DLL_DT ) ) THEN CALL CheckError( ErrID_Fatal, 'DLL_DT must be an integer multiple of DT.' ) END IF - IF ( p%DLL_DT < EPSILON( p%DLL_DT ) ) THEN + IF ( m%dll_data%DLL_DT < EPSILON( m%dll_data%DLL_DT ) ) THEN CALL CheckError( ErrID_Fatal, 'DLL_DT must be larger than zero.' ) END IF - + p%DLL_Ramp = InputFileData%DLL_Ramp - p%BlAlpha = exp( -TwoPi*p%DT*InputFileData%BPCutoff ) !used only for the DLL - m%dll_data%PrevBlPitch(1:p%NumBl) = p%BlPitchInit + p%BlAlpha = exp( -TwoPi*p%DT*InputFileData%BPCutoff ) !used only for the DLL if (InputFileData%BPCutoff < EPSILON( InputFileData%BPCutoff )) CALL CheckError( ErrID_Fatal, 'BPCutoff must be greater than 0.') - IF ( p%Ptch_Cntrl /= 1_IntKi .AND. p%Ptch_Cntrl /= 0_IntKi ) THEN - CALL CheckError( ErrID_Fatal, 'Ptch_Cntrl must be 0 or 1.') + IF ( m%dll_data%Ptch_Cntrl /= GH_DISCON_PITCH_CONTROL_INDIVIDUAL .AND. m%dll_data%Ptch_Cntrl /= GH_DISCON_PITCH_CONTROL_COLLECTIVE ) THEN + CALL CheckError( ErrID_Fatal, 'Ptch_Cntrl must be 0 (collective) or 1 (individual).') + RETURN END IF + m%dll_data%Yaw_Cntrl = GH_DISCON_YAW_CONTROL_RATE ! currently only available option + m%dll_data%OverrideYawRateWithTorque = .false. - IF ( p%DLL_NumTrq < 0_IntKi ) THEN + CALL AllocAry( m%dll_data%BlPitchInput, p%NumBl, 'm%dll_data%BlPitchInput', ErrStat2, ErrMsg2 ) + CALL CheckError(ErrStat2,ErrMsg2) + + IF ( m%dll_data%DLL_NumTrq < 0_IntKi ) THEN CALL CheckError( ErrID_Fatal, 'DLL_NumTrq must not be less than zero.') - ELSEIF ( p%DLL_NumTrq > 0 ) THEN - CALL AllocAry( p%GenSpd_TLU, p%DLL_NumTrq, 'GenSpd_TLU', ErrStat2, ErrMsg2 ) - CALL CheckError(ErrStat2,ErrMsg2) - - CALL AllocAry( p%GenTrq_TLU, p%DLL_NumTrq, 'GenTrq_TLU',ErrStat2, ErrMsg2 ) - CALL CheckError(ErrStat2,ErrMsg2) - - - p%GenSpd_TLU = InputFileData%GenSpd_TLU ! Table (array) containing DLL_NumTrq generator speeds for the torque-speed table look-up (TLU) (rad/s) - p%GenTrq_TLU = InputFileData%GenTrq_TLU ! Table (array) containing DLL_NumTrq generator torques for the torque-speed table look-up (TLU) (Nm ) - - END IF + ELSEIF ( m%dll_data%DLL_NumTrq > 0 ) THEN + m%dll_data%Gain_OM = 0.0 ! 0.0 indicates that torque-speed table look-up is selected + + CALL MOVE_ALLOC(InputFileData%GenSpd_TLU, m%dll_data%GenSpd_TLU) ! Table (array) containing DLL_NumTrq generator speeds for the torque-speed table look-up (TLU) (rad/s) + CALL MOVE_ALLOC(InputFileData%GenTrq_TLU, m%dll_data%GenTrq_TLU) ! Table (array) containing DLL_NumTrq generator torques for the torque-speed table look-up (TLU) (Nm ) + END IF + IF ( ErrStat >= AbortErrLev ) RETURN - CALL AllocAry( m%dll_data%avrSwap, R+(2*p%DLL_NumTrq)-1, 'avrSwap', ErrStat2, ErrMsg2 ) + ! Set status flag and initialize avrSWAP: + m%dll_data%SimStatus = GH_DISCON_STATUS_INITIALISING + + CALL AllocAry( m%dll_data%avrSwap, R+(2*m%dll_data%DLL_NumTrq)-1 + MaxLoggingChannels, 'avrSwap', ErrStat2, ErrMsg2 ) CALL CheckError(ErrStat2,ErrMsg2) IF ( ErrStat >= AbortErrLev ) RETURN + m%dll_data%avrSWAP = 0.0 IF (ALLOCATED(y%SuperController)) THEN CALL AllocAry( m%dll_data%SCoutput, SIZE(y%SuperController), 'm%dll_data%SuperController', ErrStat2, ErrMsg2 ) @@ -275,12 +379,10 @@ SUBROUTINE BladedInterface_Init(u,p,m,y,InputFileData, ErrStat, ErrMsg) ! Initialize dll data stored in OtherState - m%dll_data%GenState = 1 - m%dll_data%GenTrq = 0.0 - m%dll_data%YawRateCom = 0.0 - m%dll_data%HSSBrFrac = 0.0 + m%dll_data%initialized = .FALSE. + + - #ifdef STATIC_DLL_LOAD ! because OpenFOAM needs the MPI task to copy the library, we're not going to dynamically load it; it needs to be loaded at runtime. p%DLL_Trgt%FileName = '' @@ -290,25 +392,53 @@ SUBROUTINE BladedInterface_Init(u,p,m,y,InputFileData, ErrStat, ErrMsg) p%DLL_Trgt%FileName = InputFileData%DLL_FileName - p%DLL_Trgt%ProcName = "" ! initialize all procedures to empty so we try to load only one - p%DLL_Trgt%ProcName(1) = InputFileData%DLL_ProcName + if (.not. p%UseLegacyInterface) then + p%DLL_Trgt%ProcName = "" ! initialize all procedures to empty so we try to load only two + p%DLL_Trgt%ProcName(1) = "CONTROLLER" + p%DLL_Trgt%ProcName(2) = "CONTROLLER_INIT" + + CALL LoadDynamicLib ( p%DLL_Trgt, ErrStat2, ErrMsg2 ) + if (ErrStat2 > ErrID_Fatal) then ! it loaded the DLL but didn't find the INIT routine + p%DLL_Trgt%ProcName(2) = p%DLL_Trgt%ProcName(1) ! we won't call the separate controller_init routine the first time + p%DLL_Trgt%ProcAddr(2) = p%DLL_Trgt%ProcAddr(1) + elseif (ErrStat2 == ErrID_Fatal) then + CALL CheckError(ErrID_Info,'Error opening BLADED interface DLL. Checking for legacy DLL.') + CALL FreeDynamicLib( p%DLL_Trgt, ErrStat2, ErrMsg2 ) ! this doesn't do anything #ifdef STATIC_DLL_LOAD because p%DLL_Trgt is 0 (NULL) + p%UseLegacyInterface = .true. ! Bladed checks for the legacy version if it can't find the CONTROLL function in the DLL, so that's what we'll have to do, too + end if + end if + + if (p%UseLegacyInterface) then + p%DLL_Trgt%ProcName = "" ! initialize all procedures to empty so we try to load only one + p%DLL_Trgt%ProcName(1) = InputFileData%DLL_ProcName + + CALL LoadDynamicLib ( p%DLL_Trgt, ErrStat2, ErrMsg2 ) + CALL CheckError(ErrStat2,ErrMsg2) + IF ( ErrStat >= AbortErrLev ) RETURN + CALL WrScr('Using legacy Bladed DLL interface.') + end if + +!-------------------------------------- + p%NumOuts_DLL = 0 +!!! CALL GetBladedLoggingChannels(u,p,m, ErrStat2, ErrMsg2) ! this calls the DLL, but we don't have the correct inputs for a time step, so we'll close the DLL and start it again +!!! CALL CheckError(ErrStat2,ErrMsg2) +!!! IF ( ErrStat >= AbortErrLev ) RETURN +!!! +!!! ! close and reload library here... +!!! +!!! CALL BladedInterface_End(u, p, m, ErrStat2, ErrMsg2) +!!! CALL CheckError(ErrStat2,ErrMsg2) +!!! IF ( ErrStat >= AbortErrLev ) RETURN + CALL LoadDynamicLib ( p%DLL_Trgt, ErrStat2, ErrMsg2 ) CALL CheckError(ErrStat2,ErrMsg2) IF ( ErrStat >= AbortErrLev ) RETURN + +!-------------------------------------- #endif - - ! Set status flag: - !m%dll_data%avrSWAP( 1) = 0.0 - m%dll_data%avrSWAP = 0.0 - !CALL Fill_avrSWAP( 0_IntKi, t, u, p, LEN(ErrMsg), m%dll_data ) ! Status flag set as follows: 0 if this is the first call, 1 for all subsequent time steps, -1 if this is the final call at the end of the simulation (-) - - - !CALL CallBladedDLL(p%DLL_Trgt, m%dll_data, ErrStat2, ErrMsg2) - ! CALL CheckError(ErrStat2,ErrMsg2) - ! IF ( ErrStat >= AbortErrLev ) RETURN - ! + CONTAINS !............................................................................................................................... SUBROUTINE CheckError(ErrID,Msg) @@ -343,6 +473,172 @@ SUBROUTINE CheckError(ErrID,Msg) END SUBROUTINE CheckError END SUBROUTINE BladedInterface_Init !================================================================================================================================== +SUBROUTINE GetBladedLoggingChannels(u,p,m, ErrStat, ErrMsg) + + TYPE(SrvD_InputType), INTENT(IN ) :: u !< An initial guess for the input; input mesh must be defined + TYPE(SrvD_ParameterType), INTENT(INOUT) :: p !< Parameters + TYPE(SrvD_MiscVarType), INTENT(INOUT) :: m !< Initial misc (optimization) variables + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + + ! local variables + + INTEGER(IntKi) :: StartIndx ! starting index used to parse name/unit from Bladed DLL + INTEGER(IntKi) :: Indx ! index used to parse name/unit from Bladed DLL + INTEGER(IntKi) :: i ! The error status code + INTEGER(IntKi) :: ErrStat2 ! The error status code + CHARACTER( p%avcOUTNAME_LEN ) :: LoggingChannelStr ! The error message, if an error occurred + CHARACTER(*), PARAMETER :: RoutineName = "GetBladedLoggingChannels" + + + CALL Fill_CONTROL_vars( 0.0_DbKi, u, p, LEN(ErrMsg), m%dll_data ) + + if (p%UseLegacyInterface) then + + CALL CallBladedDLL(u, p, m%dll_data, ErrStat, ErrMsg, LoggingChannelStr) + IF ( ErrStat >= AbortErrLev ) RETURN + + p%NumOuts_DLL = NINT( m%dll_data%avrSWAP(65) ) ! number of channels returned for logging + + ALLOCATE ( m%dll_data%LogChannels_OutParam(p%NumOuts_DLL) , STAT=ErrStat2 ) + IF ( ErrStat2 /= 0_IntKi ) THEN + CALL SetErrStat( ErrID_Fatal,"Error allocating memory for the Bladed DLL logging channels name array.", ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + + ALLOCATE( m%dll_data%LogChannels(p%NumOuts_DLL), STAT=ErrStat2 ) + IF ( ErrStat2 /= 0_IntKi ) THEN + CALL SetErrStat( ErrID_Fatal,"Error allocating memory for the Bladed DLL logging channels array.", ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + + ! get names and units of channels + do i=1,p%NumOuts_DLL + m%dll_data%LogChannels_OutParam(i)%Indx = 0 + m%dll_data%LogChannels_OutParam(i)%SignM = 1 + m%dll_data%LogChannels_OutParam(i)%Name = "LogChan"//trim(num2lstr(i)) + m%dll_data%LogChannels_OutParam(i)%Units = "Unknown" + end do + + StartIndx = 1 + do i=1,p%NumOuts_DLL + + ! parse the channel name + indx = StartIndx + INDEX( LoggingChannelStr(StartIndx:), ':' ) - 1 + if (indx > len(LoggingChannelStr) .or. indx < 1) then + call SetErrStat( ErrID_Severe,"Error getting logging channel name.", ErrStat, ErrMsg, RoutineName ) + endif + + m%dll_data%LogChannels_OutParam(I)%Name = LoggingChannelStr(StartIndx:indx-1) + StartIndx = indx + 1 + + ! parse the channel units + indx = StartIndx + INDEX( LoggingChannelStr(StartIndx:), ';' ) - 1 + if (indx > len(LoggingChannelStr) .or. indx < 1) then + call SetErrStat( ErrID_Severe,"Error getting logging channel units.", ErrStat, ErrMsg, RoutineName ) + endif + + m%dll_data%LogChannels_OutParam(I)%Units = LoggingChannelStr(StartIndx:indx-1) + StartIndx = indx + 1 + end do + + !todo: make sure trim(m%dll_data%LogChannels_OutParam(i)%Name) does not contain spaces; replace with '_' if necessary + + else + + + ALLOCATE( m%dll_data%LogChannels( MaxLoggingChannels), & + m%dll_data%LogChannels_OutParam(MaxLoggingChannels), STAT=ErrStat2 ) + IF ( ErrStat2 /= 0_IntKi ) THEN + CALL SetErrStat( ErrID_Fatal,"Error allocating memory for the Bladed DLL logging channels.", ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + + CALL CallBladedDLL(u, p, m%dll_data, ErrStat, ErrMsg) + IF ( ErrStat >= AbortErrLev ) RETURN + + p%NumOuts_DLL = m%dll_data%NumLogChannels ! set this as a parameter in case the DLL changes the value during the simulation + + end if + + + ! convert Bladed-allowed unit specifiers to actual units + do i=1,p%NumOuts_DLL + select case (m%dll_data%LogChannels_OutParam(I)%Units) + case('1/T') + m%dll_data%LogChannels_OutParam(I)%Units = 'Hz' + case('A') + m%dll_data%LogChannels_OutParam(I)%Units = 'rad' + case('A/P') + m%dll_data%LogChannels_OutParam(I)%Units = 'rad/W' + case('A/PT') + m%dll_data%LogChannels_OutParam(I)%Units = 'rad/Ws' + case('A/PTT') + m%dll_data%LogChannels_OutParam(I)%Units = 'rad/Ws^2' + case('A/T') + m%dll_data%LogChannels_OutParam(I)%Units = 'rad/s' + case('A/TT') + m%dll_data%LogChannels_OutParam(I)%Units = 'rad/s^2' + case('F') + m%dll_data%LogChannels_OutParam(I)%Units = 'N' + case('F/L') + m%dll_data%LogChannels_OutParam(I)%Units = 'N/m' + case('F/LL') + m%dll_data%LogChannels_OutParam(I)%Units = 'N/m^2' + case('FL') + m%dll_data%LogChannels_OutParam(I)%Units = 'Nm' + case('FL/A') + m%dll_data%LogChannels_OutParam(I)%Units = 'Nm/rad' + case('FL/L') + m%dll_data%LogChannels_OutParam(I)%Units = 'Nm/m' + case('FLL') + m%dll_data%LogChannels_OutParam(I)%Units = 'Nm^2' + case('FLT/A') + m%dll_data%LogChannels_OutParam(I)%Units = 'Nms/rad' + case('FLTT/AA') + m%dll_data%LogChannels_OutParam(I)%Units = 'Nms^2/rad^2' + case('I') + m%dll_data%LogChannels_OutParam(I)%Units = 'A' + case('L') + m%dll_data%LogChannels_OutParam(I)%Units = 'm' + case('L/T') + m%dll_data%LogChannels_OutParam(I)%Units = 'm/s' + case('L/TT') + m%dll_data%LogChannels_OutParam(I)%Units = 'm/s^2' + case('LLL') + m%dll_data%LogChannels_OutParam(I)%Units = 'm^3' + case('LLL/A') + m%dll_data%LogChannels_OutParam(I)%Units = 'm^3/rad' + case('M') + m%dll_data%LogChannels_OutParam(I)%Units = 'kg' + case('M/L') + m%dll_data%LogChannels_OutParam(I)%Units = 'kg/m' + case('M/LLL') + m%dll_data%LogChannels_OutParam(I)%Units = 'kg/m^3' + case('M/LT') + m%dll_data%LogChannels_OutParam(I)%Units = 'kg/ms' + case('MLL') + m%dll_data%LogChannels_OutParam(I)%Units = 'kgm^2' + case('N') + m%dll_data%LogChannels_OutParam(I)%Units = '-' + case('P') + m%dll_data%LogChannels_OutParam(I)%Units = 'W' + case('PT') + m%dll_data%LogChannels_OutParam(I)%Units = 'J' + case('Q') + m%dll_data%LogChannels_OutParam(I)%Units = 'VAr' + case('T') + m%dll_data%LogChannels_OutParam(I)%Units = 's' + case('VI') + m%dll_data%LogChannels_OutParam(I)%Units = 'VA' + end select + + end do + +END SUBROUTINE GetBladedLoggingChannels +!================================================================================================================================== + !> This routine calls the DLL for the final time (if it was previously called), and frees the dynamic library. SUBROUTINE BladedInterface_End(u, p, m, ErrStat, ErrMsg) @@ -358,17 +654,16 @@ SUBROUTINE BladedInterface_End(u, p, m, ErrStat, ErrMsg) ! call DLL final time, but skip if we've never called it if (allocated(m%dll_data%avrSWAP)) then - IF ( .NOT. EqualRealNos( m%dll_data%avrSWAP( 1), 0.0_SiKi ) ) THEN - m%dll_data%avrSWAP( 1) = -1.0 ! Status flag set as follows: 0 if this is the first call, 1 for all subsequent time steps, -1 if this is the final call at the end of the simulation (-) - !CALL Fill_avrSWAP( -1_IntKi, -10.0_DbKi, u, p, LEN(ErrMsg), m%dll_data ) - - CALL CallBladedDLL(u, p%DLL_Trgt, m%dll_data, p, ErrStat, ErrMsg) + IF ( m%dll_data%SimStatus /= GH_DISCON_STATUS_INITIALISING ) THEN + m%dll_data%SimStatus = GH_DISCON_STATUS_FINALISING + m%dll_data%avrSWAP(1) = m%dll_data%SimStatus ! we aren't calling fill_avrSWAP, so set this manually + CALL CallBladedDLL(u, p, m%dll_data, ErrStat, ErrMsg) END IF end if CALL FreeDynamicLib( p%DLL_Trgt, ErrStat2, ErrMsg2 ) ! this doesn't do anything #ifdef STATIC_DLL_LOAD because p%DLL_Trgt is 0 (NULL) - IF (ErrStat2 /= ErrID_None) THEN - ErrStat = MAX(ErrStat, ErrStat2) + IF (ErrStat2 /= ErrID_None) THEN + ErrStat = MAX(ErrStat, ErrStat2) ErrMsg = TRIM(ErrMsg)//NewLine//TRIM(ErrMsg2) END IF @@ -388,7 +683,7 @@ SUBROUTINE BladedInterface_CalcOutput(t, u, p, m, ErrStat, ErrMsg) ! local variables: INTEGER(IntKi) :: ErrStat2 ! The error status code CHARACTER(ErrMsgLen) :: ErrMsg2 ! The error message, if an error occurred - + character(*), parameter :: RoutineName = 'BladedInterface_CalcOutput' ! Initialize error values: ErrStat = ErrID_None @@ -396,41 +691,31 @@ SUBROUTINE BladedInterface_CalcOutput(t, u, p, m, ErrStat, ErrMsg) ! Set the input values of the avrSWAP array: - CALL Fill_avrSWAP( t, u, p, LEN(ErrMsg), m%dll_data ) - + CALL Fill_CONTROL_vars( t, u, p, LEN(ErrMsg), m%dll_data ) + + #ifdef DEBUG_BLADED_INTERFACE -!CALL WrNumAryFileNR ( 58, (/t/),'1x,ES15.6E2', ErrStat, ErrMsg ) -CALL WrNumAryFileNR ( 58, m%dll_data%avrSWAP,'1x,ES15.6E2', ErrStat, ErrMsg ) +!CALL WrNumAryFileNR ( 58, (/t/),'1x,ES15.6E2', ErrStat2, ErrMsg2 ) +CALL WrNumAryFileNR ( 58, m%dll_data%avrSWAP,'1x,ES15.6E2', ErrStat2, ErrMsg2 ) write(58,'()') #endif - - + ! Call the Bladed-style DLL controller: - CALL CallBladedDLL(u, p%DLL_Trgt, m%dll_data, p, ErrStat, ErrMsg) + CALL CallBladedDLL(u, p, m%dll_data, ErrStat, ErrMsg) IF ( ErrStat >= AbortErrLev ) RETURN #ifdef DEBUG_BLADED_INTERFACE -!CALL WrNumAryFileNR ( 59, (/t/),'1x,ES15.6E2', ErrStat, ErrMsg ) -CALL WrNumAryFileNR ( 59, m%dll_data%avrSWAP,'1x,ES15.6E2', ErrStat, ErrMsg ) +!CALL WrNumAryFileNR ( 59, (/t/),'1x,ES15.6E2', ErrStat2, ErrMsg2 ) +CALL WrNumAryFileNR ( 59, m%dll_data%avrSWAP,'1x,ES15.6E2', ErrStat2, ErrMsg2 ) write(59,'()') #endif - - - !bjj: setting this after the call so that the first call is with avrSWAP(1)=0 [apparently it doesn't like to be called at initialization.... but maybe we can fix that later] - m%dll_data%avrSWAP( 1) = 1.0 ! Status flag set as follows: 0 if this is the first call, 1 for all subsequent time steps, -1 if this is the final call at the end of the simulation (-) - + ! Get the output values from the avrSWAP array: + + CALL CheckDLLReturnValues( p, m%dll_data, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Retrieve_avrSWAP( p, m%dll_data, ErrStat2, ErrMsg2 ) - IF ( ErrStat2 /= ErrID_None ) THEN - IF ( ErrStat /= ErrID_None ) ErrMsg = TRIM(ErrMsg)//NewLine - ErrMsg = TRIM(ErrMsg)//TRIM(ErrMsg2) - ErrStat = MAX(ErrStat, ErrStat2) - IF ( ErrStat >= AbortErrLev ) RETURN - END IF - - -END SUBROUTINE BladedInterface_CalcOutput +END SUBROUTINE BladedInterface_CalcOutput !================================================================================================================================== !> This routine fills the avrSWAP array with its inputs, as described in Appendices A and B of the Bladed User Manual of Bladed !! version 3.81. @@ -443,66 +728,48 @@ SUBROUTINE Fill_avrSWAP( t, u, p, ErrMsgSz, dll_data ) TYPE(SrvD_InputType), INTENT(IN ) :: u !< Inputs at t TYPE(SrvD_ParameterType), INTENT(IN ) :: p !< Parameters INTEGER(IntKi), INTENT(IN ) :: ErrMsgSz !< Allowed size of the DLL-returned error message (-) -! REAL(SiKi), INTENT(INOUT) :: avrSWAP(:) ! the SWAP array for the Bladed DLL Interface TYPE(BladedDLLType), INTENT(INOUT) :: dll_data !< data for the Bladed DLL ! local variables: INTEGER(IntKi) :: I ! Loop counter - - !! Set the values of the avrSWAP array that vary during a simulation - - !IF ( StatFlag == 0 ) ! Initialization flag - ! avrSWAP = 0.0 - ! - ! - ! - !ELSE - + !> The following are values ServoDyn sends to the Bladed DLL. !! For variables returned from the DLL, see bladedinterface::retrieve_avrswap. - !dll_data%avrSWAP( 1) = REAL(StatFlag, SiKi) + dll_data%avrSWAP( 1) = dll_data%SimStatus !> * Record 1: Status flag set as follows: 0 if this is the first call, 1 for all subsequent time steps, -1 if this is the final call at the end of the simulation (-) dll_data%avrSWAP( 2) = REAL(t, SiKi) !> * Record 2: Current time (sec) [t in single precision] - dll_data%avrSWAP( 3) = p%DLL_DT !> * Record 3: Communication interval (sec) [in FAST v7 this was \f$ y\_SrvD\%AllOuts(Time) - LastTime \f$, but is now the SrvD DLL_DT parameter] + dll_data%avrSWAP( 3) = dll_data%DLL_DT !> * Record 3: Communication interval (sec) [in FAST v7 this was \f$ y\_SrvD\%AllOuts(Time) - LastTime \f$, but is now the SrvD DLL_DT parameter] dll_data%avrSWAP( 4) = u%BlPitch(1) !> * Record 4: Blade 1 pitch angle (rad) [SrvD input] - dll_data%avrSWAP( 5) = p%Ptch_SetPnt !> * Record 5: Below-rated pitch angle set-point (rad) [SrvD Ptch_SetPnt parameter] - dll_data%avrSWAP( 6) = p%Ptch_Min !> * Record 6: Minimum pitch angle (rad) [SrvD Ptch_Min parameter] - dll_data%avrSWAP( 7) = p%Ptch_Max !> * Record 7: Maximum pitch angle (rad) [SrvD Ptch_Max parameter] - dll_data%avrSWAP( 8) = p%PtchRate_Min !> * Record 8: Minimum pitch rate (most negative value allowed) (rad/s) [SrvD PtchRate_Min parameter] - dll_data%avrSWAP( 9) = p%PtchRate_Max !> * Record 9: Maximum pitch rate (rad/s) [SrvD PtchRate_Max parameter] + dll_data%avrSWAP( 5) = dll_data%Ptch_SetPnt !> * Record 5: Below-rated pitch angle set-point (rad) [SrvD Ptch_SetPnt parameter] + dll_data%avrSWAP( 6) = dll_data%Ptch_Min !> * Record 6: Minimum pitch angle (rad) [SrvD Ptch_Min parameter] + dll_data%avrSWAP( 7) = dll_data%Ptch_Max !> * Record 7: Maximum pitch angle (rad) [SrvD Ptch_Max parameter] + dll_data%avrSWAP( 8) = dll_data%PtchRate_Min !> * Record 8: Minimum pitch rate (most negative value allowed) (rad/s) [SrvD PtchRate_Min parameter] + dll_data%avrSWAP( 9) = dll_data%PtchRate_Max !> * Record 9: Maximum pitch rate (rad/s) [SrvD PtchRate_Max parameter] dll_data%avrSWAP(10) = 0.0 !> * Record 10: 0 = pitch position actuator, 1 = pitch rate actuator (-) [must be 0 for ServoDyn] -!bjj: record 11 technically needs the old demanded values (currently equivalent to this quantity) -! dll_data%avrSWAP(11) = u%BlPitch(1) ! Current demanded pitch angle (rad) -- I am sending the value for blade 1, in the absence of any more information provided in Bladed documentation - dll_data%avrSWAP(11) = dll_data%PrevBlPitch(1) !> * Record 11: Current demanded pitch angle (rad) [I am sending the previous value for blade 1 from the DLL, in the absence of any more information provided in Bladed documentation] + dll_data%avrSWAP(11) = dll_data%BlPitchCom(1) !> * Record 11: Current demanded pitch angle (rad) [I am sending the previous value for blade 1 from the DLL, in the absence of any more information provided in Bladed documentation] dll_data%avrSWAP(12) = 0.0 !> * Record 12: Current demanded pitch rate (rad/s) [always zero for ServoDyn] - dll_data%avrSWAP(13) = p%GenPwr_Dem !> * Record 13: Demanded power (W) [SrvD GenPwr_Dem parameter] + dll_data%avrSWAP(13) = dll_data%GenPwr_Dem !> * Record 13: Demanded power (W) [SrvD GenPwr_Dem parameter from input file] dll_data%avrSWAP(14) = u%RotPwr !> * Record 14: Measured shaft power (W) [SrvD input] - dll_data%avrSWAP(15) = u%ElecPwr_prev !> * Record 15: Measured electrical power output (W) [SrvD input from previous step output; technically should be a state] - !> * Record 16: Optimal mode gain (Nm/(rad/s)^2) [if torque-speed table look-up not selected in input file, use SrvD Gain_OM parameter, otherwise use 0] - IF ( p%DLL_NumTrq == 0 ) THEN ! Torque-speed table look-up not selected - dll_data%avrSWAP(16) = p%Gain_OM ! Optimal mode gain (Nm/(rad/s)^2) - ELSE ! Torque-speed table look-up selected - dll_data%avrSWAP(16) = 0.0 ! Optimal mode gain (Nm/(rad/s)^2) -- 0.0 indicates that torque-speed table look-up is selected - ENDIF - dll_data%avrSWAP(17) = p%GenSpd_MinOM !> * Record 17: Minimum generator speed (rad/s) [SrvD GenSpd_MinOM parameter] - dll_data%avrSWAP(18) = p%GenSpd_MaxOM !> * Record 18: Optimal mode maximum speed (rad/s) [SrvD GenSpd_MaxOMp arameter] - dll_data%avrSWAP(19) = p%GenSpd_Dem !> * Record 19: Demanded generator speed above rated (rad/s) [SrvD GenSpd_Dem parameter] + dll_data%avrSWAP(15) = dll_data%ElecPwr_prev !> * Record 15: Measured electrical power output (W) [SrvD calculation from previous step; should technically be a state] + dll_data%avrSWAP(16) = dll_data%Gain_OM !> * Record 16: Optimal mode gain (Nm/(rad/s)^2) [if torque-speed table look-up not selected in input file, use SrvD Gain_OM parameter, otherwise use 0 (already overwritten in Init routine)] + dll_data%avrSWAP(17) = dll_data%GenSpd_MinOM !> * Record 17: Minimum generator speed (rad/s) [SrvD GenSpd_MinOM parameter] + dll_data%avrSWAP(18) = dll_data%GenSpd_MaxOM !> * Record 18: Optimal mode maximum speed (rad/s) [SrvD GenSpd_MaxOMp arameter] + dll_data%avrSWAP(19) = dll_data%GenSpd_Dem !> * Record 19: Demanded generator speed above rated (rad/s) [SrvD GenSpd_Dem parameter] dll_data%avrSWAP(20) = u%HSS_Spd !> * Record 20: Measured generator speed (rad/s) [SrvD input] dll_data%avrSWAP(21) = u%RotSpeed !> * Record 21: Measured rotor speed (rad/s) [SrvD input] - dll_data%avrSWAP(22) = p%GenTrq_Dem !> * Record 22: Demanded generator torque (Nm) [SrvD GenTrq_Dem parameter] + dll_data%avrSWAP(22) = dll_data%GenTrq_Dem !> * Record 22: Demanded generator torque above rated (Nm) [SrvD GenTrq_Dem parameter from input file] !bjj: this assumes it is the value at the previous step; but we actually want the output GenTrq... - dll_data%avrSWAP(23) = u%GenTrq_prev !> * Record 23: Measured generator torque (Nm) [SrvD input from previous step output; should technically be a state] + dll_data%avrSWAP(23) = dll_data%GenTrq_prev !> * Record 23: Measured generator torque (Nm) [SrvD calculation from previous step; should technically be a state] dll_data%avrSWAP(24) = u%YawErr !> * Record 24: Measured yaw error (rad) [SrvD input] - IF ( p%DLL_NumTrq == 0 ) THEN ! Torque-speed table look-up not selected + IF ( dll_data%DLL_NumTrq == 0 ) THEN ! Torque-speed table look-up not selected dll_data%avrSWAP(25) = 0.0 ! Start of below-rated torque-speed look-up table (record no.) -- 0.0 indicates that torque-speed table look-up is not selected - dll_data%avrSWAP(26) = 0.0 ! No. of points in torque-speed look-up table (-) -- 0.0 indicates that torque-speed table look-up is not selected ELSE ! Torque-speed table look-up selected dll_data%avrSWAP(25) = R !> * Record 25: Start of below-rated torque-speed look-up table (record no.) [parameter \f$R\f$ (bladedinterface::r) or 0 if DLL_NumTrq == 0] - dll_data%avrSWAP(26) = p%DLL_NumTrq !> * Record 26: No. of points in torque-speed look-up table (-) [SrvD DLL_NumTrq parameter] ENDIF + dll_data%avrSWAP(26) = dll_data%DLL_NumTrq !> * Record 26: No. of points in torque-speed look-up table (-) [SrvD DLL_NumTrq parameter] dll_data%avrSWAP(27) = u%HorWindV !> * Record 27: Hub wind speed (m/s) [SrvD input] - dll_data%avrSWAP(28) = p%Ptch_Cntrl !> * Record 28: Pitch control: 0 = collective, 1 = individual (-) [SrvD Ptch_Cntrl parameter] - dll_data%avrSWAP(29) = 0.0 !> * Record 29: Yaw control: 0 = yaw rate control, 1 = yaw torque control (-) [must be 0 for ServoDyn] + dll_data%avrSWAP(28) = dll_data%Ptch_Cntrl !> * Record 28: Pitch control: 0 = collective, 1 = individual (-) [SrvD Ptch_Cntrl parameter] + dll_data%avrSWAP(29) = dll_data%Yaw_Cntrl !> * Record 29: Yaw control: 0 = yaw rate control, 1 = yaw torque control (-) [must be 0 for ServoDyn] !^^^ bjj: maybe torque control can be used in ServoDyn? can we specifiy yaw torque control? dll_data%avrSWAP(30) = u%RootMyc(1) !> * Record 30: Blade 1 root out-of-plane bending moment (Nm) [SrvD input] dll_data%avrSWAP(31) = u%RootMyc(2) !> * Record 31: Blade 2 root out-of-plane bending moment (Nm) [SrvD input] @@ -510,23 +777,25 @@ SUBROUTINE Fill_avrSWAP( t, u, p, ErrMsgSz, dll_data ) dll_data%avrSWAP(33) = u%BlPitch(2) !> * Record 33: Blade 2 pitch angle (rad) [SrvD input] IF ( p%NumBl > 2 ) THEN dll_data%avrSWAP(34) = u%BlPitch(3) !> * Record 34: Blade 3 pitch angle (rad) [SrvD input] +! dll_data%avrSWAP(34) = u%BlPitch(3) !> * Record 34: Blade 3 pitch angle (rad) [SrvD input] END IF dll_data%avrSWAP(35) = dll_data%GenState !> * Record 35: Generator contactor (-) [GenState from previous call to DLL (initialized to 1)] - dll_data%avrSWAP(36) = dll_data%HSSBrFrac !> * Record 36: Shaft brake status: 0 = off, 1 = on (full) (-) [HSSBrFrac from previous call to DLL (initialized to 0)] +! record 36 is initialized to 0 (brake off); then we will keep the brake status set in previous call to DLL +! dll_data%avrSWAP(36) = dll_data%HSSBrFrac !> * Record 36: Shaft brake status: 0 = off, 1 = on (full), 16 = Get brake torque from record 107 (-) [HSSBrFrac from previous call to DLL (initialized to 0)] dll_data%avrSWAP(37) = u%YawAngle - p%NacYaw_North !> * Record 37: Nacelle yaw angle from North (rad) [ \f$ u\%YawAngle - p\%NacYaw\_North \f$ ] ! Records 38-48 are outputs [see Retrieve_avrSWAP()] - dll_data%avrSWAP(49) = REAL( ErrMsgSz ) + 1 !> * Record 49: Maximum number of characters in the "MESSAGE" argument (-) [size of ErrMsg argument plus 1 (we add one for the C NULL CHARACTER)] - dll_data%avrSWAP(50) = REAL( LEN_TRIM(p%DLL_InFile) ) +1 !> * Record 50: Number of characters in the "INFILE" argument (-) [trimmed length of DLL_InFile parameter plus 1 (we add one for the C NULL CHARACTER)] - dll_data%avrSWAP(51) = REAL( LEN_TRIM(p%RootName) ) +1 !> * Record 51: Number of characters in the "OUTNAME" argument (-) [trimmed length of RootName parameter plus 1 (we add one for the C NULL CHARACTER)] + dll_data%avrSWAP(49) = ErrMsgSz + 1 !> * Record 49: Maximum number of characters in the "MESSAGE" argument (-) [size of ErrMsg argument plus 1 (we add one for the C NULL CHARACTER)] + dll_data%avrSWAP(50) = LEN_TRIM(dll_data%DLL_InFile) +1 !> * Record 50: Number of characters in the "INFILE" argument (-) [trimmed length of DLL_InFile parameter plus 1 (we add one for the C NULL CHARACTER)] + dll_data%avrSWAP(51) = LEN_TRIM(dll_data%RootName) +1 !> * Record 51: Number of characters in the "OUTNAME" argument (-) [trimmed length of RootName parameter plus 1 (we add one for the C NULL CHARACTER)] ! Record 52 is reserved for future use ! DLL interface version number (-) dll_data%avrSWAP(53) = u%YawBrTAxp !> * Record 53: Tower top fore-aft acceleration (m/s^2) [SrvD input] dll_data%avrSWAP(54) = u%YawBrTAyp !> * Record 54: Tower top side-to-side acceleration (m/s^2) [SrvD input] ! Records 55-59 are outputs [see Retrieve_avrSWAP()] dll_data%avrSWAP(60) = u%LSSTipPxa !> * Record 60: Rotor azimuth angle (rad) [SrvD input] dll_data%avrSWAP(61) = p%NumBl !> * Record 61: Number of blades (-) [SrvD NumBl parameter] - dll_data%avrSWAP(62) = 0.0 !> * Record 62: Maximum number of values which can be returned for logging (-) [currently set to 0] - dll_data%avrSWAP(63) = 0.0 !> * Record 63: Record number for start of logging output (-) [currently set to 0] - dll_data%avrSWAP(64) = 0.0 !> * Record 64: Maximum number of characters which can be returned in "OUTNAME" (-) [currently set to 0] + dll_data%avrSWAP(62) = MaxLoggingChannels !> * Record 62: Maximum number of values which can be returned for logging (-) [set to parameter bladedinterface::maxloggingchannels] + dll_data%avrSWAP(63) = R + (2*dll_data%DLL_NumTrq) !> * Record 63: Record number for start of logging output (-) [set to R + (2*p\%DLL_NumTrq)] + dll_data%avrSWAP(64) = p%avcOUTNAME_LEN !> * Record 64: Maximum number of characters which can be returned in "OUTNAME" (-) [set to bladedinterface::MaxLoggingChannels * (2+nwtc_base::chanlen) + 1 (we add one for the C NULL CHARACTER)] ! Record 65 is output [see Retrieve_avrSWAP()] ! Records 66-68 are reserved @@ -565,9 +834,9 @@ SUBROUTINE Fill_avrSWAP( t, u, p, ErrMsgSz, dll_data ) dll_data%avrSWAP(117) = 0 !> * Record 117: Controller state [always set to 0] !> * Records \f$R\f$ through \f$R + 2*DLL\_NumTrq - 1\f$: torque-speed look-up table elements. - DO I = 1,p%DLL_NumTrq ! Loop through all torque-speed look-up table elements - dll_data%avrSWAP( R + (2*I) - 2 ) = p%GenSpd_TLU(I) !> + Records \f$R, R+2, R+4, \dots, R + 2*DLL\_NumTrq - 2\f$: Generator speed look-up table elements (rad/s) - dll_data%avrSWAP( R + (2*I) - 1 ) = p%GenTrq_TLU(I) !> + Records \f$R+1, R+3, R+5, \dots, R + 2*DLL\_NumTrq - 1\f$: Generator torque look-up table elements (Nm) + DO I = 1,dll_data%DLL_NumTrq ! Loop through all torque-speed look-up table elements + dll_data%avrSWAP( R + (2*I) - 2 ) = dll_data%GenSpd_TLU(I) !> + Records \f$R, R+2, R+4, \dots, R + 2*DLL\_NumTrq - 2\f$: Generator speed look-up table elements (rad/s) + dll_data%avrSWAP( R + (2*I) - 1 ) = dll_data%GenTrq_TLU(I) !> + Records \f$R+1, R+3, R+5, \dots, R + 2*DLL\_NumTrq - 1\f$: Generator torque look-up table elements (Nm) ENDDO @@ -580,6 +849,73 @@ SUBROUTINE Fill_avrSWAP( t, u, p, ErrMsgSz, dll_data ) RETURN END SUBROUTINE Fill_avrSWAP +!================================================================================================================================== +!> This routine fills the dll_data variables that are used in the non-legacy version of the Bladed DLL interface with inputs, +!! as described in Appendices A and B of the Bladed User Manual of Bladed version 4.8. +SUBROUTINE Fill_CONTROL_vars( t, u, p, ErrMsgSz, dll_data ) + + REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds + TYPE(SrvD_InputType), INTENT(IN ) :: u !< Inputs at t + TYPE(SrvD_ParameterType), INTENT(IN ) :: p !< Parameters + INTEGER(IntKi), INTENT(IN ) :: ErrMsgSz !< Allowed size of the DLL-returned error message (-) +! REAL(SiKi), INTENT(INOUT) :: avrSWAP(:) ! the SWAP array for the Bladed DLL Interface + TYPE(BladedDLLType), INTENT(INOUT) :: dll_data !< data for the Bladed DLL + + ! local variables: + INTEGER(IntKi) :: i ! Loop counter + INTEGER(IntKi) :: j ! Loop counter + + if (dll_data%SimStatus == GH_DISCON_STATUS_INITIALISING) then + dll_data%avrSWAP = 0.0 + dll_data%NumLogChannels = 0 + + dll_data%GenState = 1 + dll_data%GenTrq = 0.0 + dll_data%YawRateCom = 0.0 + dll_data%HSSBrTrqDemand = 0.0 + dll_data%ShaftBrakeStatusBinaryFlag = 0 ! no brakes deployed + dll_data%HSSBrDeployed = .false. + + dll_data%PrevBlPitch(1:p%NumBl) = p%BlPitchInit + dll_data%BlPitchCom(1:p%NumBl) = p%BlPitchInit + end if + + call Fill_avrSWAP( t, u, p, ErrMsgSz, dll_data ) ! we'll set the avrSWAP variable, for the legacy version of the DLL, too. + + !> The following are values ServoDyn sends to the Bladed DLL. + !! For variables returned from the DLL, see bladedinterface::retrieve_control_vars. + + dll_data%ErrMsg = '' + dll_data%ErrStat = ErrID_None + dll_data%OverrideYawRateWithTorque = .false. + + dll_data%CurrentTime = t ! Current time (sec) + dll_data%BlPitchInput(1:p%NumBl) = u%BlPitch(1:p%NumBl) ! current blade pitch (input) + dll_data%YawAngleFromNorth = u%YawAngle - p%NacYaw_North ! Nacelle yaw angle from North (rad) + dll_data%HorWindV = u%HorWindV ! Hub wind speed (m/s) + dll_data%HSS_Spd = u%HSS_Spd ! Measured generator speed (rad/s) + dll_data%YawErr = u%YawErr ! Measured yaw error (rad) + dll_data%RotSpeed = u%RotSpeed ! Measured rotor speed (rad/s) + dll_data%YawBrTAxp = u%YawBrTAxp ! Tower top fore-aft acceleration (m/s^2) + dll_data%YawBrTAyp = u%YawBrTAyp ! Tower top side-to-side acceleration (m/s^2) + dll_data%LSSTipMys = u%LSSTipMys ! Fixed hub My (GL co-ords) (Nm) + dll_data%LSSTipMzs = u%LSSTipMzs ! Fixed hub Mz (GL co-ords) (Nm) + dll_data%LSSTipPxa = u%LSSTipPxa ! Rotor azimuth angle (rad) + dll_data%Yaw = u%Yaw ! Current nacelle yaw (angular position) (rad) NEW TO DLL!!! + dll_data%YawRate = u%YawRate ! Current nacelle yaw rate (angular velocity) (rad/s) NEW TO DLL!!! + dll_data%LSSTipMya = u%LSSTipMya ! Rotating hub My (GL co-ords) (Nm) + dll_data%LSSTipMza = u%LSSTipMza ! Rotating hub Mz (GL co-ords) (Nm) + dll_data%YawBrMyn = u%YawBrMyn ! Yaw bearing My (GL co-ords) (Nm) + dll_data%YawBrMzn = u%YawBrMzn ! Yaw bearing Mz (GL co-ords) (Nm) + dll_data%RotPwr = u%RotPwr ! Measured shaft power (W) [SrvD input] + dll_data%NcIMURAxs = u%NcIMURAxs ! Nacelle roll acceleration (rad/s^2) -- this is in the shaft (tilted) coordinate system, instead of the nacelle (nontilted) coordinate system + dll_data%NcIMURAys = u%NcIMURAys ! Nacelle nodding acceleration (rad/s^2) + dll_data%NcIMURAzs = u%NcIMURAzs ! Nacelle yaw acceleration (rad/s^2) -- this is in the shaft (tilted) coordinate system, instead of the nacelle (nontilted) coordinate system + dll_data%LSSTipMxa = u%LSSTipMxa ! Shaft torque (=hub Mx for clockwise rotor) (Nm) + dll_data%RootMyc = u%RootMyc ! Blade root out-of-plane bending moment (Nm) [SrvD input] + dll_data%RootMxc = u%RootMxc ! Blade root in-plane bending moment (Nm) [SrvD input] + +END SUBROUTINE Fill_CONTROL_vars !================================================================================================================================== !> This routine retrieves the DLL return values from the avrSWAP array, as described in Appendices A and B of the Bladed User !! Manual of Bladed version 3.81. @@ -594,6 +930,7 @@ SUBROUTINE Retrieve_avrSWAP( p, dll_data, ErrStat, ErrMsg ) ! local variables: INTEGER(IntKi) :: K ! Loop counter + CHARACTER(*), PARAMETER :: RoutineName = 'Retrieve_avrSWAP' ! Initialize ErrStat and ErrMsg @@ -611,44 +948,23 @@ SUBROUTINE Retrieve_avrSWAP( p, dll_data, ErrStat, ErrMsg ) !> * Record 35: Generator contactor (-) [sent to DLL at the next call] dll_data%GenState = NINT( dll_data%avrSWAP(35) ) ! Generator contactor (-) - IF ( ( dll_data%GenState /= 0_IntKi ) .AND. ( dll_data%GenState /= 1_IntKi ) ) THEN - - ! Generator contactor indicates something other than off or main; abort program - - IF ( ErrStat /= ErrID_None ) ErrMsg = TRIM(ErrMsg)//NewLine - ErrMsg = TRIM(ErrMsg)//'Only off and main generators supported in '//TRIM( GetNVD( BladedInterface_Ver ) )// & - '. Set avrSWAP(35) to 0 or 1 in '//TRIM(p%DLL_Trgt%FileName)//'.' - ErrStat = ErrID_Fatal - - END IF - !> * Record 36: Shaft brake status (-) [sent to DLL at the next call; anything other than 0 or 1 is an error] - dll_data%HSSBrFrac = dll_data%avrSWAP(36) ! Shaft brake status (-) + !dll_data%HSSBrFrac = dll_data%avrSWAP(36) ! Shaft brake status (-) + dll_data%ShaftBrakeStatusBinaryFlag = NINT(dll_data%avrSWAP(36)) - IF ( ( .NOT. EqualRealNos(dll_data%HSSBrFrac, 0.0_ReKi) ) .AND. & - ( .NOT. EqualRealNos(dll_data%HSSBrFrac, 1.0_ReKi) ) ) THEN - - ! Shaft brake status specified incorrectly; abort program - - IF ( ErrStat /= ErrID_None ) ErrMsg = TRIM(ErrMsg)//NewLine - ErrMsg = TRIM(ErrMsg)//'Shaft brake status improperly set in '//TRIM( GetNVD( BladedInterface_Ver ) )//& - '. Set avrSWAP(36) to 0 or 1 in '//TRIM(p%DLL_Trgt%FileName)//'.' - ErrStat = ErrID_Fatal - - END IF - !! Records 38-40 are reserved !> * Record 41: demanded yaw actuator torque [this output is ignored since record 29 is set to 0 by ServoDyn indicating yaw rate control] + dll_data%YawTorqueDemand = dll_data%avrSWAP(41) ! Records 42-46: demanded pitch positions or rates - IF ( p%Ptch_Cntrl /= 0_IntKi ) THEN ! Individual pitch control (p%Ptch_Cntrl == 1) + IF ( dll_data%Ptch_Cntrl == GH_DISCON_PITCH_CONTROL_INDIVIDUAL ) THEN ! Individual pitch control (p%Ptch_Cntrl == 1) !> * Records 42-44: Demanded Individual Pitch position (rad) (or pitch rate [rad/s]) DO K = 1,p%NumBl ! Loop through all blades avrSWAP(42), avrSWAP(43), and, if NumBl = 3, avrSWAP(44) dll_data%BlPitchCom(K) = dll_data%avrSWAP( 41 + K ) ! Demanded individual pitch position of blade K (rad) ENDDO ! K - blades - ELSE !IF ( p%Ptch_Cntrl == 0_IntKi ) THEN ! Collective pitch control + ELSE !IF ( p%Ptch_Cntrl == GH_DISCON_PITCH_CONTROL_COLLECTIVE ) THEN ! Collective pitch control !> * Record 45: Demanded pitch angle (Collective pitch) (rad) dll_data%BlPitchCom = dll_data%avrSWAP(45) ! Demanded pitch angle (Collective pitch) (rad) @@ -662,39 +978,30 @@ SUBROUTINE Retrieve_avrSWAP( p, dll_data, ErrStat, ErrMsg ) !> * Record 55: Pitch override [anything other than 0 is an error in ServoDyn] IF ( NINT( dll_data%avrSWAP(55) ) /= 0 ) THEN - ! Pitch override requested by DLL; abort program - - IF ( ErrStat /= ErrID_None ) ErrMsg = TRIM(ErrMsg)//NewLine - ErrMsg = TRIM(ErrMsg)//'Built-in pitch unsupported in '//TRIM( GetNVD( BladedInterface_Ver ) )//& - '. Set avrSWAP(55) to 0 in '//TRIM(p%DLL_Trgt%FileName)//'.' - ErrStat = ErrID_Fatal + CALL SetErrStat( ErrID_Severe, 'Built-in pitch override unsupported. Set avrSWAP(55) to 0 in '// & + TRIM(p%DLL_Trgt%FileName)//'.', ErrStat, ErrMsg, RoutineName) + END IF - + !> * Record 56: Torque override IF ( NINT( dll_data%avrSWAP(56) ) /= 0 ) THEN - ! Torque override requested by DLL; abort program - - IF ( ErrStat /= ErrID_None ) ErrMsg = TRIM(ErrMsg)//NewLine - ErrMsg = TRIM(ErrMsg)//'Built-in torque unsupported in '//TRIM( GetNVD( BladedInterface_Ver ) )//& - '. Set avrSWAP(56) to 0 in '//TRIM(p%DLL_Trgt%FileName)//'.' - ErrStat = ErrID_Fatal + CALL SetErrStat( ErrID_Severe, 'Built-in torque override unsupported. Set avrSWAP(56) to 0 in '// & + TRIM(p%DLL_Trgt%FileName)//'.', ErrStat, ErrMsg, RoutineName) + END IF !! Records 57-59 are reserved -!> * Record 65: Number of variables returned for logging [anything other than 0 is an error] - IF ( NINT( dll_data%avrSWAP(65) ) /= 0 ) THEN +!> * Record 65: Number of variables returned for logging [anything greater than MaxLoggingChannels is an error] + IF ( NINT( dll_data%avrSWAP(65) ) > MaxLoggingChannels ) THEN ! Return variables for logging requested by DLL; abort program - - IF ( ErrStat /= ErrID_None ) ErrMsg = TRIM(ErrMsg)//NewLine - ErrMsg = TRIM(ErrMsg)//'Return variables unsupported in '//TRIM( GetNVD( BladedInterface_Ver ) )//& - '. Set avrSWAP(65) to 0 in '//TRIM(p%DLL_Trgt%FileName)//'.' - ErrStat = ErrID_Fatal + CALL SetErrStat( ErrID_Fatal, 'Return variables exceed maximum number allowed. Set avrSWAP(65) to a number no larger than '// & + trim(num2lstr(MaxLoggingChannels))//' in '//TRIM(p%DLL_Trgt%FileName)//'.', ErrStat, ErrMsg, RoutineName) ENDIF @@ -707,19 +1014,100 @@ SUBROUTINE Retrieve_avrSWAP( p, dll_data, ErrStat, ErrMsg ) !> * Record 98: Safety system number to activate; not used in ServoDyn !> * Records 102-104: Yaw control/stiffness/damping; ignored in ServoDyn - -!> * Record 107: Brake torque demand - dll_data%HSSBrTrqC = dll_data%avrSWAP(107) - + if (dll_data%avrSWAP(102)==4) then + dll_data%OverrideYawRateWithTorque = .true. + elseif (dll_data%avrSWAP(102)==0) then + dll_data%OverrideYawRateWithTorque = .false. + else + dll_data%OverrideYawRateWithTorque = .false. + CALL SetErrStat( ErrID_Severe, 'Invalid yaw control flag. Set avrSWAP(102) to 0 or 4 in '// & + TRIM(p%DLL_Trgt%FileName)//'.', ErrStat, ErrMsg, RoutineName) + end if + +!> * Record 107: Brake torque demand (used only when avrSWAP(36) is 16) + if (dll_data%ShaftBrakeStatusBinaryFlag == 16) then + dll_data%HSSBrTrqDemand = dll_data%avrSWAP(107) + end if + !> * Record 108: Yaw brake torque demand; ignored in ServoDyn !> * Records 120-129: User-defined variables 1-10; ignored in ServoDyn !> * Records 130-142: Reserved -!> * L1: variables for logging output; not yet implemented in ServoDyn +!> * L1: variables for logging output; + + do k=1,p%NumOuts_DLL + dll_data%LogChannels(k) = dll_data%avrSWAP( NINT(dll_data%avrSWAP(63))+k-1 ) + end do END SUBROUTINE Retrieve_avrSWAP !================================================================================================================================== +!> This routine checks that the values returned to FAST from the controller DLL (from either version of the interface) are valid +SUBROUTINE CheckDLLReturnValues( p, dll_data, ErrStat, ErrMsg ) + + TYPE(SrvD_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(BladedDLLType), INTENT(INOUT) :: dll_data !< data for the Bladed DLL + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + CHARACTER(*), PARAMETER :: RoutineName = 'CheckDLLReturnValues' + + ! Initialize ErrStat and ErrMsg + ErrStat = ErrID_None + ErrMsg = '' + + if (p%UseLegacyInterface) then + CALL Retrieve_avrSWAP( p, dll_data, ErrStat, ErrMsg ) + if (ErrStat >= AbortErrLev) return + end if + + + IF ( ( dll_data%GenState /= 0_IntKi ) .AND. ( dll_data%GenState /= 1_IntKi ) ) THEN + ! Generator contactor indicates something other than off or main; abort program + if (p%UseLegacyInterface) then + CALL SetErrStat( ErrID_Fatal, 'Only off and main generators supported. Set avrSWAP(35) to 0 or 1 in '//TRIM(p%DLL_Trgt%FileName)//'.', ErrStat, ErrMsg, RoutineName) + else + CALL SetErrStat( ErrID_Fatal, 'Only off and main generators supported. Call SetGeneratorContactor() with generator_contactor set to 0 or 1 in '// & + TRIM(p%DLL_Trgt%FileName)//'.', ErrStat, ErrMsg, RoutineName) + end if + END IF + + SELECT CASE (dll_data%ShaftBrakeStatusBinaryFlag) + CASE (0) + dll_data%HSSBrTrqDemand = 0.0_ReKi + dll_data%HSSBrDeployed = .false. + CASE (1) + if (.not. dll_data%HSSBrDeployed) then + dll_data%TimeHSSBrDeployed = dll_data%CurrentTime + dll_data%TimeHSSBrFullyDeployed = dll_data%TimeHSSBrDeployed + p%HSSBrDT + dll_data%HSSBrDeployed = .true. + dll_data%HSSBrTrqDemand = 0.0_ReKi + else + ! apply a linear ramp up to the maximum value + IF ( dll_data%CurrentTime < dll_data%TimeHSSBrFullyDeployed ) THEN + dll_data%HSSBrTrqDemand = ( dll_data%CurrentTime - dll_data%TimeHSSBrDeployed )/p%HSSBrDT * p%HSSBrTqF + ELSE ! Full braking torque + dll_data%HSSBrTrqDemand = p%HSSBrTqF + ENDIF + end if + CASE (16) + dll_data%HSSBrDeployed = .false. + ! do we need to check that dll_data%HSSBrTrqDemand is set properly???? + CASE DEFAULT + dll_data%HSSBrDeployed = .false. + + ! Fatal issue: shaft brake status specified incorrectly + if (p%UseLegacyInterface) then + CALL SetErrStat( ErrID_Fatal, 'Shaft brake status set improperly. Set avrSWAP(36) to 0, 1, or 16 in '// & + TRIM(p%DLL_Trgt%FileName)//'.', ErrStat, ErrMsg, RoutineName) + else + CALL SetErrStat( ErrID_Fatal, 'Shaft brake status set improperly. Call SetShaftBrakeStatusBinaryFlag() with binary_brake_status set to 0 or 1 in '// & + TRIM(p%DLL_Trgt%FileName)//'.', ErrStat, ErrMsg, RoutineName) + end if + END SELECT + +END SUBROUTINE CheckDLLReturnValues +!================================================================================================================================== END MODULE BladedInterface diff --git a/modules/servodyn/src/ServoDyn.f90 b/modules/servodyn/src/ServoDyn.f90 index 6877c4cb7e..bcf72c0a97 100644 --- a/modules/servodyn/src/ServoDyn.f90 +++ b/modules/servodyn/src/ServoDyn.f90 @@ -52,11 +52,11 @@ MODULE ServoDyn INTEGER, PARAMETER :: Indx_u_YawRate = 2 INTEGER, PARAMETER :: Indx_u_HSS_Spd = 3 - INTEGER, PARAMETER :: Indx_Y_BlPitchCom(3) = (/1,2,3/) - INTEGER, PARAMETER :: Indx_Y_YawMom = 4 - INTEGER, PARAMETER :: Indx_Y_GenTrq = 5 - INTEGER, PARAMETER :: Indx_Y_ElecPwr = 6 - INTEGER, PARAMETER :: Indx_Y_WrOutput = 6 ! last non-writeoutput variable + INTEGER, PARAMETER, PUBLIC :: SrvD_Indx_Y_BlPitchCom(3) = (/1,2,3/) + INTEGER, PARAMETER, PUBLIC :: SrvD_Indx_Y_YawMom = 4 + INTEGER, PARAMETER, PUBLIC :: SrvD_Indx_Y_GenTrq = 5 + INTEGER, PARAMETER, PUBLIC :: SrvD_Indx_Y_ElecPwr = 6 + INTEGER, PARAMETER, PUBLIC :: SrvD_Indx_Y_WrOutput = 6 ! last non-writeoutput variable ! =================================================================================================== ! NOTE: The following lines of code were generated by a Matlab script called "Write_ChckOutLst.m" @@ -139,6 +139,10 @@ MODULE ServoDyn INTEGER(IntKi), PARAMETER :: ControlMode_EXTERN = 4 !< The (ServoDyn-universal) control code for obtaining the control values from Simulink or Labivew INTEGER(IntKi), PARAMETER :: ControlMode_DLL = 5 !< The (ServoDyn-universal) control code for obtaining the control values from a Bladed-Style dynamic-link library + INTEGER(IntKi), PARAMETER, PUBLIC :: TrimCase_none = 0 + INTEGER(IntKi), PARAMETER, PUBLIC :: TrimCase_yaw = 1 + INTEGER(IntKi), PARAMETER, PUBLIC :: TrimCase_torque = 2 + INTEGER(IntKi), PARAMETER, PUBLIC :: TrimCase_pitch = 3 ! ..... Public Subroutines ................................................................................................... @@ -201,6 +205,7 @@ SUBROUTINE SrvD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitO TYPE(TMD_InitInputType) :: TMD_InitInp ! data to initialize TMD module TYPE(TMD_InitOutputType) :: TMD_InitOut ! data from TMD module initialization (not used) INTEGER(IntKi) :: i ! loop counter + INTEGER(IntKi) :: j ! loop counter INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None @@ -227,7 +232,7 @@ SUBROUTINE SrvD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitO p%RootName = InitInp%Rootname ! FAST adds the '.SrvD' before calling this module p%NumBl = InitInp%NumBl - CALL SrvD_ReadInput( InitInp%InputFile, InputFileData, Interval, p%RootName, ErrStat2, ErrMsg2 ) + CALL SrvD_ReadInput( InitInp, InputFileData, Interval, p%RootName, ErrStat2, ErrMsg2 ) CALL CheckError( ErrStat2, ErrMsg2 ) IF (ErrStat >= AbortErrLev) RETURN @@ -368,24 +373,12 @@ SUBROUTINE SrvD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitO u%RotPwr = 0. u%HorWindV = 0. u%YawAngle = 0. - u%ElecPwr_prev = 0. - u%GenTrq_prev = 0. + m%dll_data%ElecPwr_prev = 0. + m%dll_data%GenTrq_prev = 0. - ! These are values from previous step. I'll initialize them here, though the glue code may not use it. - ! @TODO: these need to be removed because they break the framework (though they're only for the Bladed-style - ! DLL which also breaks the frameowrk) - y%ElecPwr = u%ElecPwr_prev - y%GenTrq = u%GenTrq_prev - - !............................................................................................ ! Define system output initializations (set up mesh) here: !............................................................................................ - CALL AllocAry( y%WriteOutput, p%NumOuts, 'WriteOutput', ErrStat2, ErrMsg2 ) - CALL CheckError( ErrStat2, ErrMsg2 ) - IF (ErrStat >= AbortErrLev) RETURN - y%WriteOutput = 0 - CALL AllocAry( y%BlPitchCom, p%NumBl, 'BlPitchCom', ErrStat2, ErrMsg2 ) CALL CheckError( ErrStat2, ErrMsg2 ) IF (ErrStat >= AbortErrLev) RETURN @@ -404,34 +397,6 @@ SUBROUTINE SrvD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitO END IF - !............................................................................................ - ! Define initialization-routine output here: - !............................................................................................ - CALL AllocAry( InitOut%WriteOutputHdr, p%NumOuts, 'WriteOutputHdr', ErrStat2, ErrMsg2 ) - CALL CheckError( ErrStat2, ErrMsg2 ) - IF (ErrStat >= AbortErrLev) RETURN - CALL AllocAry( InitOut%WriteOutputUnt, p%NumOuts, 'WriteOutputUnt', ErrStat2, ErrMsg2 ) - CALL CheckError( ErrStat2, ErrMsg2 ) - IF (ErrStat >= AbortErrLev) RETURN - - do i=1,p%NumOuts - InitOut%WriteOutputHdr(i) = p%OutParam(i)%Name - InitOut%WriteOutputUnt(i) = p%OutParam(i)%Units - end do - - - InitOut%Ver = SrvD_Ver - - InitOut%UseHSSBrake = p%HSSBrMode /= ControlMode_None .AND. p%THSSBrDp < InitInp%TMax - - IF ( p%UseBladedInterface .OR. InitOut%UseHSSBrake ) THEN - InitOut%CouplingScheme = ExplicitLoose - ! CALL CheckError( ErrID_Info, 'The external dynamic-link library option being used in ServoDyn '& - ! //'requires an explicit-loose coupling scheme.' ) - ELSE - InitOut%CouplingScheme = ExplicitLoose - END IF - !............................................................................................ ! tip brakes - this may be added back, later, so we'll keep these here for now !............................................................................................ @@ -467,18 +432,19 @@ SUBROUTINE SrvD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitO IF ( p%UseBladedInterface ) THEN - p%AirDens = InitInp%AirDens + p%AirDens = InitInp%AirDens p%AvgWindSpeed = InitInp%AvgWindSpeed - CALL BladedInterface_Init(u, p, m, y, InputFileData, ErrStat2, ErrMsg2 ) + CALL BladedInterface_Init(u, p, m, y, InputFileData, InitInp, ErrStat2, ErrMsg2 ) CALL CheckError( ErrStat2, ErrMsg2 ) IF (ErrStat >= AbortErrLev) RETURN - m%LastTimeCalled = - p%DLL_DT ! we'll initialize the last time the DLL was called as -1 DLL_DT. + m%LastTimeCalled = - m%dll_data%DLL_DT ! we'll initialize the last time the DLL was called as -1 DLL_DT. m%LastTimeFiltered = - p%DT ! we'll initialize the last time the DLL was filtered as -1 DT. m%FirstWarn = .TRUE. - ELSE + m%dll_data%DLL_DT = p%DT ! DLL_DT is used to compute the pitch rate and acceleration outputs + p%DLL_n = 1 ! Without a call to the DLL, update the history every time step p%DLL_Trgt%FileName = "" p%DLL_Trgt%ProcName = "" @@ -533,36 +499,40 @@ SUBROUTINE SrvD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitO !............................................................................................ ! Set Init outputs for linearization (after TMD, in case we ever add the TMD to the linearization features): !............................................................................................ - + xd%CtrlOffset = 0.0_ReKi ! initialize before first use with TrimCase in linearization + p%TrimCase = InitInp%TrimCase + p%TrimGain = InitInp%TrimGain + p%RotSpeedRef = InitInp%RotSpeedRef + if (InitInp%Linearize) then ! If the module does allow linearization, return the appropriate Jacobian row/column names here: ! Allocate and set these variables: InitOut%LinNames_y, InitOut%LinNames_x, InitOut%LinNames_xd, InitOut%LinNames_z, InitOut%LinNames_u - CALL AllocAry( InitOut%RotFrame_y, 6+p%NumOuts, 'RotFrame_y', ErrStat2, ErrMsg2 ) + CALL AllocAry( InitOut%RotFrame_y, SrvD_Indx_Y_WrOutput+p%NumOuts, 'RotFrame_y', ErrStat2, ErrMsg2 ) CALL CheckError( ErrStat2, ErrMsg2 ) IF (ErrStat >= AbortErrLev) RETURN - CALL AllocAry( InitOut%LinNames_y, 6+p%NumOuts, 'LinNames_y', ErrStat2, ErrMsg2 ) + CALL AllocAry( InitOut%LinNames_y, SrvD_Indx_Y_WrOutput+p%NumOuts, 'LinNames_y', ErrStat2, ErrMsg2 ) CALL CheckError( ErrStat2, ErrMsg2 ) IF (ErrStat >= AbortErrLev) RETURN - do i=1,size(Indx_Y_BlPitchCom) - InitOut%LinNames_y(Indx_Y_BlPitchCom(i)) = 'BlPitchCom('//trim(num2lstr(i))//'), rad' - InitOut%RotFrame_y(Indx_Y_BlPitchCom(i)) = .true. + do i=1,size(SrvD_Indx_Y_BlPitchCom) + InitOut%LinNames_y(SrvD_Indx_Y_BlPitchCom(i)) = 'BlPitchCom('//trim(num2lstr(i))//'), rad' + InitOut%RotFrame_y(SrvD_Indx_Y_BlPitchCom(i)) = .true. end do - InitOut%LinNames_y(Indx_Y_YawMom) = 'YawMom, Nm' - InitOut%RotFrame_y(Indx_Y_YawMom) = .false. + InitOut%LinNames_y(SrvD_Indx_Y_YawMom) = 'YawMom, Nm' + InitOut%RotFrame_y(SrvD_Indx_Y_YawMom) = .false. - InitOut%LinNames_y(Indx_Y_GenTrq) = 'GenTrq, Nm' - InitOut%RotFrame_y(Indx_Y_GenTrq) = .false. + InitOut%LinNames_y(SrvD_Indx_Y_GenTrq) = 'GenTrq, Nm' + InitOut%RotFrame_y(SrvD_Indx_Y_GenTrq) = .false. + + InitOut%LinNames_y(SrvD_Indx_Y_ElecPwr) = 'ElecPwr, W' + InitOut%RotFrame_y(SrvD_Indx_Y_ElecPwr) = .false. - InitOut%LinNames_y(Indx_Y_ElecPwr) = 'ElecPwr, W' - InitOut%RotFrame_y(Indx_Y_ElecPwr) = .false. - do i=1,p%NumOuts - InitOut%LinNames_y(i+Indx_Y_WrOutput) = trim(p%OutParam(i)%Name)//', '//p%OutParam(i)%Units - InitOut%RotFrame_y(i+Indx_Y_WrOutput) = ANY( p%OutParam(i)%Indx == BlPitchC ) ! the only WriteOutput values in the rotating frame are BlPitch commands + InitOut%LinNames_y(i+SrvD_Indx_Y_WrOutput) = trim(p%OutParam(i)%Name)//', '//p%OutParam(i)%Units + InitOut%RotFrame_y(i+SrvD_Indx_Y_WrOutput) = ANY( p%OutParam(i)%Indx == BlPitchC ) ! the only WriteOutput values in the rotating frame are BlPitch commands end do @@ -583,8 +553,52 @@ SUBROUTINE SrvD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitO InitOut%LinNames_u(Indx_u_HSS_Spd) = 'HSS_Spd, rad/s' InitOut%RotFrame_u = .false. ! none of these are in the rotating frame InitOut%IsLoad_u = .false. ! none of these linearization inputs are loads - + + else + + p%TrimCase = TrimCase_none + end if + + + !............................................................................................ + ! Define initialization-routine output here: + !............................................................................................ + CALL AllocAry( y%WriteOutput, p%NumOuts+p%NumOuts_DLL, 'WriteOutput', ErrStat2, ErrMsg2 ) + CALL CheckError( ErrStat2, ErrMsg2 ) + IF (ErrStat >= AbortErrLev) RETURN + y%WriteOutput = 0 + + CALL AllocAry( InitOut%WriteOutputHdr, p%NumOuts+p%NumOuts_DLL, 'WriteOutputHdr', ErrStat2, ErrMsg2 ) + CALL CheckError( ErrStat2, ErrMsg2 ) + IF (ErrStat >= AbortErrLev) RETURN + CALL AllocAry( InitOut%WriteOutputUnt, p%NumOuts+p%NumOuts_DLL, 'WriteOutputUnt', ErrStat2, ErrMsg2 ) + CALL CheckError( ErrStat2, ErrMsg2 ) + IF (ErrStat >= AbortErrLev) RETURN + + do i=1,p%NumOuts + InitOut%WriteOutputHdr(i) = p%OutParam(i)%Name + InitOut%WriteOutputUnt(i) = p%OutParam(i)%Units + end do + + j=p%NumOuts + do i=1,p%NumOuts_DLL + j = j + 1 + InitOut%WriteOutputHdr(j) = m%dll_data%LogChannels_OutParam(i)%Name + InitOut%WriteOutputUnt(j) = m%dll_data%LogChannels_OutParam(i)%Units + end do + + InitOut%Ver = SrvD_Ver + + InitOut%UseHSSBrake = (p%HSSBrMode /= ControlMode_None .AND. p%THSSBrDp < InitInp%TMax) .or. p%HSSBrMode == ControlMode_DLL + + IF ( p%UseBladedInterface .OR. InitOut%UseHSSBrake ) THEN + InitOut%CouplingScheme = ExplicitLoose + ! CALL CheckError( ErrID_Info, 'The external dynamic-link library option being used in ServoDyn '& + ! //'requires an explicit-loose coupling scheme.' ) + ELSE + InitOut%CouplingScheme = ExplicitLoose + END IF !............................................................................................ @@ -734,6 +748,9 @@ SUBROUTINE SrvD_UpdateStates( t, n, Inputs, InputTimes, p, x, xd, z, OtherState, INTEGER(IntKi) :: i ! loop counter INTEGER(IntKi) :: order TYPE(SrvD_InputType) :: u_interp ! interpolated input + ! Local variables: + REAL(ReKi) :: GenTrq !< generator torque + REAL(ReKi) :: ElecPwr !< electrical power INTEGER(IntKi) :: ErrStat2 ! Error status of the operation (occurs after initial error) @@ -807,28 +824,45 @@ SUBROUTINE SrvD_UpdateStates( t, n, Inputs, InputTimes, p, x, xd, z, OtherState, END IF - ! Get appropriate value of input for the filter in discrete states - ! this works only for the DLL at this point, so we're going to move it there>>>>>>>>>>>>>>> - - ! - !CALL SrvD_UpdateDiscState( t, u_interp, p, x, xd, z, OtherState, ErrStat2, ErrMsg2 ) - ! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< - !............................................................................................................................... - ! get inputs at t+dt: + ! get inputs at t: !............................................................................................................................... - t_next = t+p%dt - CALL SrvD_CopyInput( Inputs(1), u_interp, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (ErrStat >= AbortErrLev) THEN CALL Cleanup() RETURN END IF + + CALL SrvD_Input_ExtrapInterp( Inputs, InputTimes, u_interp, t, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + !............................................................................................................................... + ! update discrete states: + !............................................................................................................................... + ! 1. Get appropriate value of input for the filter in discrete states (this works only for the DLL at this point, so we're going to move it there) + ! 2. Update control offset for trim solutions + + CALL SrvD_UpdateDiscState( t, u_interp, p, x, xd, z, OtherState, m, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + !............................................................................................................................... + ! get inputs at t+dt: + !............................................................................................................................... + t_next = t+p%dt + CALL SrvD_Input_ExtrapInterp( Inputs, InputTimes, u_interp, t_next, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + IF (p%UseBladedInterface) THEN + CALL DLL_controller_call(t_next, u_interp, p, x, xd, z, OtherState, m, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + IF (ErrStat >= AbortErrLev) THEN + CALL Cleanup() + RETURN + END IF + END IF !............................................................................................................................... ! update remaining states to values at t+dt: @@ -851,6 +885,23 @@ SUBROUTINE SrvD_UpdateStates( t, n, Inputs, InputTimes, p, x, xd, z, OtherState, CALL TipBrake_UpdateStates( t_next, u_interp, p, x, xd, z, OtherState, m, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + + !................................................................... + ! Compute ElecPwr and GenTrq for controller (and DLL needs this saved): + !................................................................... + IF ( OtherState%GenOnLine .and. .not. OtherState%Off4Good ) THEN ! Generator is on line. + CALL CalculateTorque( t, u_interp, p, m, m%dll_data%GenTrq_prev, m%dll_data%ElecPwr_prev, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF (ErrStat >= AbortErrLev) THEN + CALL Cleanup() + RETURN + END IF + ELSE ! Generator is off line. + m%dll_data%GenTrq_prev = 0.0_ReKi + m%dll_data%ElecPwr_prev = 0.0_ReKi + ENDIF + !............................................................................................................................... CALL Cleanup() @@ -874,6 +925,61 @@ END SUBROUTINE Cleanup END SUBROUTINE SrvD_UpdateStates !---------------------------------------------------------------------------------------------------------------------------------- +!> Routine for deciding if Bladed-style DLL controller should be called +SUBROUTINE DLL_controller_call(t, u, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) +!.................................................................................................................................. + + REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds + TYPE(SrvD_InputType), INTENT(IN ) :: u !< Inputs at t + TYPE(SrvD_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(SrvD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at t + TYPE(SrvD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at t + TYPE(SrvD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t + TYPE(SrvD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at t + 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 + + + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'DLL_controller_call' + + + ! Initialize ErrStat + + ErrStat = ErrID_None + ErrMsg = "" + + ! we should be calling this routine ONLY when the following statement is true: + !IF ( p%UseBladedInterface ) THEN + + IF ( .NOT. EqualRealNos( t - m%dll_data%DLL_DT, m%LastTimeCalled ) ) THEN + IF (m%FirstWarn) THEN + IF ( EqualRealNos( p%DT, m%dll_data%DLL_DT ) ) THEN ! This must be because we're doing a correction step or calling multiple times per time step + CALL SetErrStat ( ErrID_Warn, 'BladedInterface option was designed for an explicit-loose '//& + 'coupling scheme. Using last calculated values from DLL on all subsequent calls until time is advanced. '//& + 'Warning will not be displayed again.', ErrStat, ErrMsg, RoutineName ) + ELSE ! this may be because of calling multiple times per time step, but most likely is because DT /= DLL_DT + CALL SetErrStat ( ErrID_Warn, 'Using last calculated values from DLL on all subsequent calls until next DLL_DT has been reached. '//& + 'Warning will not be displayed again.', ErrStat, ErrMsg, RoutineName ) + END IF + m%FirstWarn = .FALSE. + END IF + ELSE + m%dll_data%PrevBlPitch(1:p%NumBl) = m%dll_data%BlPitchCom ! used for linear ramp of delayed signal + m%LastTimeCalled = t + + CALL BladedInterface_CalcOutput( t, u, p, m, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + m%dll_data%initialized = .true. + END IF + + !END IF + +END SUBROUTINE DLL_controller_call +!---------------------------------------------------------------------------------------------------------------------------------- !> Routine for computing outputs, used in both loose and tight coupling. SUBROUTINE SrvD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) !.................................................................................................................................. @@ -919,23 +1025,10 @@ SUBROUTINE SrvD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ! Get the demanded values from the external Bladed dynamic link library, if necessary: !............................................................................................................................... IF ( p%UseBladedInterface ) THEN - - IF ( .NOT. EqualRealNos( t - p%DLL_DT, m%LastTimeCalled ) ) THEN - IF (m%FirstWarn) THEN - IF ( EqualRealNos( p%DT, p%DLL_DT ) ) THEN ! This must be because we're doing a correction step or calling multiple times per time step - CALL SetErrStat ( ErrID_Warn, 'BladedInterface option was designed for an explicit-loose '//& - 'coupling scheme. Using last calculated values from DLL on all subsequent calls until time is advanced. '//& - 'Warning will not be displayed again.', ErrStat, ErrMsg, RoutineName ) - ELSE ! this may be because of calling multiple times per time step, but most likely is because DT /= DLL_DT - CALL SetErrStat ( ErrID_Warn, 'Using last calculated values from DLL on all subsequent calls until next DLL_DT has been reached. '//& - 'Warning will not be displayed again.', ErrStat, ErrMsg, RoutineName ) - END IF - m%FirstWarn = .FALSE. - END IF - ELSE - m%dll_data%PrevBlPitch(1:p%NumBl) = m%dll_data%BlPitchCom ! used for linear ramp of delayed signal - m%LastTimeCalled = t - CALL BladedInterface_CalcOutput( t, u, p, m, ErrStat2, ErrMsg2 ) + + ! Initialize the DLL controller in CalcOutput ONLY if it hasn't already been initialized in SrvD_UpdateStates + IF (.NOT. m%dll_data%initialized) THEN + CALL DLL_controller_call(t, u, p, x, xd, z, OtherState, m, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF @@ -943,7 +1036,7 @@ SUBROUTINE SrvD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg y%SuperController = m%dll_data%SCoutput END IF - END IF + END IF !............................................................................................................................... ! Compute the outputs @@ -955,7 +1048,7 @@ SUBROUTINE SrvD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg IF (ErrStat >= AbortErrLev) RETURN ! Pitch control: - CALL Pitch_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat2, ErrMsg2 ) + CALL Pitch_CalcOutput( t, u, p, x, xd, z, OtherState, y%BlPitchCom, y%ElecPwr, m, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (ErrStat >= AbortErrLev) RETURN @@ -969,6 +1062,15 @@ SUBROUTINE SrvD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (ErrStat >= AbortErrLev) RETURN + + !............................................................................................................................... + ! Calculate all of the available output channels: + !............................................................................................................................... + ! This is overwriting the values if it was called from UpdateStates, but they + ! should be the same and this sets the values if we called the DLL above. + m%dll_data%ElecPwr_prev = y%ElecPwr + m%dll_data%GenTrq_prev = y%GenTrq + !............................................................................................................................... ! Calculate all of the available output channels: !............................................................................................................................... @@ -980,8 +1082,8 @@ SUBROUTINE SrvD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg DO K=1,p%NumBl AllOuts( BlPitchC(K) ) = y%BlPitchCom(K)*R2D - END DO - + END DO + AllOuts(YawMomCom) = -0.001*y%YawMom AllOuts(NTMD_XQ ) = x%NTMD%tmd_x(1) @@ -1004,6 +1106,10 @@ SUBROUTINE SrvD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ENDDO ! I - All selected output channels + DO I = 1,p%NumOuts_DLL ! Loop through all DLL logging channels + y%WriteOutput(I+p%NumOuts) = m%dll_data%LogChannels( I ) + ENDDO + RETURN END SUBROUTINE SrvD_CalcOutput !---------------------------------------------------------------------------------------------------------------------------------- @@ -1069,12 +1175,22 @@ SUBROUTINE SrvD_UpdateDiscState( t, u, p, x, xd, z, OtherState, m, ErrStat, ErrM ErrStat = ErrID_None ErrMsg = "" + + select case (p%TrimCase) + case (TrimCase_yaw) + xd%CtrlOffset = xd%CtrlOffset + (u%RotSpeed - p%RotSpeedRef) * sign(p%TrimGain, p%YawNeut + xd%CtrlOffset) + case (TrimCase_torque, TrimCase_pitch) + xd%CtrlOffset = xd%CtrlOffset + (u%RotSpeed - p%RotSpeedRef) * p%TrimGain +! case default +! xd%CtrlOffset = 0.0_ReKi ! same as initialized value + end select + !xd%BlPitchFilter = p%BlAlpha * xd%BlPitchFilter + (1.0_ReKi - p%BlAlpha) * u%BlPitch !if ( p%PCMode == ControlMode_DLL ) then ! if ( p%DLL_Ramp ) then - ! temp = (t - m%LastTimeCalled) / p%DLL_DT + ! temp = (t - m%LastTimeCalled) / m%dll_data%DLL_DT ! temp = m%dll_data%PrevBlPitch(1:p%NumBl) + & ! temp * ( m%dll_data%BlPitchCom(1:p%NumBl) - m%dll_data%PrevBlPitch(1:p%NumBl) ) ! else @@ -1175,7 +1291,7 @@ SUBROUTINE SrvD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, Er ! local variables REAL(R8Ki) :: AllOuts(3,1:MaxOutPts) ! All the the available output channels - REAL(R8Ki) :: GenTrq, ElecPwr ! derivatives of generator torque and electrical power w.r.t. u%HSS_SPD + REAL(R8Ki) :: GenTrq_du, ElecPwr_du ! derivatives of generator torque and electrical power w.r.t. u%HSS_SPD INTEGER(IntKi) :: I ! Generic loop index INTEGER(IntKi) :: K ! Blade index INTEGER(IntKi) :: ErrStat2 ! Error status of the operation @@ -1215,7 +1331,7 @@ SUBROUTINE SrvD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, Er ! Note this is similiar to SrvD_CalcOutput if (.not. allocated(dYdu)) then - call allocAry(dYdu, 6+p%NumOuts, 3, 'dYdu', ErrStat2, ErrMsg2) + call allocAry(dYdu, SrvD_Indx_Y_WrOutput+p%NumOuts, 3, 'dYdu', ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end if dYdu = 0.0_R8Ki @@ -1225,10 +1341,10 @@ SUBROUTINE SrvD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, Er !> Compute !> \f$ \frac{\partial Y_{GenTrq}}{\partial u_{HSS\_Spd}} \f$ and !> \f$ \frac{\partial Y_{ElecPwr}}{\partial u_{HSS\_Spd}} \f$ in servodyn::torque_jacobianpinput. - call Torque_JacobianPInput( t, u, p, x, xd, z, OtherState, m, GenTrq, ElecPwr, ErrStat, ErrMsg ) ! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call Torque_JacobianPInput( t, u, p, x, xd, z, OtherState, m, GenTrq_du, ElecPwr_du, ErrStat, ErrMsg ) ! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (ErrStat >= AbortErrLev) RETURN - dYdu(Indx_Y_GenTrq, Indx_u_HSS_Spd) = GenTrq - dYdu(Indx_Y_ElecPwr,Indx_u_HSS_Spd) = ElecPwr + dYdu(SrvD_Indx_Y_GenTrq, Indx_u_HSS_Spd) = GenTrq_du + dYdu(SrvD_Indx_Y_ElecPwr,Indx_u_HSS_Spd) = ElecPwr_du ! Pitch control: @@ -1236,9 +1352,9 @@ SUBROUTINE SrvD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, Er ! Yaw control: !> \f$ \frac{\partial Y_{YawMom}}{\partial u_{Yaw}} = -p\%YawSpr \f$ - dYdu(Indx_Y_YawMom,Indx_u_Yaw) = -p%YawSpr ! from Yaw_CalcOutput + dYdu(SrvD_Indx_Y_YawMom,Indx_u_Yaw) = -p%YawSpr ! from Yaw_CalcOutput !> \f$ \frac{\partial Y_{YawMom}}{\partial u_{YawRate}} = -p\%YawDamp \f$ - dYdu(Indx_Y_YawMom,Indx_u_YawRate) = -p%YawDamp ! from Yaw_CalcOutput + dYdu(SrvD_Indx_Y_YawMom,Indx_u_YawRate) = -p%YawDamp ! from Yaw_CalcOutput !......................................................................................................................... @@ -1246,16 +1362,16 @@ SUBROUTINE SrvD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, Er !......................................................................................................................... AllOuts = 0.0_R8Ki ! all variables not specified below are zeros (either constant or disabled): - AllOuts(:, GenTq) = 0.001_R8Ki*dYdu(Indx_Y_GenTrq,:) - AllOuts(:, GenPwr) = 0.001_R8Ki*dYdu(Indx_Y_ElecPwr,:) - AllOuts(:, YawMomCom) = dYdu(Indx_Y_YawMom,:) + AllOuts(:, GenTq) = 0.001_R8Ki*dYdu(SrvD_Indx_Y_GenTrq,:) + AllOuts(:, GenPwr) = 0.001_R8Ki*dYdu(SrvD_Indx_Y_ElecPwr,:) + AllOuts(:, YawMomCom) = dYdu(SrvD_Indx_Y_YawMom,:) !............................................................................................................................... ! Place the selected output channels into the WriteOutput(:) portion of the jacobian with the proper sign: !............................................................................................................................... DO I = 1,p%NumOuts ! Loop through all selected output channels - dYdu(I+Indx_Y_WrOutput,:) = p%OutParam(I)%SignM * AllOuts( :, p%OutParam(I)%Indx ) + dYdu(I+SrvD_Indx_Y_WrOutput,:) = p%OutParam(I)%SignM * AllOuts( :, p%OutParam(I)%Indx ) ENDDO ! I - All selected output channels END IF @@ -1554,21 +1670,21 @@ SUBROUTINE SrvD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_o IF ( PRESENT( y_op ) ) THEN if (.not. allocated(y_op)) then - CALL AllocAry( y_op, 6+p%NumOuts, 'y_op', ErrStat2, ErrMsg2 ) + CALL AllocAry( y_op, SrvD_Indx_Y_WrOutput+p%NumOuts, 'y_op', ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (ErrStat >= AbortErrLev) RETURN end if - do i=1,size(Indx_Y_BlPitchCom) - y_op(Indx_Y_BlPitchCom(i)) = y%BlPitchCom(i) + do i=1,size(SrvD_Indx_Y_BlPitchCom) + y_op(SrvD_Indx_Y_BlPitchCom(i)) = y%BlPitchCom(i) end do - y_op(Indx_Y_YawMom) = y%YawMom - y_op(Indx_Y_GenTrq) = y%GenTrq - y_op(Indx_Y_ElecPwr) = y%ElecPwr + y_op(SrvD_Indx_Y_YawMom) = y%YawMom + y_op(SrvD_Indx_Y_GenTrq) = y%GenTrq + y_op(SrvD_Indx_Y_ElecPwr) = y%ElecPwr do i=1,p%NumOuts - y_op(i+Indx_Y_WrOutput) = y%WriteOutput(i) - end do + y_op(i+SrvD_Indx_Y_WrOutput) = y%WriteOutput(i) + end do END IF @@ -1596,13 +1712,13 @@ END SUBROUTINE SrvD_GetOP !---------------------------------------------------------------------------------------------------------------------------------- !> This subroutine reads the input file and stores all the data in the SrvD_InputFile structure. !! It does not perform data validation. -SUBROUTINE SrvD_ReadInput( InputFileName, InputFileData, Default_DT, OutFileRoot, ErrStat, ErrMsg ) +SUBROUTINE SrvD_ReadInput( InitInp, InputFileData, Default_DT, OutFileRoot, ErrStat, ErrMsg ) !.................................................................................................................................. ! Passed variables + TYPE(SrvD_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine REAL(DbKi), INTENT(IN) :: Default_DT !< The default DT (from glue code) - CHARACTER(*), INTENT(IN) :: InputFileName !< Name of the input file CHARACTER(*), INTENT(IN) :: OutFileRoot !< The rootname of all the output files written by this routine. TYPE(SrvD_InputFile), INTENT(OUT) :: InputFileData !< Data stored in the module's input file @@ -1626,7 +1742,7 @@ SUBROUTINE SrvD_ReadInput( InputFileName, InputFileData, Default_DT, OutFileRoot ! get the primary/platform input-file data - CALL ReadPrimaryFile( InputFileName, InputFileData, OutFileRoot, UnEcho, ErrStat2, ErrMsg2 ) + CALL ReadPrimaryFile( InitInp%InputFile, InputFileData, OutFileRoot, UnEcho, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) THEN IF ( UnEcho > 0 ) CLOSE( UnEcho ) @@ -1808,6 +1924,7 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, OutFileRoot, UnEc, ErrStat IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%BlPitchF = InputFileData%BlPitchF*D2R + !---------------------- GENERATOR AND TORQUE CONTROL ---------------------------- CALL ReadCom( UnIn, InputFile, 'Section Header: Generator and Torque Control', ErrStat2, ErrMsg2, UnEc ) CALL CheckError( ErrStat2, ErrMsg2 ) @@ -2063,6 +2180,8 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, OutFileRoot, UnEc, ErrStat CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN + InputFileData%UseLegacyInterface = .true. + ! DLL_FileName - Name of the Bladed DLL [used only with DLL Interface] (-): CALL ReadVar( UnIn, InputFile, InputFileData%DLL_FileName, "DLL_FileName", "Name/location of the external library {.dll [Windows]} in the Bladed-DLL format [used only with DLL Interface] (-)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) @@ -2322,9 +2441,14 @@ SUBROUTINE ValidatePrimaryData( InitInp, InputFileData, NumBl, ErrStat, ErrMsg ) ! local variables - INTEGER(IntKi) :: K ! Blade number + INTEGER(IntKi) :: K ! Blade number CHARACTER(*), PARAMETER :: RoutineName = 'ValidatePrimaryData' + INTEGER(IntKi) :: ErrStat2 !< Error status + CHARACTER(ErrMsgLen) :: ErrMsg2 !< temporary Error message if ErrStat /= ErrID_None + + ErrStat = ErrID_None + ErrMsg = '' CALL Pitch_ValidateData() CALL Yaw_ValidateData() @@ -2355,6 +2479,14 @@ SUBROUTINE ValidatePrimaryData( InitInp, InputFileData, NumBl, ErrStat, ErrMsg ) if (InputFileData%CompNTMD .or. InputFileData%CompTTMD) & call SetErrStat(ErrID_Fatal,"TMD module is not currently allowed in linearization. CompNTMD and CompTTMD must be FALSE.",ErrStat,ErrMsg,RoutineName) + if (InitInp%TrimCase /= TrimCase_none) then + if (InitInp%TrimCase /= TrimCase_yaw .and. InitInp%TrimCase /= TrimCase_torque .and. InitInp%TrimCase /= TrimCase_pitch) then + call SetErrStat(ErrID_Fatal,"Invalid value entered for TrimCase.",ErrStat,ErrMsg,RoutineName) + else + if (InitInp%TrimGain <= 0.0_ReKi) call SetErrStat(ErrID_Fatal,"TrimGain must be a positive number.",ErrStat,ErrMsg,RoutineName) + end if + end if + end if @@ -2585,7 +2717,7 @@ END SUBROUTINE ValidatePrimaryData SUBROUTINE SrvD_SetParameters( InputFileData, p, ErrStat, ErrMsg ) !.................................................................................................................................. - TYPE(SrvD_InputFile), INTENT(IN) :: InputFileData !< Data stored in the module's input file + TYPE(SrvD_InputFile), INTENT(INOUT) :: InputFileData !< Data stored in the module's input file (intent OUT for MOVE_ALLOC) TYPE(SrvD_ParameterType), INTENT(INOUT) :: p !< The module's parameter data INTEGER(IntKi), INTENT(OUT) :: ErrStat !< The error status code CHARACTER(*), INTENT(OUT) :: ErrMsg !< The error message, if an error occurred @@ -2757,9 +2889,10 @@ SUBROUTINE SrvD_SetParameters( InputFileData, p, ErrStat, ErrMsg ) END IF !............................................. - ! Parameters for file output + ! Parameters for file output (not including Bladed DLL logging outputs) !............................................. p%NumOuts = InputFileData%NumOuts + p%NumOuts_DLL = 0 ! set to zero and overwritten if/when the DLL uses it CALL SetOutParam(InputFileData%OutList, p, ErrStat2, ErrMsg2 ) ! requires: p%NumOuts, p%NumBl; sets: p%OutParam. CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) @@ -2795,20 +2928,11 @@ SUBROUTINE Yaw_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg REAL(ReKi) :: YawPosCom ! Commanded yaw angle from user-defined routines, rad. REAL(ReKi) :: YawRateCom ! Commanded yaw rate from user-defined routines, rad/s. - - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = "" - + ! Initialize ErrStat - !................................................................... - ! Calculate standard yaw position and rate commands: - !................................................................... + ErrStat = ErrID_None + ErrMsg = "" - CALL CalculateStandardYaw(t, u, p, m, YawPosCom, YawRateCom, ErrStat, ErrMsg) - !................................................................... ! Override standard yaw control with a linear maneuver if necessary: !................................................................... @@ -2826,10 +2950,27 @@ SUBROUTINE Yaw_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg YawRateCom = SIGN( p%YawManRat, p%NacYawF - OtherState%NacYawI ) ! Modify the sign of p%YawManRat based on the direction of the yaw maneuever YawPosCom = OtherState%NacYawI + YawRateCom*( t - p%TYawManS ) - ENDIF + ENDIF - ENDIF - + ELSE + + if (p%YCMode == ControlMode_DLL) then + if (m%dll_data%Yaw_Cntrl == GH_DISCON_YAW_CONTROL_TORQUE .or. m%dll_data%OverrideYawRateWithTorque) then + + y%YawMom = m%dll_data%YawTorqueDemand + + return + end if + end if + + !................................................................... + ! Calculate standard yaw position and rate commands: + !................................................................... + + CALL CalculateStandardYaw(t, u, p, m, YawPosCom, YawRateCom, ErrStat, ErrMsg) + + END IF + !................................................................... ! Calculate the yaw moment: !................................................................... @@ -2838,6 +2979,15 @@ SUBROUTINE Yaw_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg - p%YawDamp*( u%YawRate - YawRateCom ) ! {-f(qd,q,t)}DampYaw; + !................................................................... + ! Apply trim case for linearization: + ! prescribed yaw will be wrong in this case..... + !................................................................... + if (p%TrimCase==TrimCase_yaw) then + y%YawMom = y%YawMom + xd%CtrlOffset * p%YawSpr + end if + + END SUBROUTINE Yaw_CalcOutput !---------------------------------------------------------------------------------------------------------------------------------- !> Routine that calculates standard yaw position and rate commands: YawPosCom and YawRateCom. @@ -2882,7 +3032,11 @@ SUBROUTINE CalculateStandardYaw(t, u, p, m, YawPosCom, YawRateCom, ErrStat, ErrM YawPosCom = u%Yaw + m%dll_data%YawRateCom*p%DT !bjj: was this: LastYawPosCom + YawRateCom*( ZTime - LastTime ) YawRateCom = m%dll_data%YawRateCom - + if (m%dll_data%OverrideYawRateWithTorque .or. m%dll_data%Yaw_Cntrl == GH_DISCON_YAW_CONTROL_TORQUE) then + call SetErrStat(ErrID_Fatal, "Unable to calculate yaw rate control because yaw torque control (or override) was requested from DLL.", ErrStat, ErrMsg, "CalculateStandardYaw") + return + end if + END SELECT @@ -2951,7 +3105,7 @@ SUBROUTINE Yaw_UpdateStates( t, u, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) END SUBROUTINE Yaw_UpdateStates !---------------------------------------------------------------------------------------------------------------------------------- !> Routine for computing the pitch output: blade pitch commands. This routine is used in both loose and tight coupling. -SUBROUTINE Pitch_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) +SUBROUTINE Pitch_CalcOutput( t, u, p, x, xd, z, OtherState, BlPitchCom, ElecPwr, m, ErrStat, ErrMsg ) !.................................................................................................................................. REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds @@ -2961,8 +3115,9 @@ SUBROUTINE Pitch_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMs TYPE(SrvD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at t TYPE(SrvD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t TYPE(SrvD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at t - TYPE(SrvD_OutputType), INTENT(INOUT) :: y !< Outputs computed at t (Input only so that mesh con- + REAL(ReKi), INTENT(INOUT) :: BlPitchCom(:) !< pitch outputs computed at t (Input only so that mesh con- !! nectivity information does not have to be recalculated) + REAL(ReKi), INTENT(IN ) :: ElecPwr !< Electrical power (watts) 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 @@ -2996,40 +3151,38 @@ SUBROUTINE Pitch_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMs CASE ( ControlMode_USER ) ! User-defined from routine PitchCntrl(). - CALL PitchCntrl ( u%BlPitch, y%ElecPwr, u%LSS_Spd, u%TwrAccel, p%NumBl, t, p%DT, p%RootName, y%BlPitchCom ) + CALL PitchCntrl ( u%BlPitch, ElecPwr, u%LSS_Spd, u%TwrAccel, p%NumBl, t, p%DT, p%RootName, BlPitchCom ) CASE ( ControlMode_EXTERN ) ! User-defined from Simulink or LabVIEW. - y%BlPitchCom = u%ExternalBlPitchCom ! copy entire array + BlPitchCom = u%ExternalBlPitchCom ! copy entire array CASE ( ControlMode_DLL ) ! User-defined pitch control from Bladed-style DLL if (p%DLL_Ramp) then - factor = (t - m%LastTimeCalled) / p%DLL_DT - y%BlPitchCom = m%dll_data%PrevBlPitch(1:p%NumBl) + & - factor * ( m%dll_data%BlPitchCom(1:p%NumBl) - m%dll_data%PrevBlPitch(1:p%NumBl) ) + factor = (t - m%LastTimeCalled) / m%dll_data%DLL_DT + BlPitchCom = m%dll_data%PrevBlPitch(1:p%NumBl) + & + factor * ( m%dll_data%BlPitchCom(1:p%NumBl) - m%dll_data%PrevBlPitch(1:p%NumBl) ) else - y%BlPitchCom = m%dll_data%BlPitchCom(1:p%NumBl) + BlPitchCom = m%dll_data%BlPitchCom(1:p%NumBl) end if ! update the filter state once per time step IF ( EqualRealNos( t - p%DT, m%LastTimeFiltered ) ) THEN - m%xd_BlPitchFilter = p%BlAlpha * m%xd_BlPitchFilter + (1.0_ReKi - p%BlAlpha) * y%BlPitchCom + m%xd_BlPitchFilter = p%BlAlpha * m%xd_BlPitchFilter + (1.0_ReKi - p%BlAlpha) * BlPitchCom m%LastTimeFiltered = t END IF - y%BlPitchCom = p%BlAlpha * m%xd_BlPitchFilter + (1.0_ReKi - p%BlAlpha) * y%BlPitchCom + BlPitchCom = p%BlAlpha * m%xd_BlPitchFilter + (1.0_ReKi - p%BlAlpha) * BlPitchCom END SELECT ELSE ! Do not control pitch yet, maintain initial pitch angles. - ! Use the initial blade pitch angles: - y%BlPitchCom = p%BlPitchInit - + BlPitchCom = p%BlPitchInit ENDIF @@ -3045,12 +3198,12 @@ SUBROUTINE Pitch_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMs IF ( t >= OtherState%TPitManE(K) ) THEN ! Override pitch maneuver has ended, blade is locked at BlPitchF. - y%BlPitchCom(K) = p%BlPitchF(K) + BlPitchCom(K) = p%BlPitchF(K) ELSE - - PitManRat = SIGN( p%PitManRat(K), p%BlPitchF(K) - OtherState%BlPitchI(K) ) ! Modify the sign of PitManRat based on the direction of the pitch maneuever - y%BlPitchCom(K) = OtherState%BlPitchI(K) + PitManRat*( t - p%TPitManS(K) ) ! Increment the blade pitch using PitManRat + + PitManRat = SIGN( p%PitManRat(K), p%BlPitchF(K) - OtherState%BlPitchI(K) ) ! Modify the sign of PitManRat based on the direction of the pitch maneuever + BlPitchCom(K) = OtherState%BlPitchI(K) + PitManRat*( t - p%TPitManS(K) ) ! Increment the blade pitch using PitManRat END IF @@ -3059,9 +3212,17 @@ SUBROUTINE Pitch_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMs ENDDO ! K - blades + !................................................................... + ! Apply trim case for linearization: + !................................................................... + if (p%TrimCase==TrimCase_pitch) then + BlPitchCom = BlPitchCom + xd%CtrlOffset + end if + + END SUBROUTINE Pitch_CalcOutput !---------------------------------------------------------------------------------------------------------------------------------- -!> This routine updates the other states associated with the pitch controller: BegPitMan, BlPitchI, and TPitManE. +!> This routine updates the continuous and other states associated with the pitch controller: BegPitMan, BlPitchI, and TPitManE. SUBROUTINE Pitch_UpdateStates( t, u, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) !.................................................................................................................................. @@ -3086,10 +3247,11 @@ SUBROUTINE Pitch_UpdateStates( t, u, p, x, xd, z, OtherState, m, ErrStat, ErrMsg - ! Initialize ErrStat + ! Initialize ErrStat + + ErrStat = ErrID_None + ErrMsg = "" - ErrStat = ErrID_None - ErrMsg = "" !................................................................... ! Override standard pitch control with a linear maneuver if necessary: @@ -3177,15 +3339,15 @@ SUBROUTINE SetOutParam(OutList, p, ErrStat, ErrMsg ) ! Determine which inputs are not valid - InvalidOutput(BlPitchC3) = ( p%NumBl < 3 ) - InvalidOutput( NTMD_XQ) = ( .not. p%CompNTMD ) - InvalidOutput( NTMD_XQD) = ( .not. p%CompNTMD ) - InvalidOutput( NTMD_YQ) = ( .not. p%CompNTMD ) - InvalidOutput( NTMD_YQD) = ( .not. p%CompNTMD ) - InvalidOutput( TTMD_XQ) = ( .not. p%CompTTMD ) - InvalidOutput( TTMD_XQD) = ( .not. p%CompTTMD ) - InvalidOutput( TTMD_YQ) = ( .not. p%CompTTMD ) - InvalidOutput( TTMD_YQD) = ( .not. p%CompTTMD ) + InvalidOutput( BlPitchC3) = ( p%NumBl < 3 ) + InvalidOutput( NTMD_XQ) = ( .not. p%CompNTMD ) + InvalidOutput( NTMD_XQD) = ( .not. p%CompNTMD ) + InvalidOutput( NTMD_YQ) = ( .not. p%CompNTMD ) + InvalidOutput( NTMD_YQD) = ( .not. p%CompNTMD ) + InvalidOutput( TTMD_XQ) = ( .not. p%CompTTMD ) + InvalidOutput( TTMD_XQD) = ( .not. p%CompTTMD ) + InvalidOutput( TTMD_YQ) = ( .not. p%CompTTMD ) + InvalidOutput( TTMD_YQD) = ( .not. p%CompTTMD ) !------------------------------------------------------------------------------------------------- @@ -3451,65 +3613,81 @@ SUBROUTINE Torque_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM y%ElecPwr = 0.0_ReKi ENDIF + !................................................................... + ! Apply trim case for linearization: + !................................................................... + if (p%TrimCase == TrimCase_torque) then + y%GenTrq = y%GenTrq + xd%CtrlOffset + end if !................................................................................. - ! Calculate the fraction of applied HSS-brake torque, HSSBrFrac: + ! Calculate the magnitude of HSS brake torque from DLL controller !................................................................................. - IF ( (.NOT. EqualRealNos(t, p%THSSBrDp )) .AND. t < p%THSSBrDp ) THEN ! HSS brake not deployed yet. + IF (p%HSSBrMode == ControlMode_DLL) THEN + + y%HSSBrTrqC = m%dll_data%HSSBrTrqDemand - HSSBrFrac = 0.0_ReKi + ELSE + + !................................................................................. + ! Calculate the fraction of applied HSS-brake torque, HSSBrFrac: + !................................................................................. + IF ( t <= p%THSSBrDp ) THEN ! HSS brake not deployed yet. + + HSSBrFrac = 0.0_ReKi - ELSE ! HSS brake deployed. + ELSE ! HSS brake deployed. - SELECT CASE ( p%HSSBrMode ) ! Which HSS brake model are we using? + SELECT CASE ( p%HSSBrMode ) ! Which HSS brake model are we using? - CASE ( ControlMode_NONE) ! None + CASE ( ControlMode_NONE) ! None - HSSBrFrac = 0.0_ReKi + HSSBrFrac = 0.0_ReKi - CASE ( ControlMode_SIMPLE ) ! Simple built-in HSS brake model with linear ramp. + CASE ( ControlMode_SIMPLE ) ! Simple built-in HSS brake model with linear ramp. - IF ( t < p%THSSBrFl ) THEN ! Linear ramp - HSSBrFrac = ( t - p%THSSBrDp )/p%HSSBrDT - ELSE ! Full braking torque - HSSBrFrac = 1.0 - ENDIF + IF ( t < p%THSSBrFl ) THEN ! Linear ramp + HSSBrFrac = ( t - p%THSSBrDp )/p%HSSBrDT + ELSE ! Full braking torque + HSSBrFrac = 1.0 + ENDIF - CASE ( ControlMode_USER ) ! User-defined HSS brake model. + CASE ( ControlMode_USER ) ! User-defined HSS brake model. - CALL UserHSSBr ( y%GenTrq, y%ElecPwr, u%HSS_Spd, p%NumBl, t, p%DT, p%RootName, HSSBrFrac ) + CALL UserHSSBr ( y%GenTrq, y%ElecPwr, u%HSS_Spd, p%NumBl, t, p%DT, p%RootName, HSSBrFrac ) - IF ( ( HSSBrFrac < 0.0_ReKi ) .OR. ( HSSBrFrac > 1.0_ReKi ) ) THEN ! 0 (off) <= HSSBrFrac <= 1 (full); else Abort. - ErrStat = ErrID_Fatal - ErrMsg = 'HSSBrFrac must be between 0.0 (off) and 1.0 (full) (inclusive). Fix logic in routine UserHSSBr().' - RETURN - END IF + IF ( ( HSSBrFrac < 0.0_ReKi ) .OR. ( HSSBrFrac > 1.0_ReKi ) ) THEN ! 0 (off) <= HSSBrFrac <= 1 (full); else Abort. + ErrStat = ErrID_Fatal + ErrMsg = 'HSSBrFrac must be between 0.0 (off) and 1.0 (full) (inclusive). Fix logic in routine UserHSSBr().' + RETURN + END IF - CASE ( ControlMode_DLL ) ! User-defined HSS brake model from Bladed-style DLL - - HSSBrFrac = m%dll_data%HSSBrFrac - y%HSSBrTrqC = ABS( HSSBrFrac*m%dll_data%HSSBrTrqC ) - RETURN + !!!CASE ( ControlMode_DLL ) ! User-defined HSS brake model from Bladed-style DLL + !!! + !!! HSSBrFrac = 1.0_ReKi ! just a placeholder, since it never reaches this case - CASE ( ControlMode_EXTERN ) ! HSS brake model from LabVIEW. + CASE ( ControlMode_EXTERN ) ! HSS brake model from LabVIEW. - HSSBrFrac = u%ExternalHSSBrFrac + HSSBrFrac = u%ExternalHSSBrFrac - ENDSELECT + ENDSELECT - HSSBrFrac = MAX( MIN( HSSBrFrac, 1.0_ReKi ), 0.0_ReKi ) ! make sure we didn't get outside the acceptable range: 0 (off) <= HSSBrFrac <= 1 (full) + HSSBrFrac = MAX( MIN( HSSBrFrac, 1.0_ReKi ), 0.0_ReKi ) ! make sure we didn't get outside the acceptable range: 0 (off) <= HSSBrFrac <= 1 (full) - ENDIF + ENDIF ! Calculate the magnitude of HSS brake torque: - ! to avoid issues with ElastoDyn extrapolating between +/- p%HSSBrTqF, we're going to make this output always positive + !y%HSSBrTrqC = SIGN( HSSBrFrac*p%HSSBrTqF, u%HSS_Spd ) ! Scale the full braking torque by the brake torque fraction and make sure the brake torque resists motion. + y%HSSBrTrqC = HSSBrFrac*p%HSSBrTqF ! Scale the full braking torque by the brake torque fraction (don't worry about the sign here). - !y%HSSBrTrqC = SIGN( HSSBrFrac*p%HSSBrTqF, u%HSS_Spd ) ! Scale the full braking torque by the brake torque fraction and make sure the brake torque resists motion. - y%HSSBrTrqC = ABS( HSSBrFrac*p%HSSBrTqF ) ! Scale the full braking torque by the brake torque fraction and make sure the brake torque resists motion. - + END IF + + ! to avoid issues with ElastoDyn extrapolating between +/- p%HSSBrTqF, we're going to make this output always positive + y%HSSBrTrqC = ABS(y%HSSBrTrqC) + RETURN END SUBROUTINE Torque_CalcOutput @@ -3601,7 +3779,7 @@ SUBROUTINE CalculateTorque( t, u, p, m, GenTrq, ElecPwr, ErrStat, ErrMsg ) TYPE(SrvD_ParameterType), INTENT(IN ) :: p !< Parameters TYPE(SrvD_MiscVarType), INTENT(INOUT) :: m !< Misc (optimization) variables - REAL(ReKi), INTENT( OUT) :: GenTrq !< generator torque + REAL(ReKi), INTENT( OUT) :: GenTrq !< generator torque command REAL(ReKi), INTENT( OUT) :: ElecPwr !< electrical power INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None @@ -3631,118 +3809,117 @@ SUBROUTINE CalculateTorque( t, u, p, m, GenTrq, ElecPwr, ErrStat, ErrMsg ) ElecPwr = 0.0_ReKi - ! Are we doing simple variable-speed control, or using a generator model? + ! Are we doing simple variable-speed control, or using a generator model? - SELECT CASE ( p%VSContrl ) ! Are we using variable-speed control? + SELECT CASE ( p%VSContrl ) ! Are we using variable-speed control? - CASE ( ControlMode_NONE ) ! No variable-speed control. Using a generator model. + CASE ( ControlMode_NONE ) ! No variable-speed control. Using a generator model. - SELECT CASE ( p%GenModel ) ! Which generator model are we using? + SELECT CASE ( p%GenModel ) ! Which generator model are we using? - CASE ( ControlMode_SIMPLE ) ! Simple induction-generator model. + CASE ( ControlMode_SIMPLE ) ! Simple induction-generator model. - Slip = u%HSS_Spd - p%SIG_SySp + Slip = u%HSS_Spd - p%SIG_SySp - IF ( ABS( Slip ) > p%SIG_POSl ) THEN - GenTrq = SIGN( p%SIG_POTq, Slip ) - ELSE - GenTrq = Slip*p%SIG_Slop - ENDIF + IF ( ABS( Slip ) > p%SIG_POSl ) THEN + GenTrq = SIGN( p%SIG_POTq, Slip ) + ELSE + GenTrq = Slip*p%SIG_Slop + ENDIF - ElecPwr = CalculateElecPwr( GenTrq, u, p ) + ElecPwr = CalculateElecPwr( GenTrq, u, p ) - CASE ( ControlMode_ADVANCED ) ! Thevenin-equivalent generator model. + CASE ( ControlMode_ADVANCED ) ! Thevenin-equivalent generator model. - SlipRat = ( u%HSS_Spd - p%TEC_SySp )/p%TEC_SySp + SlipRat = ( u%HSS_Spd - p%TEC_SySp )/p%TEC_SySp - GenTrq = p%TEC_A0*(p%TEC_VLL**2)*SlipRat & - /( p%TEC_C0 + p%TEC_C1*SlipRat + p%TEC_C2*(SlipRat**2) ) + GenTrq = p%TEC_A0*(p%TEC_VLL**2)*SlipRat & + /( p%TEC_C0 + p%TEC_C1*SlipRat + p%TEC_C2*(SlipRat**2) ) - ! trying to refactor so we don't divide by SlipRat, which may be 0 - ! jmj tells me I need not worry about ComDenom being zero because these equations behave nicely - S2 = SlipRat**2 + ! trying to refactor so we don't divide by SlipRat, which may be 0 + ! jmj tells me I need not worry about ComDenom being zero because these equations behave nicely + S2 = SlipRat**2 - ComDenom = ( SlipRat*p%TEC_Re1 - p%TEC_RRes )**2 + (SlipRat*( p%TEC_Xe1 + p%TEC_RLR ))**2 - Current2 = CMPLX( p%TEC_V1a*SlipRat*( SlipRat*p%TEC_Re1 - p%TEC_RRes )/ComDenom , & - -p%TEC_V1a*S2 *( p%TEC_Xe1 + p%TEC_RLR )/ComDenom ) - Currentm = CMPLX( 0.0_ReKi , -p%TEC_V1a/p%TEC_MR ) - Current1 = Current2 + Currentm + ComDenom = ( SlipRat*p%TEC_Re1 - p%TEC_RRes )**2 + (SlipRat*( p%TEC_Xe1 + p%TEC_RLR ))**2 + Current2 = CMPLX( p%TEC_V1a*SlipRat*( SlipRat*p%TEC_Re1 - p%TEC_RRes )/ComDenom , & + -p%TEC_V1a*S2 *( p%TEC_Xe1 + p%TEC_RLR )/ComDenom ) + Currentm = CMPLX( 0.0_ReKi , -p%TEC_V1a/p%TEC_MR ) + Current1 = Current2 + Currentm - PwrLossS = 3.0*( ( ABS( Current1 ) )**2 )*p%TEC_SRes - PwrLossR = 3.0*( ( ABS( Current2 ) )**2 )*p%TEC_RRes + PwrLossS = 3.0*( ( ABS( Current1 ) )**2 )*p%TEC_SRes + PwrLossR = 3.0*( ( ABS( Current2 ) )**2 )*p%TEC_RRes - PwrMech = GenTrq*u%HSS_Spd - ElecPwr = PwrMech - PwrLossS - PwrLossR + PwrMech = GenTrq*u%HSS_Spd + ElecPwr = PwrMech - PwrLossS - PwrLossR - CASE ( ControlMode_USER ) ! User-defined generator model. + CASE ( ControlMode_USER ) ! User-defined generator model. - ! CALL UserGen ( u%HSS_Spd, u%LSS_Spd, p%NumBl, t, DT, p%GenEff, DelGenTrq, DirRoot, GenTrq, ElecPwr ) - CALL UserGen ( u%HSS_Spd, u%LSS_Spd, p%NumBl, t, p%DT, p%GenEff, 0.0_ReKi, p%RootName, GenTrq, ElecPwr ) + ! CALL UserGen ( u%HSS_Spd, u%LSS_Spd, p%NumBl, t, DT, p%GenEff, DelGenTrq, DirRoot, GenTrq, ElecPwr ) + CALL UserGen ( u%HSS_Spd, u%LSS_Spd, p%NumBl, t, p%DT, p%GenEff, 0.0_ReKi, p%RootName, GenTrq, ElecPwr ) - END SELECT + END SELECT - CASE ( ControlMode_SIMPLE ) ! Simple variable-speed control. + CASE ( ControlMode_SIMPLE ) ! Simple variable-speed control. - if ( u%HSS_Spd < 0.0_ReKi) then - if (.not. equalRealNos(u%HSS_Spd, 0.0_ReKi) ) then - call SetErrStat( ErrID_Fatal, "u%HSS_Spd is negative. Simple variable-speed control model "//& - "is not valid for motoring situations.", ErrStat, ErrMsg, RoutineName) - return - end if - end if + if ( u%HSS_Spd < 0.0_ReKi) then + if (.not. equalRealNos(u%HSS_Spd, 0.0_ReKi) ) then + call SetErrStat( ErrID_Fatal, "u%HSS_Spd is negative. Simple variable-speed control model "//& + "is not valid for motoring situations.", ErrStat, ErrMsg, RoutineName) + return + end if + end if - ! Compute the generator torque, which depends on which region we are in: + ! Compute the generator torque, which depends on which region we are in: - IF ( u%HSS_Spd >= p%VS_RtGnSp ) THEN ! We are in region 3 - torque is constant - GenTrq = p%VS_RtTq - ELSEIF ( u%HSS_Spd < p%VS_TrGnSp ) THEN ! We are in region 2 - torque is proportional to the square of the generator speed - GenTrq = p%VS_Rgn2K* (u%HSS_Spd**2) - ELSE ! We are in region 2 1/2 - simple induction generator transition region - GenTrq = p%VS_Slope*( u%HSS_Spd - p%VS_SySp ) - ENDIF + IF ( u%HSS_Spd >= p%VS_RtGnSp ) THEN ! We are in region 3 - torque is constant + GenTrq = p%VS_RtTq + ELSEIF ( u%HSS_Spd < p%VS_TrGnSp ) THEN ! We are in region 2 - torque is proportional to the square of the generator speed + GenTrq = p%VS_Rgn2K* (u%HSS_Spd**2) + ELSE ! We are in region 2 1/2 - simple induction generator transition region + GenTrq = p%VS_Slope*( u%HSS_Spd - p%VS_SySp ) + ENDIF - ! It's not possible to motor using this control scheme, so the generator efficiency is always subtractive. + ! It's not possible to motor using this control scheme, so the generator efficiency is always subtractive. - ElecPwr = GenTrq*u%HSS_Spd*p%GenEff - !y%ElecPwr = CalculateElecPwr( y%GenTrq, u, p ) + ElecPwr = GenTrq*u%HSS_Spd*p%GenEff + !y%ElecPwr = CalculateElecPwr( y%GenTrq, u, p ) - CASE ( ControlMode_USER ) ! User-defined variable-speed control for routine UserVSCont(). + CASE ( ControlMode_USER ) ! User-defined variable-speed control for routine UserVSCont(). - ! CALL UserVSCont ( u%HSS_Spd, u%LSS_Spd, p%NumBl, t, DT, p%GenEff, DelGenTrq, DirRoot, GenTrq, ElecPwr ) - CALL UserVSCont ( u%HSS_Spd, u%LSS_Spd, p%NumBl, t, p%DT, p%GenEff, 0.0_ReKi, p%RootName, GenTrq, ElecPwr ) + CALL UserVSCont ( u%HSS_Spd, u%LSS_Spd, p%NumBl, t, p%DT, p%GenEff, 0.0_ReKi, p%RootName, GenTrq, ElecPwr ) - CASE ( ControlMode_DLL ) ! User-defined variable-speed control from Bladed-style DLL + CASE ( ControlMode_DLL ) ! User-defined variable-speed control from Bladed-style DLL - ! bjj: I believe this is how the old logic worked, but perhaps now we can be more clever about checking if the generator is off + ! bjj: I believe this is how the old logic worked, but perhaps now we can be more clever about checking if the generator is off - IF ( m%dll_data%GenState /= 0_IntKi ) THEN ! generator is on + IF ( m%dll_data%GenState /= 0_IntKi ) THEN ! generator is on - GenTrq = m%dll_data%GenTrq + GenTrq = m%dll_data%GenTrq ElecPwr = CalculateElecPwr( GenTrq, u, p ) - ELSE ! generator is off + ELSE ! generator is off - GenTrq = 0.0_ReKi - ElecPwr = 0.0_ReKi + GenTrq = 0.0_ReKi + ElecPwr = 0.0_ReKi - END IF + END IF - CASE ( ControlMode_EXTERN ) ! User-defined variable-speed control from Simulink or LabVIEW. + CASE ( ControlMode_EXTERN ) ! User-defined variable-speed control from Simulink or LabVIEW. - GenTrq = u%ExternalGenTrq - ElecPwr = u%ExternalElecPwr + GenTrq = u%ExternalGenTrq + ElecPwr = u%ExternalElecPwr - END SELECT + END SELECT ! Lets turn the generator offline for good if ( GenTiStp = .FALSE. ) .AND. ( ElecPwr <= 0.0 ): @@ -3762,7 +3939,7 @@ FUNCTION CalculateElecPwr( GenTrq, u, p ) TYPE(SrvD_InputType), INTENT(IN) :: u !< Inputs at t TYPE(SrvD_ParameterType), INTENT(IN) :: p !< Parameters -REAL(ReKi) :: CalculateElecPwr !< The result of this function +REAL(ReKi) :: CalculateElecPwr !< The result of this function !! The generator efficiency is either additive for motoring, !! or subtractive for generating power. @@ -3771,12 +3948,12 @@ FUNCTION CalculateElecPwr( GenTrq, u, p ) CalculateElecPwr = GenTrq * u%HSS_Spd * p%GenEff ELSE CalculateElecPwr = GenTrq * u%HSS_Spd / p%GenEff - ENDIF + ENDIF END FUNCTION CalculateElecPwr !---------------------------------------------------------------------------------------------------------------------------------- !> This routine calculates the partials with respect to inputs of the drive-train torque outputs: GenTrq and ElecPwr -SUBROUTINE Torque_JacobianPInput( t, u, p, x, xd, z, OtherState, m, GenTrq, ElecPwr, ErrStat, ErrMsg ) +SUBROUTINE Torque_JacobianPInput( t, u, p, x, xd, z, OtherState, m, GenTrq_du, ElecPwr_du, ErrStat, ErrMsg ) !.................................................................................................................................. REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds @@ -3787,8 +3964,8 @@ SUBROUTINE Torque_JacobianPInput( t, u, p, x, xd, z, OtherState, m, GenTrq, Elec TYPE(SrvD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t TYPE(SrvD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at t TYPE(SrvD_MiscVarType), INTENT(INOUT) :: m !< Misc (optimization) variables - REAL(R8Ki), INTENT( OUT) :: GenTrq !< partial derivative of generator torque output with respect to HSS_Spd input - REAL(R8Ki), INTENT( OUT) :: ElecPwr !< partial derivative of electrical power output with respect to HSS_Spd input + REAL(R8Ki), INTENT( OUT) :: GenTrq_du !< partial derivative of generator torque output with respect to HSS_Spd input + REAL(R8Ki), INTENT( OUT) :: ElecPwr_du !< partial derivative of electrical power output with respect to HSS_Spd input INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None @@ -3803,11 +3980,11 @@ SUBROUTINE Torque_JacobianPInput( t, u, p, x, xd, z, OtherState, m, GenTrq, Elec !................................................................................. IF ( OtherState%GenOnLine .and. .not. OtherState%Off4Good ) THEN ! Generator is on line. - CALL CalculateTorqueJacobian( t, u, p, m, GenTrq, ElecPwr, ErrStat, ErrMsg ) + CALL CalculateTorqueJacobian( t, u, p, m, GenTrq_du, ElecPwr_du, ErrStat, ErrMsg ) if (ErrStat >= AbortErrLev) return ELSE ! Generator is off line. - GenTrq = 0.0_R8Ki - ElecPwr = 0.0_R8Ki + GenTrq_du = 0.0_R8Ki + ElecPwr_du = 0.0_R8Ki ENDIF @@ -3887,8 +4064,10 @@ SUBROUTINE CalculateTorqueJacobian( t, u, p, m, GenTrq_du, ElecPwr_du, ErrStat, GenTrq_du = p%SIG_Slop ENDIF - - IF ( GenTrq >= 0.0_ReKi ) THEN + ! Calculate the electrical powerF + ! As generator: ElecPwr = GenTrq * u%HSS_Spd * m%GenEff + ! As motor: ElecPwr = GenTrq * u%HSS_Spd / m%GenEff + IF ( GenTrq >= 0.0_R8Ki ) THEN !ElecPwr = GenTrq * u%HSS_Spd * p%GenEff ElecPwr_du = (GenTrq_du * u%HSS_Spd + GenTrq) * p%GenEff ELSE diff --git a/modules/servodyn/src/ServoDyn_Driver.f90 b/modules/servodyn/src/ServoDyn_Driver.f90 index d09a710eac..82d9d23391 100644 --- a/modules/servodyn/src/ServoDyn_Driver.f90 +++ b/modules/servodyn/src/ServoDyn_Driver.f90 @@ -26,7 +26,7 @@ PROGRAM SrvD_Driver IMPLICIT NONE - INTEGER(IntKi), PARAMETER :: NumInp = 1 !< Number of inputs sent to SrvD_UpdateStates + INTEGER(IntKi), PARAMETER :: NumInp = 3 !< Number of inputs sent to SrvD_UpdateStates ! Program variables @@ -51,12 +51,13 @@ PROGRAM SrvD_Driver INTEGER(IntKi) :: n !< Loop counter (for time step) + INTEGER(IntKi) :: j !< Loop counter (for interpolation time history) INTEGER(IntKi) :: ErrStat !< Status of error message CHARACTER(ErrMsgLen) :: ErrMsg !< Error message if ErrStat /= ErrID_None REAL(R8Ki), allocatable :: dYdu(:,:) INTEGER(IntKi) :: Un - INTEGER(IntKi), parameter :: nMax = 80 + INTEGER(IntKi) :: nMax CHARACTER(1024) :: OutFile @@ -77,16 +78,37 @@ PROGRAM SrvD_Driver ! Set the driver's request for time interval here: - TimeInterval = 0.25 ! Glue code's request for delta time (likely based on information from other modules) - - + TimeInterval = 0.01 ! s + InitInData%InputFile = 'ServoDyn.dat' + InitInData%RootName = OutFile(1:(len_trim(OutFile)-4)) + InitInData%NumBl = 3 + InitInData%gravity = 9.81 !m/s^2 + InitInData%r_N_O_G = (/ 90.0, 0.0, 0.0 /) ! m, position of nacelle (for NTMD) + InitInData%r_TwrBase = (/ 0.0, 0.0, 0.0 /) ! m, position of tower base (for TTMD) + InitInData%TMax = 10.0 !s + InitInData%AirDens = 1.225 !kg/m^3 + InitInData%AvgWindSpeed = 10.0 !m/s + InitInData%Linearize = .false. + InitInData%NumSC2Ctrl = 0 + InitInData%NumCtrl2SC = 0 + + CALL AllocAry(InitInData%BlPitchInit, InitInData%NumBl, 'BlPitchInit', ErrStat, ErrMsg) + IF ( ErrStat /= ErrID_None ) THEN + CALL WrScr( ErrMsg ) + END IF + InitInData%BlPitchInit = 5.0*pi/180.0 ! radians + + ! Initialize the module CALL SrvD_Init( InitInData, u(1), p, x, xd, z, OtherState, y, misc, TimeInterval, InitOutData, ErrStat, ErrMsg ) IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary CALL WrScr( ErrMsg ) + IF (ErrStat >= AbortErrLev) call ProgAbort('') END IF + nMax = nint(InitInData%TMax/TimeInterval) + ! Destroy initialization data @@ -94,36 +116,62 @@ PROGRAM SrvD_Driver CALL SrvD_DestroyInitOutput( InitOutData, ErrStat, ErrMsg ) + Time = 0.0_ReKi + DO j = 1, NumInp + InputTime(j) = Time - j*TimeInterval + END DO + DO j = 2, NumInp + CALL SrvD_CopyInput (u(1), u(j), MESH_NEWCOPY, ErrStat, ErrMsg) + END DO + !............................................................................................................................... ! Check the results of the Jacobian routines !............................................................................................................................... - Time = 0.0_ReKi - + + CALL SrvD_CalcOutput( Time, u(1), p, x, xd, z, OtherState, y, misc, ErrStat, ErrMsg ) + IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary + CALL WrScr( ErrMsg ) + END IF + write(Un,'(600(ES15.5,1x))') Time, y%BlPitchCom, y%WriteOutput + + + DO n = 0,nMax ! Modify u for inputs at n (likely from the outputs of another module or a set of test conditions) here: + DO j = NumInp-1, 1, -1 + CALL SrvD_CopyInput (u(j), u(j+1), MESH_UPDATECOPY, ErrStat, ErrMsg) + InputTime(j+1) = InputTime(j) + END DO + InputTime(1) = Time + u(1)%BlPitch = y%BlPitchCom - u(1)%HSS_Spd = (2000.0_ReKi)/nMax * RPM2RPS * n + !u(1)%HSS_Spd = (2000.0_ReKi)/nMax * RPM2RPS * n + CALL SrvD_UpdateStates( Time, n, u, InputTime, p, x, xd, z, OtherState, misc, ErrStat, ErrMsg ) + IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary + CALL WrScr( ErrMsg ) + END IF + ! Calculate outputs at n - + Time = (n+1)*TimeInterval CALL SrvD_CalcOutput( Time, u(1), p, x, xd, z, OtherState, y, misc, ErrStat, ErrMsg ) IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary CALL WrScr( ErrMsg ) END IF - call SrvD_JacobianPInput( Time, u(1), p, x, xd, z, OtherState, y, misc, ErrStat, ErrMsg, dYdu) + !call SrvD_JacobianPInput( Time, u(1), p, x, xd, z, OtherState, y, misc, ErrStat, ErrMsg, dYdu) - write(Un,'(100(ES15.5,1x))') u(1)%Yaw, u(1)%YawRate, u(1)%HSS_Spd, y%YawMom, y%GenTrq, y%ElecPwr, dYdu(4,1), dYdu(4,2), dYdu(5,3), dYdu(6,3) + !write(Un,'(100(ES15.5,1x))') u(1)%Yaw, u(1)%YawRate, u(1)%HSS_Spd, y%YawMom, y%GenTrq, y%ElecPwr, dYdu(4,1), dYdu(4,2), dYdu(5,3), dYdu(6,3) + write(Un,'(600(ES15.5,1x))') Time, y%BlPitchCom, y%WriteOutput END DO close (un) - !............................................................................................................................... ! Routine to terminate program execution !............................................................................................................................... diff --git a/modules/servodyn/src/ServoDyn_Registry.txt b/modules/servodyn/src/ServoDyn_Registry.txt index 1577140e89..6e1c5b8120 100644 --- a/modules/servodyn/src/ServoDyn_Registry.txt +++ b/modules/servodyn/src/ServoDyn_Registry.txt @@ -29,6 +29,9 @@ typedef ^ InitInputType ReKi AvgWindSpeed - - - "average wind speed for the simu typedef ^ InitInputType ReKi AirDens - - - "air density" kg/m^3 typedef ^ InitInputType IntKi NumSC2Ctrl - - - "number of controller inputs [from supercontroller]" - typedef ^ InitInputType IntKi NumCtrl2SC - - - "number of controller outputs [to supercontroller]" - +typedef ^ InitInputType IntKi TrimCase - - - "Controller parameter to be trimmed {1:yaw; 2:torque; 3:pitch} [used only if CalcSteady=True]" - +typedef ^ InitInputType ReKi TrimGain - - - "Proportional gain for the rotational speed error (>0) [used only if TrimCase>0]" "rad/(rad/s) for yaw or pitch; Nm/(rad/s) for torque" +typedef ^ InitInputType ReKi RotSpeedRef - - - "Reference rotor speed" "rad/s" # Define outputs from the initialization routine here: typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - "Names of the output-to-file channels" - @@ -118,6 +121,7 @@ typedef ^ SrvD_InputFile ReKi GenPwr_Dem - - - "Record 13: Demanded power [used typedef ^ SrvD_InputFile IntKi DLL_NumTrq - - - "Record 26: No. of points in torque-speed look-up table {0 = none and use the optimal mode PARAMETERs instead, nonzero = ignore the optimal mode PARAMETERs by setting Gain_OM (Record 16) to 0.0} [used only with DLL Interface]" - typedef ^ SrvD_InputFile ReKi GenSpd_TLU {:} - - "Records R:2:R+2*DLL_NumTrq-2: Generator speed values in look-up table [used only with DLL Interface]" rad/s typedef ^ SrvD_InputFile ReKi GenTrq_TLU {:} - - "Records R+1:2:R+2*DLL_NumTrq-1: Generator torque values in look-up table [used only with DLL Interface]" Nm +typedef ^ SrvD_InputFile LOGICAL UseLegacyInterface - - - "Flag that determines if the legacy Bladed interface is (legacy=DISCON with avrSWAP instead of CONTROLLER)" - typedef ^ SrvD_InputFile LOGICAL CompNTMD - - - "Compute nacelle tuned mass damper {true/false}" - typedef ^ SrvD_InputFile CHARACTER(1024) NTMDfile - - - "File for nacelle tuned mass damper (quoted string)" - typedef ^ SrvD_InputFile LOGICAL CompTTMD - - - "Compute tower tuned mass damper {true/false}" - @@ -125,15 +129,74 @@ typedef ^ SrvD_InputFile CHARACTER(1024) TTMDfile - - - "File for tower tuned ma # ..... Data for using Bladed DLLs ....................................................................................................... typedef ^ BladedDLLType SiKi avrSWAP {:} - - "The swap array: used to pass data to and from the DLL controller" "see Bladed DLL documentation" -typedef ^ BladedDLLType ReKi HSSBrFrac - - - "Fraction of full braking torque: 0 (off) <= HSSBrFrac <= 1 (full) - from Bladed DLL" - -typedef ^ BladedDLLType ReKi HSSBrTrqC - - - "Braking torque" N-m +typedef ^ BladedDLLType ReKi HSSBrTrqDemand - - - "Demanded braking torque - from Bladed DLL" - typedef ^ BladedDLLType ReKi YawRateCom - - - "Nacelle yaw rate demanded from Bladed DLL" rad/s typedef ^ BladedDLLType ReKi GenTrq - - - "Electrical generator torque from Bladed DLL" N-m -typedef ^ BladedDLLType IntKi GenState - - - "Generator state from Bladed DLL" N-m -#typedef ^ BladedDLLType ReKi ElecPwr - - - "Electrical power sent to Bladed DLL" W +typedef ^ BladedDLLType IntKi GenState - - - "Generator state from Bladed DLL" - typedef ^ BladedDLLType ReKi BlPitchCom 3 - - "Commanded blade pitch angles" radians typedef ^ BladedDLLType ReKi PrevBlPitch 3 - - "Previously commanded blade pitch angles" radians +typedef ^ BladedDLLType ReKi ElecPwr_prev - - - "Electrical power (from previous step), sent to Bladed DLL" W +typedef ^ BladedDLLType ReKi GenTrq_prev - - - "Electrical generator torque (from previous step), sent to Bladed DLL" N-m typedef ^ BladedDLLType SiKi SCoutput {:} - - "controller output to supercontroller" - +typedef ^ BladedDLLType logical initialized - - - "flag that determines if DLL has been called (for difference between CalcOutput and UpdateStates)" - +typedef ^ BladedDLLType INTEGER NumLogChannels - - - "number of log channels from controller" - +typedef ^ BladedDLLType OutParmType LogChannels_OutParam {:} - - "Names and units (and other characteristics) of logging outputs from DLL" - +typedef ^ BladedDLLType ReKi LogChannels {:} - - "logging outputs from controller" - +typedef ^ BladedDLLType IntKi ErrStat - - - "error message from external controller API" - +typedef ^ BladedDLLType CHARACTER(ErrMsgLen) ErrMsg - - - "error message from external controller API" - +typedef ^ BladedDLLType R8Ki CurrentTime - - - "Current Simulation Time" s +typedef ^ BladedDLLType IntKi SimStatus - - - "simulation status (see avrSWAP(1): Status flag set as follows: 0 if this is the first call, 1 for all subsequent time steps, -1 if this is the final call at the end of the simulation)" - +typedef ^ BladedDLLType IntKi ShaftBrakeStatusBinaryFlag - - - "binary flag indicating (on/off) status for shaft brake 1, shaft brake 2, generator brake, shaft brake 3, or brake torque set separately (0, 1, or 16 allowed in FAST)"- +typedef ^ BladedDLLType LOGICAL HSSBrDeployed - - - "Whether the HSS brake has been deployed" - +typedef ^ BladedDLLType R8Ki TimeHSSBrFullyDeployed - - - "Time at which the controller high-speed shaft is fully deployed" s +typedef ^ BladedDLLType R8Ki TimeHSSBrDeployed - - - "Time at which the controller high-speed shaft is first deployed" s +typedef ^ BladedDLLType LOGICAL OverrideYawRateWithTorque - - - "acts similiar to Yaw_Cntrl" - +typedef ^ BladedDLLType ReKi YawTorqueDemand - - - "Demanded yaw actuator torque (override of yaw rate control)" Nm +## these are INPUTS copied to the DLL: +typedef ^ BladedDLLType ReKi BlPitchInput {:} - - "Input blade pitch angles" radians +typedef ^ BladedDLLType ReKi YawAngleFromNorth - - - "Yaw angle of the nacelle relative to North (see NacYaw_North)" rad +typedef ^ BladedDLLType ReKi HorWindV - - - "Horizontal hub-height wind velocity magnitude" m/s +typedef ^ BladedDLLType ReKi HSS_Spd - - - "High-speed shaft (HSS) speed" rad/s +typedef ^ BladedDLLType ReKi YawErr - - - "Yaw error" radians +typedef ^ BladedDLLType ReKi RotSpeed - - - "Rotor azimuth angular speed" rad/s +typedef ^ BladedDLLType ReKi YawBrTAxp - - - "Tower-top / yaw bearing fore-aft (translational) acceleration (absolute)" m/s^2 +typedef ^ BladedDLLType ReKi YawBrTAyp - - - "Tower-top / yaw bearing side-to-side (translational) acceleration (absolute)" m/s^2 +typedef ^ BladedDLLType ReKi LSSTipMys - - - "Nonrotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader)" N-m +typedef ^ BladedDLLType ReKi LSSTipMzs - - - "Nonrotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader)" N-m +typedef ^ BladedDLLType ReKi LSSTipMya - - - "Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader)" N-m +typedef ^ BladedDLLType ReKi LSSTipMza - - - "Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader)" N-m +typedef ^ BladedDLLType ReKi LSSTipPxa - - - "Rotor azimuth angle (position)" radians +typedef ^ BladedDLLType ReKi Yaw - - - "Current nacelle yaw" radians +typedef ^ BladedDLLType ReKi YawRate - - - "Current nacelle yaw rate" rad/s +typedef ^ BladedDLLType ReKi YawBrMyn - - - "Rotating (with nacelle) tower-top / yaw bearing pitch moment" N-m +typedef ^ BladedDLLType ReKi YawBrMzn - - - "Tower-top / yaw bearing yaw moment" N-m +typedef ^ BladedDLLType ReKi NcIMURAxs - - - "Nacelle inertial measurement unit angular (rotational) acceleration (absolute)" rad/s^2 +typedef ^ BladedDLLType ReKi NcIMURAys - - - "Nacelle inertial measurement unit angular (rotational) acceleration (absolute)" rad/s^2 +typedef ^ BladedDLLType ReKi NcIMURAzs - - - "Nacelle inertial measurement unit angular (rotational) acceleration (absolute)" rad/s^2 +typedef ^ BladedDLLType ReKi RotPwr - - - "Rotor power (this is equivalent to the low-speed shaft power)" W +typedef ^ BladedDLLType ReKi LSSTipMxa - - - "Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader)" N-m +typedef ^ BladedDLLType ReKi RootMyc 3 - - "Out-of-plane moment (i.e., the moment caused by out-of-plane forces) at the blade root for each of the blades (max 3)" N-m +typedef ^ BladedDLLType ReKi RootMxc 3 - - "In-plane moment (i.e., the moment caused by in-plane forces) at the blade root" N-m +## these are PARAMETERS sent to the DLL (THEIR VALUES SHOULD NOT CHANGE DURING SIMULATION): +typedef ^ BladedDLLType DbKi DLL_DT - - - "interval for calling DLL (integer multiple number of DT)" s +typedef ^ BladedDLLType CHARACTER(1024) DLL_InFile - - - "Name of input file used in DLL" - +typedef ^ BladedDLLType CHARACTER(1024) RootName - - - "RootName for writing output files" - +typedef ^ BladedDLLType ReKi GenTrq_Dem - - - "Demanded generator torque above rated" Nm +typedef ^ BladedDLLType ReKi GenSpd_Dem - - - "Demanded generator speed above rated" rad/s +typedef ^ BladedDLLType ReKi Ptch_Max - - - "Maximum pitch angle" rad +typedef ^ BladedDLLType ReKi Ptch_Min - - - "Minimum pitch angle" rad +typedef ^ BladedDLLType ReKi Ptch_SetPnt - - - "Below-rated pitch angle set-point" rad +typedef ^ BladedDLLType ReKi PtchRate_Max - - - "Maximum pitch rate" rad/s +typedef ^ BladedDLLType ReKi PtchRate_Min - - - "Minimum pitch rate (most negative value allowed)" rad/s +typedef ^ BladedDLLType ReKi GenPwr_Dem - - - "Demanded power (This is not valid for variable-speed, pitch-regulated controllers.)" W +typedef ^ BladedDLLType ReKi Gain_OM - - - "Optimal mode gain" Nm/(rad/s)^2 +typedef ^ BladedDLLType ReKi GenSpd_MaxOM - - - "Optimal mode maximum speed" rad/s +typedef ^ BladedDLLType ReKi GenSpd_MinOM - - - "Minimum generator speed" rad/s +typedef ^ BladedDLLType IntKi Ptch_Cntrl - - - "Pitch control: 0 = collective; 1 = individual" - +typedef ^ BladedDLLType IntKi DLL_NumTrq - - - "No. of points in torque-speed look-up table, 0 = none and use the optimal mode PARAMETERs instead; nonzero = ignore the optimal mode PARAMETERs by setting Record 16 to 0.0" - +typedef ^ BladedDLLType ReKi GenSpd_TLU {:} - - "Table (array) containing DLL_NumTrq generator speeds for the torque-speed table look-up (TLU) -- this should be defined using an array constructor; for example, if DLL_NumTrq = 3, GenSpd_TLU(DLL_NumTrq) = (/ 0.0, 99.9, 999.9 /)" rad/s +typedef ^ BladedDLLType ReKi GenTrq_TLU {:} - - "Table (array) containing DLL_NumTrq generator torques for the torque-speed table look-up (TLU) -- this should be defined using an array constructor, for example, if DLL_NumTrq = 3, GenTrq_TLU(DLL_NumTrq) = (/ 0.0, 10, 200.0 /)" Nm +typedef ^ BladedDLLType IntKi Yaw_Cntrl - - - "Yaw control: 0 = rate; 1 = torque" - # ..... States .................................................................................................................... # Define continuous (differentiable) states here: @@ -142,6 +205,7 @@ typedef ^ ContinuousStateType TMD_ContinuousStateType NTMD - - - "TMD module sta typedef ^ ContinuousStateType TMD_ContinuousStateType TTMD - - - "TMD module states - tower" - # Define discrete (nondifferentiable) states here: +typedef ^ DiscreteStateType ReKi CtrlOffset - - - "Controller offset parameter" N-m #typedef ^ DiscreteStateType ReKi BlPitchFilter {:} - - "blade pitch filter" - typedef ^ DiscreteStateType TMD_DiscreteStateType NTMD - - - "TMD module states - nacelle" - typedef ^ DiscreteStateType TMD_DiscreteStateType TTMD - - - "TMD module states - tower" - @@ -185,7 +249,6 @@ typedef ^ MiscVarType TMD_MiscVarType TTMD - - - "TMD module misc vars - tower" # 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 DbKi HSSBrDT - - - "Time it takes for HSS brake to reach full deployment once deployed" seconds -typedef ^ ParameterType ReKi HSSBrFrac - - - "Fraction of full braking torque: 0 (off) <= HSSBrFrac <= 1 (full), (-)" - typedef ^ ParameterType ReKi HSSBrTqF - - - "Fully deployed HSS brake torque" typedef ^ ParameterType ReKi SIG_POSl - - - "Pullout slip" typedef ^ ParameterType ReKi SIG_POTq - - - "Pullout torque" @@ -210,7 +273,6 @@ typedef ^ ParameterType ReKi GenEff - - - "Generator efficiency" typedef ^ ParameterType ReKi BlPitchInit {:} - - "Initial blade pitch angles" radians typedef ^ ParameterType ReKi BlPitchF {:} - - "Final blade pitch" typedef ^ ParameterType ReKi PitManRat {:} - - "Pitch rates at which override pitch maneuvers head toward final pitch angles (does not include sign)" rad/s -typedef ^ ParameterType ReKi BlAlpha typedef ^ ParameterType ReKi YawManRat - - - "Yaw rate at which override yaw maneuver head toward for final yaw angle (does not include sign)" rad/s typedef ^ ParameterType ReKi NacYawF - - - "Final yaw angle after override yaw maneuver" typedef ^ ParameterType ReKi SpdGenOn - - - "Generator speed to turn on the generator for a startup" @@ -250,55 +312,46 @@ typedef ^ ParameterType LOGICAL CompNTMD - - - "Compute nacelle tuned mass dampe typedef ^ ParameterType LOGICAL CompTTMD - - - "Compute tower tuned mass damper {true/false}" - # parameters for output typedef ^ ParameterType IntKi NumOuts - - - "Number of parameters in the output list (number of outputs requested)" - +typedef ^ ParameterType IntKi NumOuts_DLL - - - "Number of logging channels output from the DLL (set at initialization)" - typedef ^ ParameterType CHARACTER(1024) RootName - - - "RootName for writing output files" - typedef ^ ParameterType OutParmType OutParam {:} - - "Names and units (and other characteristics) of all requested output parameters" - typedef ^ ParameterType CHARACTER(1) Delim - - - "Column delimiter for output text files" - # parameters for Bladed Interface (dynamic-link library) typedef ^ ParameterType LOGICAL UseBladedInterface - - - "Flag that determines if BladedInterface was used" - +typedef ^ ParameterType LOGICAL UseLegacyInterface - - - "Flag that determines if the legacy Bladed interface is (legacy=DISCON with avrSWAP instead of CONTROLLER)" - +typedef ^ ParameterType DLL_Type DLL_Trgt - - - "The addresses and names of the Bladed DLL and its procedure" - typedef ^ ParameterType LOGICAL DLL_Ramp - - - "determines if there is a DLL_DT-ramp time delay (true only when DLL_DT /= DT)" - -typedef ^ ParameterType DbKi DLL_DT - - - "interval for calling DLL (integer multiple number of DT)" s -typedef ^ ParameterType IntKi DLL_NumTrq - - - "No. of points in torque-speed look-up table, 0 = none and use the optimal mode PARAMETERs instead; nonzero = ignore the optimal mode PARAMETERs by setting Record 16 to 0.0" - -typedef ^ ParameterType IntKi Ptch_Cntrl - - - "Pitch control: 0 = collective; 1 = individual" - -typedef ^ ParameterType ReKi Gain_OM - - - "Optimal mode gain" Nm/(rad/s)^2 -typedef ^ ParameterType ReKi GenPwr_Dem - - - "Demanded power" W -typedef ^ ParameterType ReKi GenSpd_Dem - - - "Demanded generator speed above rated" rad/s -typedef ^ ParameterType ReKi GenSpd_MaxOM - - - "Optimal mode maximum speed" rad/s -typedef ^ ParameterType ReKi GenSpd_MinOM - - - "Minimum generator speed" rad/s -typedef ^ ParameterType ReKi GenSpd_TLU {:} - - "Table (array) containing DLL_NumTrq generator speeds for the torque-speed table look-up (TLU) -- this should be defined using an array constructor; for example, if DLL_NumTrq = 3, GenSpd_TLU(DLL_NumTrq) = (/ 0.0, 99.9, 999.9 /)" rad/s -typedef ^ ParameterType ReKi GenTrq_Dem - - - "Demanded generator torque" Nm -typedef ^ ParameterType ReKi GenTrq_TLU {:} - - "Table (array) containing DLL_NumTrq generator torques for the torque-speed table look-up (TLU) -- this should be defined using an array constructor, for example, if DLL_NumTrq = 3, GenTrq_TLU(DLL_NumTrq) = (/ 0.0, 10, 200.0 /)" Nm -typedef ^ ParameterType ReKi Ptch_Max - - - "Maximum pitch angle" rad -typedef ^ ParameterType ReKi Ptch_Min - - - "Minimum pitch angle" rad -typedef ^ ParameterType ReKi Ptch_SetPnt - - - "Below-rated pitch angle set-point" rad -typedef ^ ParameterType ReKi PtchRate_Max - - - "Maximum pitch rate" rad/s -typedef ^ ParameterType ReKi PtchRate_Min - - - "Minimum pitch rate (most negative value allowed)" rad/s +typedef ^ ParameterType ReKi BlAlpha - - - "parameter for low-pass filter of blade pitch commands from the controller DLL" - +typedef ^ ParameterType IntKi DLL_n - - - "number of steps between the controller being called and SrvD being called" - +typedef ^ ParameterType IntKi avcOUTNAME_LEN - - - "Length of the avcOUTNAME character array passed to/from the DLL" - typedef ^ ParameterType ReKi NacYaw_North - - - "Reference yaw angle of the nacelle when the upwind end points due North" rad -typedef ^ ParameterType CHARACTER(1024) DLL_InFile - - - "Name of input file used in DLL" - -typedef ^ ParameterType DLL_Type DLL_Trgt - - - "The addresses and names of the Bladed DLL and its procedure" - -typedef ^ ParameterType TMD_ParameterType NTMD - - - "TMD module parameters - nacelle" - -typedef ^ ParameterType TMD_ParameterType TTMD - - - "TMD module parameters - tower" - typedef ^ ParameterType ReKi AvgWindSpeed - - - "average wind speed for the simulation" m/s typedef ^ ParameterType ReKi AirDens - - - "air density" kg/m^3 +# parameters for trim-case (linearization): +typedef ^ ParameterType IntKi TrimCase - - - "Controller parameter to be trimmed {1:yaw; 2:torque; 3:pitch} [used only if CalcSteady=True]" - +typedef ^ ParameterType ReKi TrimGain - - - "Proportional gain for the rotational speed error (>0) [used only if TrimCase>0]" "rad/(rad/s) for yaw or pitch; Nm/(rad/s) for torque" +typedef ^ ParameterType ReKi RotSpeedRef - - - "Reference rotor speed" "rad/s" +# parameters for other modules: +typedef ^ ParameterType TMD_ParameterType NTMD - - - "TMD module parameters - nacelle" - +typedef ^ ParameterType TMD_ParameterType TTMD - - - "TMD module parameters - tower" - # ..... Inputs .................................................................................................................... -# Define inputs that are contained on the mesh here: -#typedef ^ InputType MeshType MeshedInput - - - "Meshed input data" - # Define inputs that are not on this mesh here: -typedef ^ InputType ReKi BlPitch {:} - - "Current blade pitch angles" radians -typedef ^ InputType ReKi Yaw - - - "Current nacelle yaw" radians +typedef ^ InputType ReKi BlPitch {:} - 2pi "Current blade pitch angles" radians +typedef ^ InputType ReKi Yaw - - 2pi "Current nacelle yaw" radians typedef ^ InputType ReKi YawRate - - - "Current nacelle yaw rate" rad/s typedef ^ InputType ReKi LSS_Spd - - - "Low-speed shaft (LSS) speed at entrance to gearbox" rad/s typedef ^ InputType ReKi HSS_Spd - - - "High-speed shaft (HSS) speed" rad/s typedef ^ InputType ReKi RotSpeed - - - "Rotor azimuth angular speed" rad/s -typedef ^ InputType ReKi ExternalYawPosCom - - - "Commanded nacelle yaw position from Simulink or Labview" radians +typedef ^ InputType ReKi ExternalYawPosCom - - 2pi "Commanded nacelle yaw position from Simulink or Labview" radians typedef ^ InputType ReKi ExternalYawRateCom - - - "Commanded nacelle yaw rate from Simulink or Labview" rad/s -typedef ^ InputType ReKi ExternalBlPitchCom {:} - - "Commanded blade pitch from Simulink or LabVIEW" radians +typedef ^ InputType ReKi ExternalBlPitchCom {:} - 2pi "Commanded blade pitch from Simulink or LabVIEW" radians typedef ^ InputType ReKi ExternalGenTrq - - - "Electrical generator torque from Simulink or LabVIEW" N-m typedef ^ InputType ReKi ExternalElecPwr - - - "Electrical power from Simulink or LabVIEW" W typedef ^ InputType ReKi ExternalHSSBrFrac - - - "Fraction of full braking torque: 0 (off) <= HSSBrFrac <= 1 (full) from Simulink or LabVIEW" - typedef ^ InputType ReKi TwrAccel - - - "Tower acceleration for tower feedback control (user routine only)" m/s^2 -typedef ^ InputType ReKi YawErr - - - "Yaw error" radians -typedef ^ InputType ReKi WindDir - - - "Wind direction" radians +typedef ^ InputType ReKi YawErr - - 2pi "Yaw error" radians +typedef ^ InputType ReKi WindDir - - 2pi "Wind direction" radians typedef ^ InputType ReKi RootMyc 3 - - "Out-of-plane moment (i.e., the moment caused by out-of-plane forces) at the blade root for each of the blades (max 3)" N-m typedef ^ InputType ReKi YawBrTAxp - - - "Tower-top / yaw bearing fore-aft (translational) acceleration (absolute)" m/s^2 typedef ^ InputType ReKi YawBrTAyp - - - "Tower-top / yaw bearing side-to-side (translational) acceleration (absolute)" m/s^2 @@ -316,9 +369,7 @@ typedef ^ InputType ReKi NcIMURAys - - - "Nacelle inertial measurement unit angu typedef ^ InputType ReKi NcIMURAzs - - - "Nacelle inertial measurement unit angular (rotational) acceleration (absolute)" rad/s^2 typedef ^ InputType ReKi RotPwr - - - "Rotor power (this is equivalent to the low-speed shaft power)" W typedef ^ InputType ReKi HorWindV - - - "Horizontal hub-height wind velocity magnitude" m/s -typedef ^ InputType ReKi YawAngle - - - "Estimate of yaw (nacelle + platform)" radians -typedef ^ InputType ReKi ElecPwr_prev - - - "Electrical power (from previous step), sent to Bladed DLL" W -typedef ^ InputType ReKi GenTrq_prev - - - "Electrical generator torque (from previous step), sent to Bladed DLL" N-m +typedef ^ InputType ReKi YawAngle - - 2pi "Estimate of yaw (nacelle + platform)" radians typedef ^ InputType TMD_InputType NTMD - - - "TMD module inputs - nacelle" - typedef ^ InputType TMD_InputType TTMD - - - "TMD module inputs - tower" - typedef ^ InputType SiKi SuperController {:} - - "A swap array: used to pass input data to the DLL controller from the supercontroller" - @@ -328,7 +379,7 @@ typedef ^ InputType SiKi SuperController {:} - - "A swap array: used to pass inp #typedef ^ OutputType MeshType MeshedOutput - - - "Meshed output data" - # Define outputs that are not on this mesh here: typedef ^ OutputType ReKi WriteOutput {:} - - "Data to be written to an output file: see WriteOutputHdr for names of each variable" "see WriteOutputUnt" -typedef ^ OutputType ReKi BlPitchCom {:} - - "Commanded blade pitch angles" radians +typedef ^ OutputType ReKi BlPitchCom {:} - 2pi "Commanded blade pitch angles" radians typedef ^ OutputType ReKi YawMom - - - "Torque transmitted through the yaw bearing" N-m typedef ^ OutputType ReKi GenTrq - - - "Electrical generator torque" N-m typedef ^ OutputType ReKi HSSBrTrqC - - - "Commanded HSS brake torque" N-m diff --git a/modules/servodyn/src/ServoDyn_Types.f90 b/modules/servodyn/src/ServoDyn_Types.f90 index 1b13f3e024..6e962a603c 100644 --- a/modules/servodyn/src/ServoDyn_Types.f90 +++ b/modules/servodyn/src/ServoDyn_Types.f90 @@ -49,6 +49,9 @@ MODULE ServoDyn_Types REAL(ReKi) :: AirDens !< air density [kg/m^3] INTEGER(IntKi) :: NumSC2Ctrl !< number of controller inputs [from supercontroller] [-] INTEGER(IntKi) :: NumCtrl2SC !< number of controller outputs [to supercontroller] [-] + INTEGER(IntKi) :: TrimCase !< Controller parameter to be trimmed {1:yaw; 2:torque; 3:pitch} [used only if CalcSteady=True] [-] + REAL(ReKi) :: TrimGain !< Proportional gain for the rotational speed error (>0) [used only if TrimCase>0] [rad/(rad/s) for yaw or pitch; Nm/(rad/s) for torque] + REAL(ReKi) :: RotSpeedRef !< Reference rotor speed [rad/s] END TYPE SrvD_InitInputType ! ======================= ! ========= SrvD_InitOutputType ======= @@ -138,6 +141,7 @@ MODULE ServoDyn_Types INTEGER(IntKi) :: DLL_NumTrq !< Record 26: No. of points in torque-speed look-up table {0 = none and use the optimal mode PARAMETERs instead, nonzero = ignore the optimal mode PARAMETERs by setting Gain_OM (Record 16) to 0.0} [used only with DLL Interface] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: GenSpd_TLU !< Records R:2:R+2*DLL_NumTrq-2: Generator speed values in look-up table [used only with DLL Interface] [rad/s] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: GenTrq_TLU !< Records R+1:2:R+2*DLL_NumTrq-1: Generator torque values in look-up table [used only with DLL Interface] [Nm] + LOGICAL :: UseLegacyInterface !< Flag that determines if the legacy Bladed interface is (legacy=DISCON with avrSWAP instead of CONTROLLER) [-] LOGICAL :: CompNTMD !< Compute nacelle tuned mass damper {true/false} [-] CHARACTER(1024) :: NTMDfile !< File for nacelle tuned mass damper (quoted string) [-] LOGICAL :: CompTTMD !< Compute tower tuned mass damper {true/false} [-] @@ -147,14 +151,72 @@ MODULE ServoDyn_Types ! ========= BladedDLLType ======= TYPE, PUBLIC :: BladedDLLType REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: avrSWAP !< The swap array: used to pass data to and from the DLL controller [see Bladed DLL documentation] - REAL(ReKi) :: HSSBrFrac !< Fraction of full braking torque: 0 (off) <= HSSBrFrac <= 1 (full) - from Bladed DLL [-] - REAL(ReKi) :: HSSBrTrqC !< Braking torque [N-m] + REAL(ReKi) :: HSSBrTrqDemand !< Demanded braking torque - from Bladed DLL [-] REAL(ReKi) :: YawRateCom !< Nacelle yaw rate demanded from Bladed DLL [rad/s] REAL(ReKi) :: GenTrq !< Electrical generator torque from Bladed DLL [N-m] - INTEGER(IntKi) :: GenState !< Generator state from Bladed DLL [N-m] + INTEGER(IntKi) :: GenState !< Generator state from Bladed DLL [-] REAL(ReKi) , DIMENSION(1:3) :: BlPitchCom !< Commanded blade pitch angles [radians] REAL(ReKi) , DIMENSION(1:3) :: PrevBlPitch !< Previously commanded blade pitch angles [radians] + REAL(ReKi) :: ElecPwr_prev !< Electrical power (from previous step), sent to Bladed DLL [W] + REAL(ReKi) :: GenTrq_prev !< Electrical generator torque (from previous step), sent to Bladed DLL [N-m] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: SCoutput !< controller output to supercontroller [-] + LOGICAL :: initialized !< flag that determines if DLL has been called (for difference between CalcOutput and UpdateStates) [-] + INTEGER(IntKi) :: NumLogChannels !< number of log channels from controller [-] + TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: LogChannels_OutParam !< Names and units (and other characteristics) of logging outputs from DLL [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: LogChannels !< logging outputs from controller [-] + INTEGER(IntKi) :: ErrStat !< error message from external controller API [-] + CHARACTER(ErrMsgLen) :: ErrMsg !< error message from external controller API [-] + REAL(R8Ki) :: CurrentTime !< Current Simulation Time [s] + INTEGER(IntKi) :: SimStatus !< simulation status (see avrSWAP(1): Status flag set as follows: 0 if this is the first call, 1 for all subsequent time steps, -1 if this is the final call at the end of the simulation) [-] + INTEGER(IntKi) :: ShaftBrakeStatusBinaryFlag !< binary flag indicating (on/off) status for shaft brake 1, shaft brake 2, generator brake, shaft brake 3, or brake torque set separately (0, 1, or 16 allowed in FAST) [-] + LOGICAL :: HSSBrDeployed !< Whether the HSS brake has been deployed [-] + REAL(R8Ki) :: TimeHSSBrFullyDeployed !< Time at which the controller high-speed shaft is fully deployed [s] + REAL(R8Ki) :: TimeHSSBrDeployed !< Time at which the controller high-speed shaft is first deployed [s] + LOGICAL :: OverrideYawRateWithTorque !< acts similiar to Yaw_Cntrl [-] + REAL(ReKi) :: YawTorqueDemand !< Demanded yaw actuator torque (override of yaw rate control) [Nm] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlPitchInput !< Input blade pitch angles [radians] + REAL(ReKi) :: YawAngleFromNorth !< Yaw angle of the nacelle relative to North (see NacYaw_North) [rad] + REAL(ReKi) :: HorWindV !< Horizontal hub-height wind velocity magnitude [m/s] + REAL(ReKi) :: HSS_Spd !< High-speed shaft (HSS) speed [rad/s] + REAL(ReKi) :: YawErr !< Yaw error [radians] + REAL(ReKi) :: RotSpeed !< Rotor azimuth angular speed [rad/s] + REAL(ReKi) :: YawBrTAxp !< Tower-top / yaw bearing fore-aft (translational) acceleration (absolute) [m/s^2] + REAL(ReKi) :: YawBrTAyp !< Tower-top / yaw bearing side-to-side (translational) acceleration (absolute) [m/s^2] + REAL(ReKi) :: LSSTipMys !< Nonrotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] + REAL(ReKi) :: LSSTipMzs !< Nonrotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] + REAL(ReKi) :: LSSTipMya !< Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] + REAL(ReKi) :: LSSTipMza !< Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] + REAL(ReKi) :: LSSTipPxa !< Rotor azimuth angle (position) [radians] + REAL(ReKi) :: Yaw !< Current nacelle yaw [radians] + REAL(ReKi) :: YawRate !< Current nacelle yaw rate [rad/s] + REAL(ReKi) :: YawBrMyn !< Rotating (with nacelle) tower-top / yaw bearing pitch moment [N-m] + REAL(ReKi) :: YawBrMzn !< Tower-top / yaw bearing yaw moment [N-m] + REAL(ReKi) :: NcIMURAxs !< Nacelle inertial measurement unit angular (rotational) acceleration (absolute) [rad/s^2] + REAL(ReKi) :: NcIMURAys !< Nacelle inertial measurement unit angular (rotational) acceleration (absolute) [rad/s^2] + REAL(ReKi) :: NcIMURAzs !< Nacelle inertial measurement unit angular (rotational) acceleration (absolute) [rad/s^2] + REAL(ReKi) :: RotPwr !< Rotor power (this is equivalent to the low-speed shaft power) [W] + REAL(ReKi) :: LSSTipMxa !< Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] + REAL(DbKi) :: DLL_DT !< interval for calling DLL (integer multiple number of DT) [s] + CHARACTER(1024) :: DLL_InFile !< Name of input file used in DLL [-] + CHARACTER(1024) :: RootName !< RootName for writing output files [-] + REAL(ReKi) :: GenTrq_Dem !< Demanded generator torque above rated [Nm] + REAL(ReKi) :: GenSpd_Dem !< Demanded generator speed above rated [rad/s] + REAL(ReKi) :: Ptch_Max !< Maximum pitch angle [rad] + REAL(ReKi) :: Ptch_Min !< Minimum pitch angle [rad] + REAL(ReKi) :: Ptch_SetPnt !< Below-rated pitch angle set-point [rad] + REAL(ReKi) :: PtchRate_Max !< Maximum pitch rate [rad/s] + REAL(ReKi) :: PtchRate_Min !< Minimum pitch rate (most negative value allowed) [rad/s] + REAL(ReKi) :: GenPwr_Dem !< Demanded power (This is not valid for variable-speed, pitch-regulated controllers.) [W] + REAL(ReKi) :: Gain_OM !< Optimal mode gain [Nm/(rad/s)^2] + REAL(ReKi) :: GenSpd_MaxOM !< Optimal mode maximum speed [rad/s] + REAL(ReKi) :: GenSpd_MinOM !< Minimum generator speed [rad/s] + INTEGER(IntKi) :: Ptch_Cntrl !< Pitch control: 0 = collective; 1 = individual [-] + INTEGER(IntKi) :: DLL_NumTrq !< No. of points in torque-speed look-up table, 0 = none and use the optimal mode PARAMETERs instead; nonzero = ignore the optimal mode PARAMETERs by setting Record 16 to 0.0 [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: GenSpd_TLU !< Table (array) containing DLL_NumTrq generator speeds for the torque-speed table look-up (TLU) -- this should be defined using an array constructor; for example, if DLL_NumTrq = 3, GenSpd_TLU(DLL_NumTrq) = (/ 0.0, 99.9, 999.9 /) [rad/s] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: GenTrq_TLU !< Table (array) containing DLL_NumTrq generator torques for the torque-speed table look-up (TLU) -- this should be defined using an array constructor, for example, if DLL_NumTrq = 3, GenTrq_TLU(DLL_NumTrq) = (/ 0.0, 10, 200.0 /) [Nm] + INTEGER(IntKi) :: Yaw_Cntrl !< Yaw control: 0 = rate; 1 = torque [-] + REAL(ReKi) , DIMENSION(1:3) :: RootMyc !< Out-of-plane moment (i.e., the moment caused by out-of-plane forces) at the blade root for each of the blades (max 3) [N-m] + REAL(ReKi) , DIMENSION(1:3) :: RootMxc !< In-plane moment (i.e., the moment caused by in-plane forces) at the blade root [N-m] END TYPE BladedDLLType ! ======================= ! ========= SrvD_ContinuousStateType ======= @@ -166,6 +228,7 @@ MODULE ServoDyn_Types ! ======================= ! ========= SrvD_DiscreteStateType ======= TYPE, PUBLIC :: SrvD_DiscreteStateType + REAL(ReKi) :: CtrlOffset !< Controller offset parameter [N-m] TYPE(TMD_DiscreteStateType) :: NTMD !< TMD module states - nacelle [-] TYPE(TMD_DiscreteStateType) :: TTMD !< TMD module states - tower [-] END TYPE SrvD_DiscreteStateType @@ -209,7 +272,6 @@ MODULE ServoDyn_Types TYPE, PUBLIC :: SrvD_ParameterType REAL(DbKi) :: DT !< Time step for continuous state integration & discrete state update [seconds] REAL(DbKi) :: HSSBrDT !< Time it takes for HSS brake to reach full deployment once deployed [seconds] - REAL(ReKi) :: HSSBrFrac !< Fraction of full braking torque: 0 (off) <= HSSBrFrac <= 1 (full), (-) [-] REAL(ReKi) :: HSSBrTqF !< Fully deployed HSS brake torque [-] REAL(ReKi) :: SIG_POSl !< Pullout slip [-] REAL(ReKi) :: SIG_POTq !< Pullout torque [-] @@ -234,7 +296,6 @@ MODULE ServoDyn_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlPitchInit !< Initial blade pitch angles [radians] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlPitchF !< Final blade pitch [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PitManRat !< Pitch rates at which override pitch maneuvers head toward final pitch angles (does not include sign) [rad/s] - REAL(ReKi) :: BlAlpha REAL(ReKi) :: YawManRat !< Yaw rate at which override yaw maneuver head toward for final yaw angle (does not include sign) [rad/s] REAL(ReKi) :: NacYawF !< Final yaw angle after override yaw maneuver [-] REAL(ReKi) :: SpdGenOn !< Generator speed to turn on the generator for a startup [-] @@ -273,34 +334,25 @@ MODULE ServoDyn_Types LOGICAL :: CompNTMD !< Compute nacelle tuned mass damper {true/false} [-] LOGICAL :: CompTTMD !< Compute tower tuned mass damper {true/false} [-] INTEGER(IntKi) :: NumOuts !< Number of parameters in the output list (number of outputs requested) [-] + INTEGER(IntKi) :: NumOuts_DLL !< Number of logging channels output from the DLL (set at initialization) [-] CHARACTER(1024) :: RootName !< RootName for writing output files [-] TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< Names and units (and other characteristics) of all requested output parameters [-] CHARACTER(1) :: Delim !< Column delimiter for output text files [-] LOGICAL :: UseBladedInterface !< Flag that determines if BladedInterface was used [-] + LOGICAL :: UseLegacyInterface !< Flag that determines if the legacy Bladed interface is (legacy=DISCON with avrSWAP instead of CONTROLLER) [-] + TYPE(DLL_Type) :: DLL_Trgt !< The addresses and names of the Bladed DLL and its procedure [-] LOGICAL :: DLL_Ramp !< determines if there is a DLL_DT-ramp time delay (true only when DLL_DT /= DT) [-] - REAL(DbKi) :: DLL_DT !< interval for calling DLL (integer multiple number of DT) [s] - INTEGER(IntKi) :: DLL_NumTrq !< No. of points in torque-speed look-up table, 0 = none and use the optimal mode PARAMETERs instead; nonzero = ignore the optimal mode PARAMETERs by setting Record 16 to 0.0 [-] - INTEGER(IntKi) :: Ptch_Cntrl !< Pitch control: 0 = collective; 1 = individual [-] - REAL(ReKi) :: Gain_OM !< Optimal mode gain [Nm/(rad/s)^2] - REAL(ReKi) :: GenPwr_Dem !< Demanded power [W] - REAL(ReKi) :: GenSpd_Dem !< Demanded generator speed above rated [rad/s] - REAL(ReKi) :: GenSpd_MaxOM !< Optimal mode maximum speed [rad/s] - REAL(ReKi) :: GenSpd_MinOM !< Minimum generator speed [rad/s] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: GenSpd_TLU !< Table (array) containing DLL_NumTrq generator speeds for the torque-speed table look-up (TLU) -- this should be defined using an array constructor; for example, if DLL_NumTrq = 3, GenSpd_TLU(DLL_NumTrq) = (/ 0.0, 99.9, 999.9 /) [rad/s] - REAL(ReKi) :: GenTrq_Dem !< Demanded generator torque [Nm] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: GenTrq_TLU !< Table (array) containing DLL_NumTrq generator torques for the torque-speed table look-up (TLU) -- this should be defined using an array constructor, for example, if DLL_NumTrq = 3, GenTrq_TLU(DLL_NumTrq) = (/ 0.0, 10, 200.0 /) [Nm] - REAL(ReKi) :: Ptch_Max !< Maximum pitch angle [rad] - REAL(ReKi) :: Ptch_Min !< Minimum pitch angle [rad] - REAL(ReKi) :: Ptch_SetPnt !< Below-rated pitch angle set-point [rad] - REAL(ReKi) :: PtchRate_Max !< Maximum pitch rate [rad/s] - REAL(ReKi) :: PtchRate_Min !< Minimum pitch rate (most negative value allowed) [rad/s] + REAL(ReKi) :: BlAlpha !< parameter for low-pass filter of blade pitch commands from the controller DLL [-] + INTEGER(IntKi) :: DLL_n !< number of steps between the controller being called and SrvD being called [-] + INTEGER(IntKi) :: avcOUTNAME_LEN !< Length of the avcOUTNAME character array passed to/from the DLL [-] REAL(ReKi) :: NacYaw_North !< Reference yaw angle of the nacelle when the upwind end points due North [rad] - CHARACTER(1024) :: DLL_InFile !< Name of input file used in DLL [-] - TYPE(DLL_Type) :: DLL_Trgt !< The addresses and names of the Bladed DLL and its procedure [-] - TYPE(TMD_ParameterType) :: NTMD !< TMD module parameters - nacelle [-] - TYPE(TMD_ParameterType) :: TTMD !< TMD module parameters - tower [-] REAL(ReKi) :: AvgWindSpeed !< average wind speed for the simulation [m/s] REAL(ReKi) :: AirDens !< air density [kg/m^3] + INTEGER(IntKi) :: TrimCase !< Controller parameter to be trimmed {1:yaw; 2:torque; 3:pitch} [used only if CalcSteady=True] [-] + REAL(ReKi) :: TrimGain !< Proportional gain for the rotational speed error (>0) [used only if TrimCase>0] [rad/(rad/s) for yaw or pitch; Nm/(rad/s) for torque] + REAL(ReKi) :: RotSpeedRef !< Reference rotor speed [rad/s] + TYPE(TMD_ParameterType) :: NTMD !< TMD module parameters - nacelle [-] + TYPE(TMD_ParameterType) :: TTMD !< TMD module parameters - tower [-] END TYPE SrvD_ParameterType ! ======================= ! ========= SrvD_InputType ======= @@ -338,8 +390,6 @@ MODULE ServoDyn_Types REAL(ReKi) :: RotPwr !< Rotor power (this is equivalent to the low-speed shaft power) [W] REAL(ReKi) :: HorWindV !< Horizontal hub-height wind velocity magnitude [m/s] REAL(ReKi) :: YawAngle !< Estimate of yaw (nacelle + platform) [radians] - REAL(ReKi) :: ElecPwr_prev !< Electrical power (from previous step), sent to Bladed DLL [W] - REAL(ReKi) :: GenTrq_prev !< Electrical generator torque (from previous step), sent to Bladed DLL [N-m] TYPE(TMD_InputType) :: NTMD !< TMD module inputs - nacelle [-] TYPE(TMD_InputType) :: TTMD !< TMD module inputs - tower [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: SuperController !< A swap array: used to pass input data to the DLL controller from the supercontroller [-] @@ -399,6 +449,9 @@ SUBROUTINE SrvD_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%AirDens = SrcInitInputData%AirDens DstInitInputData%NumSC2Ctrl = SrcInitInputData%NumSC2Ctrl DstInitInputData%NumCtrl2SC = SrcInitInputData%NumCtrl2SC + DstInitInputData%TrimCase = SrcInitInputData%TrimCase + DstInitInputData%TrimGain = SrcInitInputData%TrimGain + DstInitInputData%RotSpeedRef = SrcInitInputData%RotSpeedRef END SUBROUTINE SrvD_CopyInitInput SUBROUTINE SrvD_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) @@ -467,6 +520,9 @@ SUBROUTINE SrvD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Re_BufSz = Re_BufSz + 1 ! AirDens Int_BufSz = Int_BufSz + 1 ! NumSC2Ctrl Int_BufSz = Int_BufSz + 1 ! NumCtrl2SC + Int_BufSz = Int_BufSz + 1 ! TrimCase + Re_BufSz = Re_BufSz + 1 ! TrimGain + Re_BufSz = Re_BufSz + 1 ! RotSpeedRef IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -541,6 +597,12 @@ SUBROUTINE SrvD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = InData%NumCtrl2SC Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TrimCase + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TrimGain + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RotSpeedRef + Re_Xferred = Re_Xferred + 1 END SUBROUTINE SrvD_PackInitInput SUBROUTINE SrvD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -624,6 +686,12 @@ SUBROUTINE SrvD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Int_Xferred = Int_Xferred + 1 OutData%NumCtrl2SC = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 + OutData%TrimCase = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TrimGain = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RotSpeedRef = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE SrvD_UnPackInitInput SUBROUTINE SrvD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -1355,6 +1423,7 @@ SUBROUTINE SrvD_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, Err END IF DstInputFileData%GenTrq_TLU = SrcInputFileData%GenTrq_TLU ENDIF + DstInputFileData%UseLegacyInterface = SrcInputFileData%UseLegacyInterface DstInputFileData%CompNTMD = SrcInputFileData%CompNTMD DstInputFileData%NTMDfile = SrcInputFileData%NTMDfile DstInputFileData%CompTTMD = SrcInputFileData%CompTTMD @@ -1499,6 +1568,7 @@ SUBROUTINE SrvD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Int_BufSz = Int_BufSz + 2*1 ! GenTrq_TLU upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%GenTrq_TLU) ! GenTrq_TLU END IF + Int_BufSz = Int_BufSz + 1 ! UseLegacyInterface Int_BufSz = Int_BufSz + 1 ! CompNTMD Int_BufSz = Int_BufSz + 1*LEN(InData%NTMDfile) ! NTMDfile Int_BufSz = Int_BufSz + 1 ! CompTTMD @@ -1727,6 +1797,8 @@ SUBROUTINE SrvD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Re_Xferred = Re_Xferred + 1 END DO END IF + IntKiBuf(Int_Xferred) = TRANSFER(InData%UseLegacyInterface, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = TRANSFER(InData%CompNTMD, IntKiBuf(1)) Int_Xferred = Int_Xferred + 1 DO I = 1, LEN(InData%NTMDfile) @@ -1980,6 +2052,8 @@ SUBROUTINE SrvD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = Re_Xferred + 1 END DO END IF + OutData%UseLegacyInterface = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseLegacyInterface) + Int_Xferred = Int_Xferred + 1 OutData%CompNTMD = TRANSFER(IntKiBuf(Int_Xferred), OutData%CompNTMD) Int_Xferred = Int_Xferred + 1 DO I = 1, LEN(OutData%NTMDfile) @@ -2021,13 +2095,14 @@ SUBROUTINE SrvD_CopyBladedDLLType( SrcBladedDLLTypeData, DstBladedDLLTypeData, C END IF DstBladedDLLTypeData%avrSWAP = SrcBladedDLLTypeData%avrSWAP ENDIF - DstBladedDLLTypeData%HSSBrFrac = SrcBladedDLLTypeData%HSSBrFrac - DstBladedDLLTypeData%HSSBrTrqC = SrcBladedDLLTypeData%HSSBrTrqC + DstBladedDLLTypeData%HSSBrTrqDemand = SrcBladedDLLTypeData%HSSBrTrqDemand DstBladedDLLTypeData%YawRateCom = SrcBladedDLLTypeData%YawRateCom DstBladedDLLTypeData%GenTrq = SrcBladedDLLTypeData%GenTrq DstBladedDLLTypeData%GenState = SrcBladedDLLTypeData%GenState DstBladedDLLTypeData%BlPitchCom = SrcBladedDLLTypeData%BlPitchCom DstBladedDLLTypeData%PrevBlPitch = SrcBladedDLLTypeData%PrevBlPitch + DstBladedDLLTypeData%ElecPwr_prev = SrcBladedDLLTypeData%ElecPwr_prev + DstBladedDLLTypeData%GenTrq_prev = SrcBladedDLLTypeData%GenTrq_prev IF (ALLOCATED(SrcBladedDLLTypeData%SCoutput)) THEN i1_l = LBOUND(SrcBladedDLLTypeData%SCoutput,1) i1_u = UBOUND(SrcBladedDLLTypeData%SCoutput,1) @@ -2040,6 +2115,122 @@ SUBROUTINE SrvD_CopyBladedDLLType( SrcBladedDLLTypeData, DstBladedDLLTypeData, C END IF DstBladedDLLTypeData%SCoutput = SrcBladedDLLTypeData%SCoutput ENDIF + DstBladedDLLTypeData%initialized = SrcBladedDLLTypeData%initialized + DstBladedDLLTypeData%NumLogChannels = SrcBladedDLLTypeData%NumLogChannels +IF (ALLOCATED(SrcBladedDLLTypeData%LogChannels_OutParam)) THEN + i1_l = LBOUND(SrcBladedDLLTypeData%LogChannels_OutParam,1) + i1_u = UBOUND(SrcBladedDLLTypeData%LogChannels_OutParam,1) + IF (.NOT. ALLOCATED(DstBladedDLLTypeData%LogChannels_OutParam)) THEN + ALLOCATE(DstBladedDLLTypeData%LogChannels_OutParam(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%LogChannels_OutParam.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcBladedDLLTypeData%LogChannels_OutParam,1), UBOUND(SrcBladedDLLTypeData%LogChannels_OutParam,1) + CALL NWTC_Library_Copyoutparmtype( SrcBladedDLLTypeData%LogChannels_OutParam(i1), DstBladedDLLTypeData%LogChannels_OutParam(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcBladedDLLTypeData%LogChannels)) THEN + i1_l = LBOUND(SrcBladedDLLTypeData%LogChannels,1) + i1_u = UBOUND(SrcBladedDLLTypeData%LogChannels,1) + IF (.NOT. ALLOCATED(DstBladedDLLTypeData%LogChannels)) THEN + ALLOCATE(DstBladedDLLTypeData%LogChannels(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%LogChannels.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstBladedDLLTypeData%LogChannels = SrcBladedDLLTypeData%LogChannels +ENDIF + DstBladedDLLTypeData%ErrStat = SrcBladedDLLTypeData%ErrStat + DstBladedDLLTypeData%ErrMsg = SrcBladedDLLTypeData%ErrMsg + DstBladedDLLTypeData%CurrentTime = SrcBladedDLLTypeData%CurrentTime + DstBladedDLLTypeData%SimStatus = SrcBladedDLLTypeData%SimStatus + DstBladedDLLTypeData%ShaftBrakeStatusBinaryFlag = SrcBladedDLLTypeData%ShaftBrakeStatusBinaryFlag + DstBladedDLLTypeData%HSSBrDeployed = SrcBladedDLLTypeData%HSSBrDeployed + DstBladedDLLTypeData%TimeHSSBrFullyDeployed = SrcBladedDLLTypeData%TimeHSSBrFullyDeployed + DstBladedDLLTypeData%TimeHSSBrDeployed = SrcBladedDLLTypeData%TimeHSSBrDeployed + DstBladedDLLTypeData%OverrideYawRateWithTorque = SrcBladedDLLTypeData%OverrideYawRateWithTorque + DstBladedDLLTypeData%YawTorqueDemand = SrcBladedDLLTypeData%YawTorqueDemand +IF (ALLOCATED(SrcBladedDLLTypeData%BlPitchInput)) THEN + i1_l = LBOUND(SrcBladedDLLTypeData%BlPitchInput,1) + i1_u = UBOUND(SrcBladedDLLTypeData%BlPitchInput,1) + IF (.NOT. ALLOCATED(DstBladedDLLTypeData%BlPitchInput)) THEN + ALLOCATE(DstBladedDLLTypeData%BlPitchInput(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%BlPitchInput.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstBladedDLLTypeData%BlPitchInput = SrcBladedDLLTypeData%BlPitchInput +ENDIF + DstBladedDLLTypeData%YawAngleFromNorth = SrcBladedDLLTypeData%YawAngleFromNorth + DstBladedDLLTypeData%HorWindV = SrcBladedDLLTypeData%HorWindV + DstBladedDLLTypeData%HSS_Spd = SrcBladedDLLTypeData%HSS_Spd + DstBladedDLLTypeData%YawErr = SrcBladedDLLTypeData%YawErr + DstBladedDLLTypeData%RotSpeed = SrcBladedDLLTypeData%RotSpeed + DstBladedDLLTypeData%YawBrTAxp = SrcBladedDLLTypeData%YawBrTAxp + DstBladedDLLTypeData%YawBrTAyp = SrcBladedDLLTypeData%YawBrTAyp + DstBladedDLLTypeData%LSSTipMys = SrcBladedDLLTypeData%LSSTipMys + DstBladedDLLTypeData%LSSTipMzs = SrcBladedDLLTypeData%LSSTipMzs + DstBladedDLLTypeData%LSSTipMya = SrcBladedDLLTypeData%LSSTipMya + DstBladedDLLTypeData%LSSTipMza = SrcBladedDLLTypeData%LSSTipMza + DstBladedDLLTypeData%LSSTipPxa = SrcBladedDLLTypeData%LSSTipPxa + DstBladedDLLTypeData%Yaw = SrcBladedDLLTypeData%Yaw + DstBladedDLLTypeData%YawRate = SrcBladedDLLTypeData%YawRate + DstBladedDLLTypeData%YawBrMyn = SrcBladedDLLTypeData%YawBrMyn + DstBladedDLLTypeData%YawBrMzn = SrcBladedDLLTypeData%YawBrMzn + DstBladedDLLTypeData%NcIMURAxs = SrcBladedDLLTypeData%NcIMURAxs + DstBladedDLLTypeData%NcIMURAys = SrcBladedDLLTypeData%NcIMURAys + DstBladedDLLTypeData%NcIMURAzs = SrcBladedDLLTypeData%NcIMURAzs + DstBladedDLLTypeData%RotPwr = SrcBladedDLLTypeData%RotPwr + DstBladedDLLTypeData%LSSTipMxa = SrcBladedDLLTypeData%LSSTipMxa + DstBladedDLLTypeData%DLL_DT = SrcBladedDLLTypeData%DLL_DT + DstBladedDLLTypeData%DLL_InFile = SrcBladedDLLTypeData%DLL_InFile + DstBladedDLLTypeData%RootName = SrcBladedDLLTypeData%RootName + DstBladedDLLTypeData%GenTrq_Dem = SrcBladedDLLTypeData%GenTrq_Dem + DstBladedDLLTypeData%GenSpd_Dem = SrcBladedDLLTypeData%GenSpd_Dem + DstBladedDLLTypeData%Ptch_Max = SrcBladedDLLTypeData%Ptch_Max + DstBladedDLLTypeData%Ptch_Min = SrcBladedDLLTypeData%Ptch_Min + DstBladedDLLTypeData%Ptch_SetPnt = SrcBladedDLLTypeData%Ptch_SetPnt + DstBladedDLLTypeData%PtchRate_Max = SrcBladedDLLTypeData%PtchRate_Max + DstBladedDLLTypeData%PtchRate_Min = SrcBladedDLLTypeData%PtchRate_Min + DstBladedDLLTypeData%GenPwr_Dem = SrcBladedDLLTypeData%GenPwr_Dem + DstBladedDLLTypeData%Gain_OM = SrcBladedDLLTypeData%Gain_OM + DstBladedDLLTypeData%GenSpd_MaxOM = SrcBladedDLLTypeData%GenSpd_MaxOM + DstBladedDLLTypeData%GenSpd_MinOM = SrcBladedDLLTypeData%GenSpd_MinOM + DstBladedDLLTypeData%Ptch_Cntrl = SrcBladedDLLTypeData%Ptch_Cntrl + DstBladedDLLTypeData%DLL_NumTrq = SrcBladedDLLTypeData%DLL_NumTrq +IF (ALLOCATED(SrcBladedDLLTypeData%GenSpd_TLU)) THEN + i1_l = LBOUND(SrcBladedDLLTypeData%GenSpd_TLU,1) + i1_u = UBOUND(SrcBladedDLLTypeData%GenSpd_TLU,1) + IF (.NOT. ALLOCATED(DstBladedDLLTypeData%GenSpd_TLU)) THEN + ALLOCATE(DstBladedDLLTypeData%GenSpd_TLU(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%GenSpd_TLU.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstBladedDLLTypeData%GenSpd_TLU = SrcBladedDLLTypeData%GenSpd_TLU +ENDIF +IF (ALLOCATED(SrcBladedDLLTypeData%GenTrq_TLU)) THEN + i1_l = LBOUND(SrcBladedDLLTypeData%GenTrq_TLU,1) + i1_u = UBOUND(SrcBladedDLLTypeData%GenTrq_TLU,1) + IF (.NOT. ALLOCATED(DstBladedDLLTypeData%GenTrq_TLU)) THEN + ALLOCATE(DstBladedDLLTypeData%GenTrq_TLU(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%GenTrq_TLU.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstBladedDLLTypeData%GenTrq_TLU = SrcBladedDLLTypeData%GenTrq_TLU +ENDIF + DstBladedDLLTypeData%Yaw_Cntrl = SrcBladedDLLTypeData%Yaw_Cntrl + DstBladedDLLTypeData%RootMyc = SrcBladedDLLTypeData%RootMyc + DstBladedDLLTypeData%RootMxc = SrcBladedDLLTypeData%RootMxc END SUBROUTINE SrvD_CopyBladedDLLType SUBROUTINE SrvD_DestroyBladedDLLType( BladedDLLTypeData, ErrStat, ErrMsg ) @@ -2056,6 +2247,24 @@ SUBROUTINE SrvD_DestroyBladedDLLType( BladedDLLTypeData, ErrStat, ErrMsg ) ENDIF IF (ALLOCATED(BladedDLLTypeData%SCoutput)) THEN DEALLOCATE(BladedDLLTypeData%SCoutput) +ENDIF +IF (ALLOCATED(BladedDLLTypeData%LogChannels_OutParam)) THEN +DO i1 = LBOUND(BladedDLLTypeData%LogChannels_OutParam,1), UBOUND(BladedDLLTypeData%LogChannels_OutParam,1) + CALL NWTC_Library_Destroyoutparmtype( BladedDLLTypeData%LogChannels_OutParam(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(BladedDLLTypeData%LogChannels_OutParam) +ENDIF +IF (ALLOCATED(BladedDLLTypeData%LogChannels)) THEN + DEALLOCATE(BladedDLLTypeData%LogChannels) +ENDIF +IF (ALLOCATED(BladedDLLTypeData%BlPitchInput)) THEN + DEALLOCATE(BladedDLLTypeData%BlPitchInput) +ENDIF +IF (ALLOCATED(BladedDLLTypeData%GenSpd_TLU)) THEN + DEALLOCATE(BladedDLLTypeData%GenSpd_TLU) +ENDIF +IF (ALLOCATED(BladedDLLTypeData%GenTrq_TLU)) THEN + DEALLOCATE(BladedDLLTypeData%GenTrq_TLU) ENDIF END SUBROUTINE SrvD_DestroyBladedDLLType @@ -2099,18 +2308,115 @@ SUBROUTINE SrvD_PackBladedDLLType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + 2*1 ! avrSWAP upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%avrSWAP) ! avrSWAP END IF - Re_BufSz = Re_BufSz + 1 ! HSSBrFrac - Re_BufSz = Re_BufSz + 1 ! HSSBrTrqC + Re_BufSz = Re_BufSz + 1 ! HSSBrTrqDemand Re_BufSz = Re_BufSz + 1 ! YawRateCom Re_BufSz = Re_BufSz + 1 ! GenTrq Int_BufSz = Int_BufSz + 1 ! GenState Re_BufSz = Re_BufSz + SIZE(InData%BlPitchCom) ! BlPitchCom Re_BufSz = Re_BufSz + SIZE(InData%PrevBlPitch) ! PrevBlPitch + Re_BufSz = Re_BufSz + 1 ! ElecPwr_prev + Re_BufSz = Re_BufSz + 1 ! GenTrq_prev Int_BufSz = Int_BufSz + 1 ! SCoutput allocated yes/no IF ( ALLOCATED(InData%SCoutput) ) THEN Int_BufSz = Int_BufSz + 2*1 ! SCoutput upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%SCoutput) ! SCoutput END IF + Int_BufSz = Int_BufSz + 1 ! initialized + Int_BufSz = Int_BufSz + 1 ! NumLogChannels + Int_BufSz = Int_BufSz + 1 ! LogChannels_OutParam allocated yes/no + IF ( ALLOCATED(InData%LogChannels_OutParam) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! LogChannels_OutParam upper/lower bounds for each dimension + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + DO i1 = LBOUND(InData%LogChannels_OutParam,1), UBOUND(InData%LogChannels_OutParam,1) + Int_BufSz = Int_BufSz + 3 ! LogChannels_OutParam: size of buffers for each call to pack subtype + CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%LogChannels_OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! LogChannels_OutParam + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! LogChannels_OutParam + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! LogChannels_OutParam + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! LogChannels_OutParam + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! LogChannels allocated yes/no + IF ( ALLOCATED(InData%LogChannels) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! LogChannels upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%LogChannels) ! LogChannels + END IF + Int_BufSz = Int_BufSz + 1 ! ErrStat + Int_BufSz = Int_BufSz + 1*LEN(InData%ErrMsg) ! ErrMsg + Db_BufSz = Db_BufSz + 1 ! CurrentTime + Int_BufSz = Int_BufSz + 1 ! SimStatus + Int_BufSz = Int_BufSz + 1 ! ShaftBrakeStatusBinaryFlag + Int_BufSz = Int_BufSz + 1 ! HSSBrDeployed + Db_BufSz = Db_BufSz + 1 ! TimeHSSBrFullyDeployed + Db_BufSz = Db_BufSz + 1 ! TimeHSSBrDeployed + Int_BufSz = Int_BufSz + 1 ! OverrideYawRateWithTorque + Re_BufSz = Re_BufSz + 1 ! YawTorqueDemand + Int_BufSz = Int_BufSz + 1 ! BlPitchInput allocated yes/no + IF ( ALLOCATED(InData%BlPitchInput) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! BlPitchInput upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%BlPitchInput) ! BlPitchInput + END IF + Re_BufSz = Re_BufSz + 1 ! YawAngleFromNorth + Re_BufSz = Re_BufSz + 1 ! HorWindV + Re_BufSz = Re_BufSz + 1 ! HSS_Spd + Re_BufSz = Re_BufSz + 1 ! YawErr + Re_BufSz = Re_BufSz + 1 ! RotSpeed + Re_BufSz = Re_BufSz + 1 ! YawBrTAxp + Re_BufSz = Re_BufSz + 1 ! YawBrTAyp + Re_BufSz = Re_BufSz + 1 ! LSSTipMys + Re_BufSz = Re_BufSz + 1 ! LSSTipMzs + Re_BufSz = Re_BufSz + 1 ! LSSTipMya + Re_BufSz = Re_BufSz + 1 ! LSSTipMza + Re_BufSz = Re_BufSz + 1 ! LSSTipPxa + Re_BufSz = Re_BufSz + 1 ! Yaw + Re_BufSz = Re_BufSz + 1 ! YawRate + Re_BufSz = Re_BufSz + 1 ! YawBrMyn + Re_BufSz = Re_BufSz + 1 ! YawBrMzn + Re_BufSz = Re_BufSz + 1 ! NcIMURAxs + Re_BufSz = Re_BufSz + 1 ! NcIMURAys + Re_BufSz = Re_BufSz + 1 ! NcIMURAzs + Re_BufSz = Re_BufSz + 1 ! RotPwr + Re_BufSz = Re_BufSz + 1 ! LSSTipMxa + Db_BufSz = Db_BufSz + 1 ! DLL_DT + Int_BufSz = Int_BufSz + 1*LEN(InData%DLL_InFile) ! DLL_InFile + Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName + Re_BufSz = Re_BufSz + 1 ! GenTrq_Dem + Re_BufSz = Re_BufSz + 1 ! GenSpd_Dem + Re_BufSz = Re_BufSz + 1 ! Ptch_Max + Re_BufSz = Re_BufSz + 1 ! Ptch_Min + Re_BufSz = Re_BufSz + 1 ! Ptch_SetPnt + Re_BufSz = Re_BufSz + 1 ! PtchRate_Max + Re_BufSz = Re_BufSz + 1 ! PtchRate_Min + Re_BufSz = Re_BufSz + 1 ! GenPwr_Dem + Re_BufSz = Re_BufSz + 1 ! Gain_OM + Re_BufSz = Re_BufSz + 1 ! GenSpd_MaxOM + Re_BufSz = Re_BufSz + 1 ! GenSpd_MinOM + Int_BufSz = Int_BufSz + 1 ! Ptch_Cntrl + Int_BufSz = Int_BufSz + 1 ! DLL_NumTrq + Int_BufSz = Int_BufSz + 1 ! GenSpd_TLU allocated yes/no + IF ( ALLOCATED(InData%GenSpd_TLU) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! GenSpd_TLU upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%GenSpd_TLU) ! GenSpd_TLU + END IF + Int_BufSz = Int_BufSz + 1 ! GenTrq_TLU allocated yes/no + IF ( ALLOCATED(InData%GenTrq_TLU) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! GenTrq_TLU upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%GenTrq_TLU) ! GenTrq_TLU + END IF + Int_BufSz = Int_BufSz + 1 ! Yaw_Cntrl + Re_BufSz = Re_BufSz + SIZE(InData%RootMyc) ! RootMyc + Re_BufSz = Re_BufSz + SIZE(InData%RootMxc) ! RootMxc IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -2153,9 +2459,7 @@ SUBROUTINE SrvD_PackBladedDLLType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Re_Xferred = Re_Xferred + 1 END DO END IF - ReKiBuf(Re_Xferred) = InData%HSSBrFrac - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HSSBrTrqC + ReKiBuf(Re_Xferred) = InData%HSSBrTrqDemand Re_Xferred = Re_Xferred + 1 ReKiBuf(Re_Xferred) = InData%YawRateCom Re_Xferred = Re_Xferred + 1 @@ -2171,6 +2475,10 @@ SUBROUTINE SrvD_PackBladedDLLType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ReKiBuf(Re_Xferred) = InData%PrevBlPitch(i1) Re_Xferred = Re_Xferred + 1 END DO + ReKiBuf(Re_Xferred) = InData%ElecPwr_prev + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GenTrq_prev + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%SCoutput) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2186,56 +2494,269 @@ SUBROUTINE SrvD_PackBladedDLLType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Re_Xferred = Re_Xferred + 1 END DO END IF - END SUBROUTINE SrvD_PackBladedDLLType + IntKiBuf(Int_Xferred) = TRANSFER(InData%initialized, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumLogChannels + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%LogChannels_OutParam) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%LogChannels_OutParam,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LogChannels_OutParam,1) + Int_Xferred = Int_Xferred + 2 - SUBROUTINE SrvD_UnPackBladedDLLType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(BladedDLLType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_UnPackBladedDLLType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! avrSWAP not allocated + DO i1 = LBOUND(InData%LogChannels_OutParam,1), UBOUND(InData%LogChannels_OutParam,1) + CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%LogChannels_OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! LogChannels_OutParam + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%LogChannels) ) THEN + IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE + IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%LogChannels,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LogChannels,1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%avrSWAP)) DEALLOCATE(OutData%avrSWAP) - ALLOCATE(OutData%avrSWAP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%avrSWAP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%avrSWAP,1), UBOUND(OutData%avrSWAP,1) - OutData%avrSWAP(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + + DO i1 = LBOUND(InData%LogChannels,1), UBOUND(InData%LogChannels,1) + ReKiBuf(Re_Xferred) = InData%LogChannels(i1) Re_Xferred = Re_Xferred + 1 END DO END IF - OutData%HSSBrFrac = ReKiBuf(Re_Xferred) + IntKiBuf(Int_Xferred) = InData%ErrStat + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%ErrMsg) + IntKiBuf(Int_Xferred) = ICHAR(InData%ErrMsg(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DbKiBuf(Db_Xferred) = InData%CurrentTime + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%SimStatus + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%ShaftBrakeStatusBinaryFlag + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%HSSBrDeployed, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%TimeHSSBrFullyDeployed + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%TimeHSSBrDeployed + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%OverrideYawRateWithTorque, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawTorqueDemand Re_Xferred = Re_Xferred + 1 - OutData%HSSBrTrqC = ReKiBuf(Re_Xferred) + IF ( .NOT. ALLOCATED(InData%BlPitchInput) ) 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%BlPitchInput,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlPitchInput,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%BlPitchInput,1), UBOUND(InData%BlPitchInput,1) + ReKiBuf(Re_Xferred) = InData%BlPitchInput(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%YawAngleFromNorth + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HorWindV + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HSS_Spd + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawErr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RotSpeed + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawBrTAxp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawBrTAyp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%LSSTipMys + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%LSSTipMzs + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%LSSTipMya + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%LSSTipMza + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%LSSTipPxa + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Yaw + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawRate + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawBrMyn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawBrMzn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NcIMURAxs + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NcIMURAys + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NcIMURAzs + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RotPwr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%LSSTipMxa + Re_Xferred = Re_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DLL_DT + Db_Xferred = Db_Xferred + 1 + DO I = 1, LEN(InData%DLL_InFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_InFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + ReKiBuf(Re_Xferred) = InData%GenTrq_Dem + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GenSpd_Dem + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Ptch_Max + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Ptch_Min + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Ptch_SetPnt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtchRate_Max + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtchRate_Min + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GenPwr_Dem + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Gain_OM + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GenSpd_MaxOM + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GenSpd_MinOM + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Ptch_Cntrl + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DLL_NumTrq + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%GenSpd_TLU) ) 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%GenSpd_TLU,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GenSpd_TLU,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%GenSpd_TLU,1), UBOUND(InData%GenSpd_TLU,1) + ReKiBuf(Re_Xferred) = InData%GenSpd_TLU(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%GenTrq_TLU) ) 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%GenTrq_TLU,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GenTrq_TLU,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%GenTrq_TLU,1), UBOUND(InData%GenTrq_TLU,1) + ReKiBuf(Re_Xferred) = InData%GenTrq_TLU(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = InData%Yaw_Cntrl + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%RootMyc,1), UBOUND(InData%RootMyc,1) + ReKiBuf(Re_Xferred) = InData%RootMyc(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%RootMxc,1), UBOUND(InData%RootMxc,1) + ReKiBuf(Re_Xferred) = InData%RootMxc(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END SUBROUTINE SrvD_PackBladedDLLType + + SUBROUTINE SrvD_UnPackBladedDLLType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(BladedDLLType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_UnPackBladedDLLType' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! avrSWAP 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%avrSWAP)) DEALLOCATE(OutData%avrSWAP) + ALLOCATE(OutData%avrSWAP(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%avrSWAP.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%avrSWAP,1), UBOUND(OutData%avrSWAP,1) + OutData%avrSWAP(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%HSSBrTrqDemand = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 OutData%YawRateCom = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 @@ -2255,6 +2776,10 @@ SUBROUTINE SrvD_UnPackBladedDLLType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta OutData%PrevBlPitch(i1) = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 END DO + OutData%ElecPwr_prev = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GenTrq_prev = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SCoutput not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2273,6 +2798,252 @@ SUBROUTINE SrvD_UnPackBladedDLLType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Re_Xferred = Re_Xferred + 1 END DO END IF + OutData%initialized = TRANSFER(IntKiBuf(Int_Xferred), OutData%initialized) + Int_Xferred = Int_Xferred + 1 + OutData%NumLogChannels = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LogChannels_OutParam not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%LogChannels_OutParam)) DEALLOCATE(OutData%LogChannels_OutParam) + ALLOCATE(OutData%LogChannels_OutParam(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LogChannels_OutParam.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%LogChannels_OutParam,1), UBOUND(OutData%LogChannels_OutParam,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackoutparmtype( Re_Buf, Db_Buf, Int_Buf, OutData%LogChannels_OutParam(i1), ErrStat2, ErrMsg2 ) ! LogChannels_OutParam + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LogChannels 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%LogChannels)) DEALLOCATE(OutData%LogChannels) + ALLOCATE(OutData%LogChannels(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LogChannels.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%LogChannels,1), UBOUND(OutData%LogChannels,1) + OutData%LogChannels(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%ErrStat = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%ErrMsg) + OutData%ErrMsg(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%CurrentTime = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%SimStatus = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ShaftBrakeStatusBinaryFlag = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%HSSBrDeployed = TRANSFER(IntKiBuf(Int_Xferred), OutData%HSSBrDeployed) + Int_Xferred = Int_Xferred + 1 + OutData%TimeHSSBrFullyDeployed = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%TimeHSSBrDeployed = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%OverrideYawRateWithTorque = TRANSFER(IntKiBuf(Int_Xferred), OutData%OverrideYawRateWithTorque) + Int_Xferred = Int_Xferred + 1 + OutData%YawTorqueDemand = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlPitchInput 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%BlPitchInput)) DEALLOCATE(OutData%BlPitchInput) + ALLOCATE(OutData%BlPitchInput(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitchInput.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%BlPitchInput,1), UBOUND(OutData%BlPitchInput,1) + OutData%BlPitchInput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%YawAngleFromNorth = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HorWindV = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HSS_Spd = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawErr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RotSpeed = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawBrTAxp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawBrTAyp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LSSTipMys = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LSSTipMzs = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LSSTipMya = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LSSTipMza = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LSSTipPxa = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Yaw = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawRate = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawBrMyn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawBrMzn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NcIMURAxs = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NcIMURAys = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NcIMURAzs = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RotPwr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LSSTipMxa = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%DLL_DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + DO I = 1, LEN(OutData%DLL_InFile) + OutData%DLL_InFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%GenTrq_Dem = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GenSpd_Dem = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Ptch_Max = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Ptch_Min = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Ptch_SetPnt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtchRate_Max = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtchRate_Min = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GenPwr_Dem = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Gain_OM = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GenSpd_MaxOM = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GenSpd_MinOM = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Ptch_Cntrl = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%DLL_NumTrq = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GenSpd_TLU 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%GenSpd_TLU)) DEALLOCATE(OutData%GenSpd_TLU) + ALLOCATE(OutData%GenSpd_TLU(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GenSpd_TLU.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%GenSpd_TLU,1), UBOUND(OutData%GenSpd_TLU,1) + OutData%GenSpd_TLU(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GenTrq_TLU 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%GenTrq_TLU)) DEALLOCATE(OutData%GenTrq_TLU) + ALLOCATE(OutData%GenTrq_TLU(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GenTrq_TLU.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%GenTrq_TLU,1), UBOUND(OutData%GenTrq_TLU,1) + OutData%GenTrq_TLU(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%Yaw_Cntrl = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + i1_l = LBOUND(OutData%RootMyc,1) + i1_u = UBOUND(OutData%RootMyc,1) + DO i1 = LBOUND(OutData%RootMyc,1), UBOUND(OutData%RootMyc,1) + OutData%RootMyc(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + i1_l = LBOUND(OutData%RootMxc,1) + i1_u = UBOUND(OutData%RootMxc,1) + DO i1 = LBOUND(OutData%RootMxc,1), UBOUND(OutData%RootMxc,1) + OutData%RootMxc(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE SrvD_UnPackBladedDLLType SUBROUTINE SrvD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) @@ -2593,6 +3364,7 @@ SUBROUTINE SrvD_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, Err ! ErrStat = ErrID_None ErrMsg = "" + DstDiscStateData%CtrlOffset = SrcDiscStateData%CtrlOffset CALL TMD_CopyDiscState( SrcDiscStateData%NTMD, DstDiscStateData%NTMD, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN @@ -2649,6 +3421,7 @@ SUBROUTINE SrvD_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Re_BufSz = 0 Db_BufSz = 0 Int_BufSz = 0 + Re_BufSz = Re_BufSz + 1 ! CtrlOffset ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! NTMD: size of buffers for each call to pack subtype CALL TMD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%NTMD, ErrStat2, ErrMsg2, .TRUE. ) ! NTMD @@ -2711,6 +3484,8 @@ SUBROUTINE SrvD_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 + ReKiBuf(Re_Xferred) = InData%CtrlOffset + Re_Xferred = Re_Xferred + 1 CALL TMD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%NTMD, ErrStat2, ErrMsg2, OnlySize ) ! NTMD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2795,6 +3570,8 @@ SUBROUTINE SrvD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 + OutData%CtrlOffset = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -4306,7 +5083,6 @@ SUBROUTINE SrvD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ErrMsg = "" DstParamData%DT = SrcParamData%DT DstParamData%HSSBrDT = SrcParamData%HSSBrDT - DstParamData%HSSBrFrac = SrcParamData%HSSBrFrac DstParamData%HSSBrTqF = SrcParamData%HSSBrTqF DstParamData%SIG_POSl = SrcParamData%SIG_POSl DstParamData%SIG_POTq = SrcParamData%SIG_POTq @@ -4364,7 +5140,6 @@ SUBROUTINE SrvD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg END IF DstParamData%PitManRat = SrcParamData%PitManRat ENDIF - DstParamData%BlAlpha = SrcParamData%BlAlpha DstParamData%YawManRat = SrcParamData%YawManRat DstParamData%NacYawF = SrcParamData%NacYawF DstParamData%SpdGenOn = SrcParamData%SpdGenOn @@ -4425,6 +5200,7 @@ SUBROUTINE SrvD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%CompNTMD = SrcParamData%CompNTMD DstParamData%CompTTMD = SrcParamData%CompTTMD DstParamData%NumOuts = SrcParamData%NumOuts + DstParamData%NumOuts_DLL = SrcParamData%NumOuts_DLL DstParamData%RootName = SrcParamData%RootName IF (ALLOCATED(SrcParamData%OutParam)) THEN i1_l = LBOUND(SrcParamData%OutParam,1) @@ -4444,56 +5220,24 @@ SUBROUTINE SrvD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ENDIF 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%DLL_DT = SrcParamData%DLL_DT - DstParamData%DLL_NumTrq = SrcParamData%DLL_NumTrq - DstParamData%Ptch_Cntrl = SrcParamData%Ptch_Cntrl - DstParamData%Gain_OM = SrcParamData%Gain_OM - DstParamData%GenPwr_Dem = SrcParamData%GenPwr_Dem - DstParamData%GenSpd_Dem = SrcParamData%GenSpd_Dem - DstParamData%GenSpd_MaxOM = SrcParamData%GenSpd_MaxOM - DstParamData%GenSpd_MinOM = SrcParamData%GenSpd_MinOM -IF (ALLOCATED(SrcParamData%GenSpd_TLU)) THEN - i1_l = LBOUND(SrcParamData%GenSpd_TLU,1) - i1_u = UBOUND(SrcParamData%GenSpd_TLU,1) - IF (.NOT. ALLOCATED(DstParamData%GenSpd_TLU)) THEN - ALLOCATE(DstParamData%GenSpd_TLU(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%GenSpd_TLU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%GenSpd_TLU = SrcParamData%GenSpd_TLU -ENDIF - DstParamData%GenTrq_Dem = SrcParamData%GenTrq_Dem -IF (ALLOCATED(SrcParamData%GenTrq_TLU)) THEN - i1_l = LBOUND(SrcParamData%GenTrq_TLU,1) - i1_u = UBOUND(SrcParamData%GenTrq_TLU,1) - IF (.NOT. ALLOCATED(DstParamData%GenTrq_TLU)) THEN - ALLOCATE(DstParamData%GenTrq_TLU(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%GenTrq_TLU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%GenTrq_TLU = SrcParamData%GenTrq_TLU -ENDIF - DstParamData%Ptch_Max = SrcParamData%Ptch_Max - DstParamData%Ptch_Min = SrcParamData%Ptch_Min - DstParamData%Ptch_SetPnt = SrcParamData%Ptch_SetPnt - DstParamData%PtchRate_Max = SrcParamData%PtchRate_Max - DstParamData%PtchRate_Min = SrcParamData%PtchRate_Min + DstParamData%BlAlpha = SrcParamData%BlAlpha + DstParamData%DLL_n = SrcParamData%DLL_n + DstParamData%avcOUTNAME_LEN = SrcParamData%avcOUTNAME_LEN DstParamData%NacYaw_North = SrcParamData%NacYaw_North - DstParamData%DLL_InFile = SrcParamData%DLL_InFile - DstParamData%DLL_Trgt = SrcParamData%DLL_Trgt + DstParamData%AvgWindSpeed = SrcParamData%AvgWindSpeed + DstParamData%AirDens = SrcParamData%AirDens + DstParamData%TrimCase = SrcParamData%TrimCase + DstParamData%TrimGain = SrcParamData%TrimGain + DstParamData%RotSpeedRef = SrcParamData%RotSpeedRef CALL TMD_CopyParam( SrcParamData%NTMD, DstParamData%NTMD, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN CALL TMD_CopyParam( SrcParamData%TTMD, DstParamData%TTMD, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - DstParamData%AvgWindSpeed = SrcParamData%AvgWindSpeed - DstParamData%AirDens = SrcParamData%AirDens END SUBROUTINE SrvD_CopyParam SUBROUTINE SrvD_DestroyParam( ParamData, ErrStat, ErrMsg ) @@ -4525,12 +5269,6 @@ SUBROUTINE SrvD_DestroyParam( ParamData, ErrStat, ErrMsg ) CALL NWTC_Library_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat, ErrMsg ) ENDDO DEALLOCATE(ParamData%OutParam) -ENDIF -IF (ALLOCATED(ParamData%GenSpd_TLU)) THEN - DEALLOCATE(ParamData%GenSpd_TLU) -ENDIF -IF (ALLOCATED(ParamData%GenTrq_TLU)) THEN - DEALLOCATE(ParamData%GenTrq_TLU) ENDIF CALL FreeDynamicLib( ParamData%DLL_Trgt, ErrStat, ErrMsg ) CALL TMD_DestroyParam( ParamData%NTMD, ErrStat, ErrMsg ) @@ -4574,7 +5312,6 @@ SUBROUTINE SrvD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_BufSz = 0 Db_BufSz = Db_BufSz + 1 ! DT Db_BufSz = Db_BufSz + 1 ! HSSBrDT - Re_BufSz = Re_BufSz + 1 ! HSSBrFrac Re_BufSz = Re_BufSz + 1 ! HSSBrTqF Re_BufSz = Re_BufSz + 1 ! SIG_POSl Re_BufSz = Re_BufSz + 1 ! SIG_POTq @@ -4611,7 +5348,6 @@ SUBROUTINE SrvD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_BufSz = Int_BufSz + 2*1 ! PitManRat upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%PitManRat) ! PitManRat END IF - Re_BufSz = Re_BufSz + 1 ! BlAlpha Re_BufSz = Re_BufSz + 1 ! YawManRat Re_BufSz = Re_BufSz + 1 ! NacYawF Re_BufSz = Re_BufSz + 1 ! SpdGenOn @@ -4658,6 +5394,7 @@ SUBROUTINE SrvD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_BufSz = Int_BufSz + 1 ! CompNTMD Int_BufSz = Int_BufSz + 1 ! CompTTMD Int_BufSz = Int_BufSz + 1 ! NumOuts + Int_BufSz = Int_BufSz + 1 ! NumOuts_DLL Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName Int_BufSz = Int_BufSz + 1 ! OutParam allocated yes/no IF ( ALLOCATED(InData%OutParam) ) THEN @@ -4685,33 +5422,7 @@ SUBROUTINE SrvD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, END IF Int_BufSz = Int_BufSz + 1*LEN(InData%Delim) ! Delim Int_BufSz = Int_BufSz + 1 ! UseBladedInterface - Int_BufSz = Int_BufSz + 1 ! DLL_Ramp - Db_BufSz = Db_BufSz + 1 ! DLL_DT - Int_BufSz = Int_BufSz + 1 ! DLL_NumTrq - Int_BufSz = Int_BufSz + 1 ! Ptch_Cntrl - Re_BufSz = Re_BufSz + 1 ! Gain_OM - Re_BufSz = Re_BufSz + 1 ! GenPwr_Dem - Re_BufSz = Re_BufSz + 1 ! GenSpd_Dem - Re_BufSz = Re_BufSz + 1 ! GenSpd_MaxOM - Re_BufSz = Re_BufSz + 1 ! GenSpd_MinOM - Int_BufSz = Int_BufSz + 1 ! GenSpd_TLU allocated yes/no - IF ( ALLOCATED(InData%GenSpd_TLU) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! GenSpd_TLU upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%GenSpd_TLU) ! GenSpd_TLU - END IF - Re_BufSz = Re_BufSz + 1 ! GenTrq_Dem - Int_BufSz = Int_BufSz + 1 ! GenTrq_TLU allocated yes/no - IF ( ALLOCATED(InData%GenTrq_TLU) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! GenTrq_TLU upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%GenTrq_TLU) ! GenTrq_TLU - END IF - Re_BufSz = Re_BufSz + 1 ! Ptch_Max - Re_BufSz = Re_BufSz + 1 ! Ptch_Min - Re_BufSz = Re_BufSz + 1 ! Ptch_SetPnt - Re_BufSz = Re_BufSz + 1 ! PtchRate_Max - Re_BufSz = Re_BufSz + 1 ! PtchRate_Min - Re_BufSz = Re_BufSz + 1 ! NacYaw_North - Int_BufSz = Int_BufSz + 1*LEN(InData%DLL_InFile) ! DLL_InFile + Int_BufSz = Int_BufSz + 1 ! UseLegacyInterface Int_BufSz = Int_BufSz + 3 ! DLL_Trgt: size of buffers for each call to pack subtype CALL DLLTypePack( InData%DLL_Trgt, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! DLL_Trgt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4729,6 +5440,16 @@ SUBROUTINE SrvD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF + Int_BufSz = Int_BufSz + 1 ! DLL_Ramp + Re_BufSz = Re_BufSz + 1 ! BlAlpha + Int_BufSz = Int_BufSz + 1 ! DLL_n + Int_BufSz = Int_BufSz + 1 ! avcOUTNAME_LEN + Re_BufSz = Re_BufSz + 1 ! NacYaw_North + Re_BufSz = Re_BufSz + 1 ! AvgWindSpeed + Re_BufSz = Re_BufSz + 1 ! AirDens + Int_BufSz = Int_BufSz + 1 ! TrimCase + Re_BufSz = Re_BufSz + 1 ! TrimGain + Re_BufSz = Re_BufSz + 1 ! RotSpeedRef Int_BufSz = Int_BufSz + 3 ! NTMD: size of buffers for each call to pack subtype CALL TMD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%NTMD, ErrStat2, ErrMsg2, .TRUE. ) ! NTMD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4763,8 +5484,6 @@ SUBROUTINE SrvD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF - Re_BufSz = Re_BufSz + 1 ! AvgWindSpeed - Re_BufSz = Re_BufSz + 1 ! AirDens IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -4796,8 +5515,6 @@ SUBROUTINE SrvD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = Db_Xferred + 1 DbKiBuf(Db_Xferred) = InData%HSSBrDT Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HSSBrFrac - Re_Xferred = Re_Xferred + 1 ReKiBuf(Re_Xferred) = InData%HSSBrTqF Re_Xferred = Re_Xferred + 1 ReKiBuf(Re_Xferred) = InData%SIG_POSl @@ -4885,8 +5602,6 @@ SUBROUTINE SrvD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Re_Xferred = Re_Xferred + 1 END DO END IF - ReKiBuf(Re_Xferred) = InData%BlAlpha - Re_Xferred = Re_Xferred + 1 ReKiBuf(Re_Xferred) = InData%YawManRat Re_Xferred = Re_Xferred + 1 ReKiBuf(Re_Xferred) = InData%NacYawF @@ -4989,6 +5704,8 @@ SUBROUTINE SrvD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = InData%NumOuts Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts_DLL + Int_Xferred = Int_Xferred + 1 DO I = 1, LEN(InData%RootName) IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) Int_Xferred = Int_Xferred + 1 @@ -5040,72 +5757,8 @@ SUBROUTINE SrvD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, END DO ! I IntKiBuf(Int_Xferred) = TRANSFER(InData%UseBladedInterface, IntKiBuf(1)) Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%DLL_Ramp, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%DLL_DT - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%DLL_NumTrq - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Ptch_Cntrl - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Gain_OM - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GenPwr_Dem - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GenSpd_Dem - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GenSpd_MaxOM - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GenSpd_MinOM - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%GenSpd_TLU) ) 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%GenSpd_TLU,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GenSpd_TLU,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%GenSpd_TLU,1), UBOUND(InData%GenSpd_TLU,1) - ReKiBuf(Re_Xferred) = InData%GenSpd_TLU(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%GenTrq_Dem - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%GenTrq_TLU) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%UseLegacyInterface, IntKiBuf(1)) Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GenTrq_TLU,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GenTrq_TLU,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%GenTrq_TLU,1), UBOUND(InData%GenTrq_TLU,1) - ReKiBuf(Re_Xferred) = InData%GenTrq_TLU(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%Ptch_Max - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Ptch_Min - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Ptch_SetPnt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtchRate_Max - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtchRate_Min - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NacYaw_North - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%DLL_InFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_InFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I CALL DLLTypePack( InData%DLL_Trgt, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! DLL_Trgt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -5134,6 +5787,26 @@ SUBROUTINE SrvD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF + IntKiBuf(Int_Xferred) = TRANSFER(InData%DLL_Ramp, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%BlAlpha + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DLL_n + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%avcOUTNAME_LEN + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NacYaw_North + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AvgWindSpeed + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AirDens + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TrimCase + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TrimGain + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RotSpeedRef + Re_Xferred = Re_Xferred + 1 CALL TMD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%NTMD, ErrStat2, ErrMsg2, OnlySize ) ! NTMD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -5190,10 +5863,6 @@ SUBROUTINE SrvD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - ReKiBuf(Re_Xferred) = InData%AvgWindSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AirDens - Re_Xferred = Re_Xferred + 1 END SUBROUTINE SrvD_PackParam SUBROUTINE SrvD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -5227,8 +5896,6 @@ SUBROUTINE SrvD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Db_Xferred = Db_Xferred + 1 OutData%HSSBrDT = DbKiBuf(Db_Xferred) Db_Xferred = Db_Xferred + 1 - OutData%HSSBrFrac = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 OutData%HSSBrTqF = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 OutData%SIG_POSl = ReKiBuf(Re_Xferred) @@ -5325,8 +5992,6 @@ SUBROUTINE SrvD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Re_Xferred = Re_Xferred + 1 END DO END IF - OutData%BlAlpha = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 OutData%YawManRat = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 OutData%NacYawF = ReKiBuf(Re_Xferred) @@ -5435,6 +6100,8 @@ SUBROUTINE SrvD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Int_Xferred = Int_Xferred + 1 OutData%NumOuts = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 + OutData%NumOuts_DLL = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 DO I = 1, LEN(OutData%RootName) OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) Int_Xferred = Int_Xferred + 1 @@ -5501,78 +6168,8 @@ SUBROUTINE SrvD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs END DO ! I OutData%UseBladedInterface = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseBladedInterface) Int_Xferred = Int_Xferred + 1 - OutData%DLL_Ramp = TRANSFER(IntKiBuf(Int_Xferred), OutData%DLL_Ramp) - Int_Xferred = Int_Xferred + 1 - OutData%DLL_DT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%DLL_NumTrq = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Ptch_Cntrl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Gain_OM = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GenPwr_Dem = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GenSpd_Dem = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GenSpd_MaxOM = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GenSpd_MinOM = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GenSpd_TLU 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%GenSpd_TLU)) DEALLOCATE(OutData%GenSpd_TLU) - ALLOCATE(OutData%GenSpd_TLU(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GenSpd_TLU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%GenSpd_TLU,1), UBOUND(OutData%GenSpd_TLU,1) - OutData%GenSpd_TLU(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%GenTrq_Dem = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GenTrq_TLU not allocated - Int_Xferred = Int_Xferred + 1 - ELSE + OutData%UseLegacyInterface = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseLegacyInterface) Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%GenTrq_TLU)) DEALLOCATE(OutData%GenTrq_TLU) - ALLOCATE(OutData%GenTrq_TLU(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GenTrq_TLU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%GenTrq_TLU,1), UBOUND(OutData%GenTrq_TLU,1) - OutData%GenTrq_TLU(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%Ptch_Max = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Ptch_Min = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Ptch_SetPnt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtchRate_Max = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtchRate_Min = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NacYaw_North = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%DLL_InFile) - OutData%DLL_InFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -5613,6 +6210,26 @@ SUBROUTINE SrvD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + OutData%DLL_Ramp = TRANSFER(IntKiBuf(Int_Xferred), OutData%DLL_Ramp) + Int_Xferred = Int_Xferred + 1 + OutData%BlAlpha = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%DLL_n = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%avcOUTNAME_LEN = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NacYaw_North = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AvgWindSpeed = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AirDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TrimCase = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TrimGain = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RotSpeedRef = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -5693,10 +6310,6 @@ SUBROUTINE SrvD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%AvgWindSpeed = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AirDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 END SUBROUTINE SrvD_UnPackParam SUBROUTINE SrvD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -5769,8 +6382,6 @@ SUBROUTINE SrvD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg DstInputData%RotPwr = SrcInputData%RotPwr DstInputData%HorWindV = SrcInputData%HorWindV DstInputData%YawAngle = SrcInputData%YawAngle - DstInputData%ElecPwr_prev = SrcInputData%ElecPwr_prev - DstInputData%GenTrq_prev = SrcInputData%GenTrq_prev CALL TMD_CopyInput( SrcInputData%NTMD, DstInputData%NTMD, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN @@ -5889,8 +6500,6 @@ SUBROUTINE SrvD_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Re_BufSz = Re_BufSz + 1 ! RotPwr Re_BufSz = Re_BufSz + 1 ! HorWindV Re_BufSz = Re_BufSz + 1 ! YawAngle - Re_BufSz = Re_BufSz + 1 ! ElecPwr_prev - Re_BufSz = Re_BufSz + 1 ! GenTrq_prev ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! NTMD: size of buffers for each call to pack subtype CALL TMD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%NTMD, ErrStat2, ErrMsg2, .TRUE. ) ! NTMD @@ -6053,10 +6662,6 @@ SUBROUTINE SrvD_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, ReKiBuf(Re_Xferred) = InData%HorWindV Re_Xferred = Re_Xferred + 1 ReKiBuf(Re_Xferred) = InData%YawAngle - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ElecPwr_prev - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GenTrq_prev Re_Xferred = Re_Xferred + 1 CALL TMD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%NTMD, ErrStat2, ErrMsg2, OnlySize ) ! NTMD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6263,10 +6868,6 @@ SUBROUTINE SrvD_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs OutData%HorWindV = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 OutData%YawAngle = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ElecPwr_prev = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GenTrq_prev = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -7001,12 +7602,10 @@ SUBROUTINE SrvD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ScaleFactor = t_out / t(2) IF (ALLOCATED(u_out%BlPitch) .AND. ALLOCATED(u1%BlPitch)) THEN DO i1 = LBOUND(u_out%BlPitch,1),UBOUND(u_out%BlPitch,1) - b = -(u1%BlPitch(i1) - u2%BlPitch(i1)) - u_out%BlPitch(i1) = u1%BlPitch(i1) + b * ScaleFactor + CALL Angles_ExtrapInterp( u1%BlPitch(i1), u2%BlPitch(i1), tin, u_out%BlPitch(i1), tin_out ) END DO END IF ! check if allocated - b = -(u1%Yaw - u2%Yaw) - u_out%Yaw = u1%Yaw + b * ScaleFactor + CALL Angles_ExtrapInterp( u1%Yaw, u2%Yaw, tin, u_out%Yaw, tin_out ) b = -(u1%YawRate - u2%YawRate) u_out%YawRate = u1%YawRate + b * ScaleFactor b = -(u1%LSS_Spd - u2%LSS_Spd) @@ -7015,14 +7614,12 @@ SUBROUTINE SrvD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg u_out%HSS_Spd = u1%HSS_Spd + b * ScaleFactor b = -(u1%RotSpeed - u2%RotSpeed) u_out%RotSpeed = u1%RotSpeed + b * ScaleFactor - b = -(u1%ExternalYawPosCom - u2%ExternalYawPosCom) - u_out%ExternalYawPosCom = u1%ExternalYawPosCom + b * ScaleFactor + CALL Angles_ExtrapInterp( u1%ExternalYawPosCom, u2%ExternalYawPosCom, tin, u_out%ExternalYawPosCom, tin_out ) b = -(u1%ExternalYawRateCom - u2%ExternalYawRateCom) u_out%ExternalYawRateCom = u1%ExternalYawRateCom + b * ScaleFactor IF (ALLOCATED(u_out%ExternalBlPitchCom) .AND. ALLOCATED(u1%ExternalBlPitchCom)) THEN DO i1 = LBOUND(u_out%ExternalBlPitchCom,1),UBOUND(u_out%ExternalBlPitchCom,1) - b = -(u1%ExternalBlPitchCom(i1) - u2%ExternalBlPitchCom(i1)) - u_out%ExternalBlPitchCom(i1) = u1%ExternalBlPitchCom(i1) + b * ScaleFactor + CALL Angles_ExtrapInterp( u1%ExternalBlPitchCom(i1), u2%ExternalBlPitchCom(i1), tin, u_out%ExternalBlPitchCom(i1), tin_out ) END DO END IF ! check if allocated b = -(u1%ExternalGenTrq - u2%ExternalGenTrq) @@ -7033,10 +7630,8 @@ SUBROUTINE SrvD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg u_out%ExternalHSSBrFrac = u1%ExternalHSSBrFrac + b * ScaleFactor b = -(u1%TwrAccel - u2%TwrAccel) u_out%TwrAccel = u1%TwrAccel + b * ScaleFactor - b = -(u1%YawErr - u2%YawErr) - u_out%YawErr = u1%YawErr + b * ScaleFactor - b = -(u1%WindDir - u2%WindDir) - u_out%WindDir = u1%WindDir + b * ScaleFactor + CALL Angles_ExtrapInterp( u1%YawErr, u2%YawErr, tin, u_out%YawErr, tin_out ) + CALL Angles_ExtrapInterp( u1%WindDir, u2%WindDir, tin, u_out%WindDir, tin_out ) DO i1 = LBOUND(u_out%RootMyc,1),UBOUND(u_out%RootMyc,1) b = -(u1%RootMyc(i1) - u2%RootMyc(i1)) u_out%RootMyc(i1) = u1%RootMyc(i1) + b * ScaleFactor @@ -7075,12 +7670,7 @@ SUBROUTINE SrvD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg u_out%RotPwr = u1%RotPwr + b * ScaleFactor b = -(u1%HorWindV - u2%HorWindV) u_out%HorWindV = u1%HorWindV + b * ScaleFactor - b = -(u1%YawAngle - u2%YawAngle) - u_out%YawAngle = u1%YawAngle + b * ScaleFactor - b = -(u1%ElecPwr_prev - u2%ElecPwr_prev) - u_out%ElecPwr_prev = u1%ElecPwr_prev + b * ScaleFactor - b = -(u1%GenTrq_prev - u2%GenTrq_prev) - u_out%GenTrq_prev = u1%GenTrq_prev + b * ScaleFactor + CALL Angles_ExtrapInterp( u1%YawAngle, u2%YawAngle, tin, u_out%YawAngle, tin_out ) CALL TMD_Input_ExtrapInterp1( u1%NTMD, u2%NTMD, tin, u_out%NTMD, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL TMD_Input_ExtrapInterp1( u1%TTMD, u2%TTMD, tin, u_out%TTMD, tin_out, ErrStat2, ErrMsg2 ) @@ -7150,14 +7740,10 @@ SUBROUTINE SrvD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ALLOCATED(u_out%BlPitch) .AND. ALLOCATED(u1%BlPitch)) THEN DO i1 = LBOUND(u_out%BlPitch,1),UBOUND(u_out%BlPitch,1) - b = (t(3)**2*(u1%BlPitch(i1) - u2%BlPitch(i1)) + t(2)**2*(-u1%BlPitch(i1) + u3%BlPitch(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%BlPitch(i1) + t(3)*u2%BlPitch(i1) - t(2)*u3%BlPitch(i1) ) * scaleFactor - u_out%BlPitch(i1) = u1%BlPitch(i1) + b + c * t_out + 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 - b = (t(3)**2*(u1%Yaw - u2%Yaw) + t(2)**2*(-u1%Yaw + u3%Yaw))* scaleFactor - c = ( (t(2)-t(3))*u1%Yaw + t(3)*u2%Yaw - t(2)*u3%Yaw ) * scaleFactor - u_out%Yaw = u1%Yaw + b + c * t_out + CALL Angles_ExtrapInterp( u1%Yaw, u2%Yaw, u3%Yaw, tin, u_out%Yaw, tin_out ) b = (t(3)**2*(u1%YawRate - u2%YawRate) + t(2)**2*(-u1%YawRate + u3%YawRate))* scaleFactor c = ( (t(2)-t(3))*u1%YawRate + t(3)*u2%YawRate - t(2)*u3%YawRate ) * scaleFactor u_out%YawRate = u1%YawRate + b + c * t_out @@ -7170,17 +7756,13 @@ SUBROUTINE SrvD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er b = (t(3)**2*(u1%RotSpeed - u2%RotSpeed) + t(2)**2*(-u1%RotSpeed + u3%RotSpeed))* scaleFactor c = ( (t(2)-t(3))*u1%RotSpeed + t(3)*u2%RotSpeed - t(2)*u3%RotSpeed ) * scaleFactor u_out%RotSpeed = u1%RotSpeed + b + c * t_out - b = (t(3)**2*(u1%ExternalYawPosCom - u2%ExternalYawPosCom) + t(2)**2*(-u1%ExternalYawPosCom + u3%ExternalYawPosCom))* scaleFactor - c = ( (t(2)-t(3))*u1%ExternalYawPosCom + t(3)*u2%ExternalYawPosCom - t(2)*u3%ExternalYawPosCom ) * scaleFactor - u_out%ExternalYawPosCom = u1%ExternalYawPosCom + b + c * t_out + CALL Angles_ExtrapInterp( u1%ExternalYawPosCom, u2%ExternalYawPosCom, u3%ExternalYawPosCom, tin, u_out%ExternalYawPosCom, tin_out ) b = (t(3)**2*(u1%ExternalYawRateCom - u2%ExternalYawRateCom) + t(2)**2*(-u1%ExternalYawRateCom + u3%ExternalYawRateCom))* scaleFactor c = ( (t(2)-t(3))*u1%ExternalYawRateCom + t(3)*u2%ExternalYawRateCom - t(2)*u3%ExternalYawRateCom ) * scaleFactor u_out%ExternalYawRateCom = u1%ExternalYawRateCom + b + c * t_out IF (ALLOCATED(u_out%ExternalBlPitchCom) .AND. ALLOCATED(u1%ExternalBlPitchCom)) THEN DO i1 = LBOUND(u_out%ExternalBlPitchCom,1),UBOUND(u_out%ExternalBlPitchCom,1) - b = (t(3)**2*(u1%ExternalBlPitchCom(i1) - u2%ExternalBlPitchCom(i1)) + t(2)**2*(-u1%ExternalBlPitchCom(i1) + u3%ExternalBlPitchCom(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%ExternalBlPitchCom(i1) + t(3)*u2%ExternalBlPitchCom(i1) - t(2)*u3%ExternalBlPitchCom(i1) ) * scaleFactor - u_out%ExternalBlPitchCom(i1) = u1%ExternalBlPitchCom(i1) + b + c * t_out + 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 b = (t(3)**2*(u1%ExternalGenTrq - u2%ExternalGenTrq) + t(2)**2*(-u1%ExternalGenTrq + u3%ExternalGenTrq))* scaleFactor @@ -7195,12 +7777,8 @@ SUBROUTINE SrvD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er b = (t(3)**2*(u1%TwrAccel - u2%TwrAccel) + t(2)**2*(-u1%TwrAccel + u3%TwrAccel))* scaleFactor c = ( (t(2)-t(3))*u1%TwrAccel + t(3)*u2%TwrAccel - t(2)*u3%TwrAccel ) * scaleFactor u_out%TwrAccel = u1%TwrAccel + b + c * t_out - b = (t(3)**2*(u1%YawErr - u2%YawErr) + t(2)**2*(-u1%YawErr + u3%YawErr))* scaleFactor - c = ( (t(2)-t(3))*u1%YawErr + t(3)*u2%YawErr - t(2)*u3%YawErr ) * scaleFactor - u_out%YawErr = u1%YawErr + b + c * t_out - b = (t(3)**2*(u1%WindDir - u2%WindDir) + t(2)**2*(-u1%WindDir + u3%WindDir))* scaleFactor - c = ( (t(2)-t(3))*u1%WindDir + t(3)*u2%WindDir - t(2)*u3%WindDir ) * scaleFactor - u_out%WindDir = u1%WindDir + b + c * t_out + CALL Angles_ExtrapInterp( u1%YawErr, u2%YawErr, u3%YawErr, tin, u_out%YawErr, tin_out ) + CALL Angles_ExtrapInterp( u1%WindDir, u2%WindDir, u3%WindDir, tin, u_out%WindDir, tin_out ) DO i1 = LBOUND(u_out%RootMyc,1),UBOUND(u_out%RootMyc,1) b = (t(3)**2*(u1%RootMyc(i1) - u2%RootMyc(i1)) + t(2)**2*(-u1%RootMyc(i1) + u3%RootMyc(i1)))* scaleFactor c = ( (t(2)-t(3))*u1%RootMyc(i1) + t(3)*u2%RootMyc(i1) - t(2)*u3%RootMyc(i1) ) * scaleFactor @@ -7256,15 +7834,7 @@ SUBROUTINE SrvD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er b = (t(3)**2*(u1%HorWindV - u2%HorWindV) + t(2)**2*(-u1%HorWindV + u3%HorWindV))* scaleFactor c = ( (t(2)-t(3))*u1%HorWindV + t(3)*u2%HorWindV - t(2)*u3%HorWindV ) * scaleFactor u_out%HorWindV = u1%HorWindV + b + c * t_out - b = (t(3)**2*(u1%YawAngle - u2%YawAngle) + t(2)**2*(-u1%YawAngle + u3%YawAngle))* scaleFactor - c = ( (t(2)-t(3))*u1%YawAngle + t(3)*u2%YawAngle - t(2)*u3%YawAngle ) * scaleFactor - u_out%YawAngle = u1%YawAngle + b + c * t_out - b = (t(3)**2*(u1%ElecPwr_prev - u2%ElecPwr_prev) + t(2)**2*(-u1%ElecPwr_prev + u3%ElecPwr_prev))* scaleFactor - c = ( (t(2)-t(3))*u1%ElecPwr_prev + t(3)*u2%ElecPwr_prev - t(2)*u3%ElecPwr_prev ) * scaleFactor - u_out%ElecPwr_prev = u1%ElecPwr_prev + b + c * t_out - b = (t(3)**2*(u1%GenTrq_prev - u2%GenTrq_prev) + t(2)**2*(-u1%GenTrq_prev + u3%GenTrq_prev))* scaleFactor - c = ( (t(2)-t(3))*u1%GenTrq_prev + t(3)*u2%GenTrq_prev - t(2)*u3%GenTrq_prev ) * scaleFactor - u_out%GenTrq_prev = u1%GenTrq_prev + b + c * t_out + CALL Angles_ExtrapInterp( u1%YawAngle, u2%YawAngle, u3%YawAngle, tin, u_out%YawAngle, tin_out ) CALL TMD_Input_ExtrapInterp2( u1%NTMD, u2%NTMD, u3%NTMD, tin, u_out%NTMD, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL TMD_Input_ExtrapInterp2( u1%TTMD, u2%TTMD, u3%TTMD, tin, u_out%TTMD, tin_out, ErrStat2, ErrMsg2 ) @@ -7381,8 +7951,7 @@ SUBROUTINE SrvD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs END IF ! check if allocated IF (ALLOCATED(y_out%BlPitchCom) .AND. ALLOCATED(y1%BlPitchCom)) THEN DO i1 = LBOUND(y_out%BlPitchCom,1),UBOUND(y_out%BlPitchCom,1) - b = -(y1%BlPitchCom(i1) - y2%BlPitchCom(i1)) - y_out%BlPitchCom(i1) = y1%BlPitchCom(i1) + b * ScaleFactor + CALL Angles_ExtrapInterp( y1%BlPitchCom(i1), y2%BlPitchCom(i1), tin, y_out%BlPitchCom(i1), tin_out ) END DO END IF ! check if allocated b = -(y1%YawMom - y2%YawMom) @@ -7475,9 +8044,7 @@ SUBROUTINE SrvD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E END IF ! check if allocated IF (ALLOCATED(y_out%BlPitchCom) .AND. ALLOCATED(y1%BlPitchCom)) THEN DO i1 = LBOUND(y_out%BlPitchCom,1),UBOUND(y_out%BlPitchCom,1) - b = (t(3)**2*(y1%BlPitchCom(i1) - y2%BlPitchCom(i1)) + t(2)**2*(-y1%BlPitchCom(i1) + y3%BlPitchCom(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%BlPitchCom(i1) + t(3)*y2%BlPitchCom(i1) - t(2)*y3%BlPitchCom(i1) ) * scaleFactor - y_out%BlPitchCom(i1) = y1%BlPitchCom(i1) + b + c * t_out + 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 b = (t(3)**2*(y1%YawMom - y2%YawMom) + t(2)**2*(-y1%YawMom + y3%YawMom))* scaleFactor diff --git a/modules/servodyn/src/TMD.f90 b/modules/servodyn/src/TMD.f90 index bce0a770e6..df29a5426d 100644 --- a/modules/servodyn/src/TMD.f90 +++ b/modules/servodyn/src/TMD.f90 @@ -442,7 +442,7 @@ END SUBROUTINE TMD_UpdateStates !! !! For details, see: !! Press, W. H.; Flannery, B. P.; Teukolsky, S. A.; and Vetterling, W. T. "Runge-Kutta Method" and "Adaptive Step Size Control for -!! Runge-Kutta." �16.1 and 16.2 in Numerical Recipes in FORTRAN: The Art of Scientific Computing, 2nd ed. Cambridge, England: +!! Runge-Kutta." Sections 16.1 and 16.2 in Numerical Recipes in FORTRAN: The Art of Scientific Computing, 2nd ed. Cambridge, England: !! Cambridge University Press, pp. 704-716, 1992. SUBROUTINE TMD_RK4( t, n, u, utimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) !.................................................................................................................................. diff --git a/modules/servodyn/src/TMD_Registry.txt b/modules/servodyn/src/TMD_Registry.txt index 105c5a0e95..c2d74036c8 100644 --- a/modules/servodyn/src/TMD_Registry.txt +++ b/modules/servodyn/src/TMD_Registry.txt @@ -53,8 +53,8 @@ typedef ^ ^ ReKi Gravity - - - "Gravitational acceleration" m/s^2 typedef ^ ^ ReKi r_N_O_G {3} - - "nacelle origin for setting up mesh" - # Define outputs from the initialization routine here: typedef ^ InitOutputType SiKi DummyInitOut - - - "dummy init output" - -#typedef ^ InitOutputType CHARACTER(10) WriteOutputHdr {:} - - "Names of the output-to-file channels" - -#typedef ^ InitOutputType CHARACTER(10) WriteOutputUnt {:}- - "Units of the output-to-file channels" - +#typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - "Names of the output-to-file channels" - +#typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputUnt {:}- - "Units of the output-to-file channels" - # ..... States .................................................................................................................... # Define continuous (differentiable) states here: From 4955d0f56b0fc1100b3f45bba37cb2cbba4fd649 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Tue, 3 Dec 2019 10:41:52 -0700 Subject: [PATCH 13/72] SrvD: fix issue if only one blade is used also sync some other subroutines + types file --- modules/servodyn/src/BladedInterface.f90 | 4 +- modules/servodyn/src/ServoDyn.f90 | 234 +++++++++++------------ modules/servodyn/src/ServoDyn_Types.f90 | 52 ++--- 3 files changed, 145 insertions(+), 145 deletions(-) diff --git a/modules/servodyn/src/BladedInterface.f90 b/modules/servodyn/src/BladedInterface.f90 index 23a9f79447..ab7f173d59 100644 --- a/modules/servodyn/src/BladedInterface.f90 +++ b/modules/servodyn/src/BladedInterface.f90 @@ -774,8 +774,10 @@ SUBROUTINE Fill_avrSWAP( t, u, p, ErrMsgSz, dll_data ) dll_data%avrSWAP(30) = u%RootMyc(1) !> * Record 30: Blade 1 root out-of-plane bending moment (Nm) [SrvD input] dll_data%avrSWAP(31) = u%RootMyc(2) !> * Record 31: Blade 2 root out-of-plane bending moment (Nm) [SrvD input] dll_data%avrSWAP(32) = u%RootMyc(3) !> * Record 32: Blade 3 root out-of-plane bending moment (Nm) [SrvD input] +IF ( p%NumBl > 1 ) THEN dll_data%avrSWAP(33) = u%BlPitch(2) !> * Record 33: Blade 2 pitch angle (rad) [SrvD input] -IF ( p%NumBl > 2 ) THEN +END IF +IF ( p%NumBl > 2 ) THEN dll_data%avrSWAP(34) = u%BlPitch(3) !> * Record 34: Blade 3 pitch angle (rad) [SrvD input] ! dll_data%avrSWAP(34) = u%BlPitch(3) !> * Record 34: Blade 3 pitch angle (rad) [SrvD input] END IF diff --git a/modules/servodyn/src/ServoDyn.f90 b/modules/servodyn/src/ServoDyn.f90 index bcf72c0a97..b282be860f 100644 --- a/modules/servodyn/src/ServoDyn.f90 +++ b/modules/servodyn/src/ServoDyn.f90 @@ -235,8 +235,8 @@ SUBROUTINE SrvD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitO CALL SrvD_ReadInput( InitInp, InputFileData, Interval, p%RootName, ErrStat2, ErrMsg2 ) CALL CheckError( ErrStat2, ErrMsg2 ) IF (ErrStat >= AbortErrLev) RETURN - - CALL ValidatePrimaryData( InitInp, InputFileData, InitInp%NumBl, ErrStat2, ErrMsg2 ) + + CALL ValidatePrimaryData( InitInp, InputFileData, ErrStat2, ErrMsg2 ) CALL CheckError( ErrStat2, ErrMsg2 ) IF (ErrStat >= AbortErrLev) RETURN @@ -249,7 +249,7 @@ SUBROUTINE SrvD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitO !............................................................................................ ! Define parameters here: !............................................................................................ - CALL SrvD_SetParameters( InputFileData, p, ErrStat2, ErrMsg2 ) + CALL SrvD_SetParameters( InputFileData, p, ErrStat2, ErrMsg2 ) CALL CheckError( ErrStat2, ErrMsg2 ) IF (ErrStat >= AbortErrLev) RETURN !p%DT = Interval @@ -868,7 +868,7 @@ SUBROUTINE SrvD_UpdateStates( t, n, Inputs, InputTimes, p, x, xd, z, OtherState, ! update remaining states to values at t+dt: !............................................................................................................................... - ! Torque control + ! Torque control: CALL Torque_UpdateStates( t_next, u_interp, p, x, xd, z, OtherState, m, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -1742,7 +1742,7 @@ SUBROUTINE SrvD_ReadInput( InitInp, InputFileData, Default_DT, OutFileRoot, ErrS ! get the primary/platform input-file data - CALL ReadPrimaryFile( InitInp%InputFile, InputFileData, OutFileRoot, UnEcho, ErrStat2, ErrMsg2 ) + CALL ReadPrimaryFile( InitInp, InputFileData, OutFileRoot, UnEcho, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) THEN IF ( UnEcho > 0 ) CLOSE( UnEcho ) @@ -1763,20 +1763,20 @@ END SUBROUTINE SrvD_ReadInput !---------------------------------------------------------------------------------------------------------------------------------- !> This routine reads in the primary ServoDyn input file and places the values it reads in the InputFileData structure. !! It opens and prints to an echo file if requested. -SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, OutFileRoot, UnEc, ErrStat, ErrMsg ) +SUBROUTINE ReadPrimaryFile( InitInp, InputFileData, OutFileRoot, UnEc, ErrStat, ErrMsg ) !.................................................................................................................................. IMPLICIT NONE ! Passed variables - INTEGER(IntKi), INTENT(OUT) :: UnEc !< I/O unit for echo file. If > 0, file is open for writing. - INTEGER(IntKi), INTENT(OUT) :: ErrStat !< Error status + INTEGER(IntKi), INTENT(OUT) :: UnEc !< I/O unit for echo file. If > 0, file is open for writing. + INTEGER(IntKi), INTENT(OUT) :: ErrStat !< Error status - CHARACTER(*), INTENT(IN) :: InputFile !< Name of the file containing the primary input data - CHARACTER(*), INTENT(OUT) :: ErrMsg !< Error message - CHARACTER(*), INTENT(IN) :: OutFileRoot !< The rootname of the echo file, possibly opened in this routine + TYPE(SrvD_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine + CHARACTER(*), INTENT(OUT) :: ErrMsg !< Error message + CHARACTER(*), INTENT(IN) :: OutFileRoot !< The rootname of the echo file, possibly opened in this routine - TYPE(SrvD_InputFile), INTENT(INOUT) :: InputFileData !< All the data in the ServoDyn input file + TYPE(SrvD_InputFile), INTENT(INOUT) :: InputFileData !< All the data in the ServoDyn input file ! Local variables: REAL(ReKi) :: TmpRAry(2) ! A temporary array to read a table from the input file @@ -1793,14 +1793,13 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, OutFileRoot, UnEc, ErrStat - ! Initialize some variables: ErrStat = ErrID_None ErrMsg = "" UnEc = -1 Echo = .FALSE. - CALL GetPath( InputFile, PriPath ) ! Input files will be relative to the path where the primary input file is located. + CALL GetPath( InitInp%InputFile, PriPath ) ! Input files will be relative to the path where the primary input file is located. CALL AllocAry( InputFileData%OutList, MaxOutPts, "ServoDyn Input File's Outlist", ErrStat2, ErrMsg2 ) @@ -1817,7 +1816,7 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, OutFileRoot, UnEc, ErrStat ! Open the Primary input file. - CALL OpenFInpFile ( UnIn, InputFile, ErrStat2, ErrMsg2 ) + CALL OpenFInpFile ( UnIn, InitInp%InputFile, ErrStat2, ErrMsg2 ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN @@ -1830,24 +1829,24 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, OutFileRoot, UnEc, ErrStat DO !-------------------------- HEADER --------------------------------------------- - CALL ReadCom( UnIn, InputFile, 'File header: Module Version (line 1)', ErrStat2, ErrMsg2, UnEc ) + CALL ReadCom( UnIn, InitInp%InputFile, 'File header: Module Version (line 1)', ErrStat2, ErrMsg2, UnEc ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN - CALL ReadStr( UnIn, InputFile, FTitle, 'FTitle', 'File Header: File Description (line 2)', ErrStat2, ErrMsg2, UnEc ) + CALL ReadStr( UnIn, InitInp%InputFile, FTitle, 'FTitle', 'File Header: File Description (line 2)', ErrStat2, ErrMsg2, UnEc ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN !---------------------- SIMULATION CONTROL -------------------------------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: Simulation Control', ErrStat2, ErrMsg2, UnEc ) + CALL ReadCom( UnIn, InitInp%InputFile, 'Section Header: Simulation Control', ErrStat2, ErrMsg2, UnEc ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! Echo - Echo input to ".ech". - CALL ReadVar( UnIn, InputFile, Echo, 'Echo', 'Echo switch', ErrStat2, ErrMsg2, UnEc ) + CALL ReadVar( UnIn, InitInp%InputFile, Echo, 'Echo', 'Echo switch', ErrStat2, ErrMsg2, UnEc ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN @@ -1862,11 +1861,11 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, OutFileRoot, UnEc, ErrStat CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN - IF ( UnEc > 0 ) WRITE (UnEc,'(/,A,/)') 'Data from '//TRIM(SrvD_Ver%Name)//' primary input file "'//TRIM( InputFile )//'":' + IF ( UnEc > 0 ) WRITE (UnEc,'(/,A,/)') 'Data from '//TRIM(SrvD_Ver%Name)//' primary input file "'//TRIM( InitInp%InputFile )//'":' REWIND( UnIn, IOSTAT=ErrStat2 ) IF (ErrStat2 /= 0_IntKi ) THEN - CALL CheckError( ErrID_Fatal, 'Error rewinding file "'//TRIM(InputFile)//'".' ) + CALL CheckError( ErrID_Fatal, 'Error rewinding file "'//TRIM(InitInp%InputFile)//'".' ) RETURN END IF @@ -1879,430 +1878,430 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, OutFileRoot, UnEc, ErrStat ! DT - Communication interval for controllers (s): - CALL ReadVar( UnIn, InputFile, Line, "DT", "Communication interval for controllers (s)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, Line, "DT", "Communication interval for controllers (s)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN CALL Conv2UC( Line ) IF ( INDEX(Line, "DEFAULT" ) /= 1 ) THEN ! If it's not "default", read this variable; otherwise use the value already stored in InputFileData%DT READ( Line, *, IOSTAT=IOS) InputFileData%DT - CALL CheckIOS ( IOS, InputFile, 'DT', NumType, ErrStat2, ErrMsg2 ) + CALL CheckIOS ( IOS, InitInp%InputFile, 'DT', NumType, ErrStat2, ErrMsg2 ) CALL CheckError(ErrStat2, ErrMsg2) IF ( ErrStat >= AbortErrLev ) RETURN END IF !---------------------- PITCH CONTROL ------------------------------------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: Pitch Control', ErrStat2, ErrMsg2, UnEc ) + CALL ReadCom( UnIn, InitInp%InputFile, 'Section Header: Pitch Control', ErrStat2, ErrMsg2, UnEc ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! PCMode - Pitch control mode (-): - CALL ReadVar( UnIn, InputFile, InputFileData%PCMode, "PCMode", "Pitch control mode (-)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%PCMode, "PCMode", "Pitch control mode (-)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! TPCOn - Time to enable active pitch control [unused when PCMode=0] (s): - CALL ReadVar( UnIn, InputFile, InputFileData%TPCOn, "TPCOn", "Time to enable active pitch control (s)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%TPCOn, "TPCOn", "Time to enable active pitch control (s)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! TPitManS - Time to start override pitch maneuver for blade (K) and end standard pitch control (s): - CALL ReadAryLines( UnIn, InputFile, InputFileData%TPitManS, SIZE(InputFileData%TPitManS), "TPitManS", & + CALL ReadAryLines( UnIn, InitInp%InputFile, InputFileData%TPitManS, SIZE(InputFileData%TPitManS), "TPitManS", & "Time to start override pitch maneuver for blade K and end standard pitch control (s)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! PitManRat - Pitch rates at which override pitch maneuvers head toward final pitch angles (degrees/s) (read in deg/s and converted to radians/s here): - CALL ReadAryLines( UnIn, InputFile, InputFileData%PitManRat, SIZE(InputFileData%PitManRat), "PitManRat", "Pitch rates at which override pitch maneuvers head toward final pitch angles (deg/s)", ErrStat2, ErrMsg2, UnEc) + CALL ReadAryLines( UnIn, InitInp%InputFile, InputFileData%PitManRat, SIZE(InputFileData%PitManRat), "PitManRat", "Pitch rates at which override pitch maneuvers head toward final pitch angles (deg/s)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%PitManRat = InputFileData%PitManRat*D2R ! BlPitchF - Blade (K) final pitch for pitch maneuvers (deg) (read from file in degrees and converted to radians here): - CALL ReadAryLines( UnIn, InputFile, InputFileData%BlPitchF, SIZE(InputFileData%BlPitchF), "BlPitchF", "Blade K final pitch for pitch maneuvers (deg)", ErrStat2, ErrMsg2, UnEc) + CALL ReadAryLines( UnIn, InitInp%InputFile, InputFileData%BlPitchF, SIZE(InputFileData%BlPitchF), "BlPitchF", "Blade K final pitch for pitch maneuvers (deg)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%BlPitchF = InputFileData%BlPitchF*D2R !---------------------- GENERATOR AND TORQUE CONTROL ---------------------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: Generator and Torque Control', ErrStat2, ErrMsg2, UnEc ) + CALL ReadCom( UnIn, InitInp%InputFile, 'Section Header: Generator and Torque Control', ErrStat2, ErrMsg2, UnEc ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! VSContrl - Variable-speed control mode {0: none, 1: simple VS, 3: user-defined from routine UserVSCont, 4: user-defined from Simulink/LabVIEW} (-): - CALL ReadVar( UnIn, InputFile, InputFileData%VSContrl, "VSContrl", "Variable-speed control mode (-)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%VSContrl, "VSContrl", "Variable-speed control mode (-)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! GenModel - Generator model {1: simple, 2: Thevenin, 3: user-defined from routine UserGen} [used only when VSContrl=0] (-): - CALL ReadVar( UnIn, InputFile, InputFileData%GenModel, "GenModel", "Generator model {1: simple, 2: Thevenin, 3: user-defined from routine UserGen} [used only when VSContrl=0] (-)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%GenModel, "GenModel", "Generator model {1: simple, 2: Thevenin, 3: user-defined from routine UserGen} [used only when VSContrl=0] (-)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! GenEff - Generator efficiency [ignored by the Thevenin and user-defined generator models] (%) (read in percent and converted to a fraction here): - CALL ReadVar( UnIn, InputFile, InputFileData%GenEff, "GenEff", "Generator efficiency [ignored by the Thevenin and user-defined generator models] (%)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%GenEff, "GenEff", "Generator efficiency [ignored by the Thevenin and user-defined generator models] (%)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%GenEff = InputFileData%GenEff*0.01 ! GenTiStr - Method to start the generator {T: timed using TimGenOn, F: generator speed using SpdGenOn} (flag): - CALL ReadVar( UnIn, InputFile, InputFileData%GenTiStr, "GenTiStr", "Method to start the generator {T: timed using TimGenOn, F: generator speed using SpdGenOn} (flag)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%GenTiStr, "GenTiStr", "Method to start the generator {T: timed using TimGenOn, F: generator speed using SpdGenOn} (flag)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! GenTiStp - Method to stop the generator {T: timed using TimGenOf, F: when generator power = 0} (flag): - CALL ReadVar( UnIn, InputFile, InputFileData%GenTiStp, "GenTiStp", "Method to stop the generator {T: timed using TimGenOf, F: when generator power = 0} (flag)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%GenTiStp, "GenTiStp", "Method to stop the generator {T: timed using TimGenOf, F: when generator power = 0} (flag)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! SpdGenOn - Generator speed to turn on the generator for a startup (HSS speed) [used only when GenTiStr=False] (rpm) (read in rpm and converted to rad/sec here): - CALL ReadVar( UnIn, InputFile, InputFileData%SpdGenOn, "SpdGenOn", "Generator speed to turn on the generator for a startup (HSS speed) [used only when GenTiStr=False] (rpm)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%SpdGenOn, "SpdGenOn", "Generator speed to turn on the generator for a startup (HSS speed) [used only when GenTiStr=False] (rpm)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%SpdGenOn = InputFileData%SpdGenOn*RPM2RPS ! TimGenOn - Time to turn on the generator for a startup [used only when GenTiStr=True] (s): - CALL ReadVar( UnIn, InputFile, InputFileData%TimGenOn, "TimGenOn", "Time to turn on the generator for a startup [used only when GenTiStr=True] (s)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%TimGenOn, "TimGenOn", "Time to turn on the generator for a startup [used only when GenTiStr=True] (s)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! TimGenOf - Time to turn off the generator [used only when GenTiStp=True] (s): - CALL ReadVar( UnIn, InputFile, InputFileData%TimGenOf, "TimGenOf", "Time to turn off the generator [used only when GenTiStp=True] (s)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%TimGenOf, "TimGenOf", "Time to turn off the generator [used only when GenTiStp=True] (s)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN !---------------------- SIMPLE VARIABLE-SPEED TORQUE CONTROL -------------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: Simple Variable-Speed Torque Control', ErrStat2, ErrMsg2, UnEc ) + CALL ReadCom( UnIn, InitInp%InputFile, 'Section Header: Simple Variable-Speed Torque Control', ErrStat2, ErrMsg2, UnEc ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! VS_RtGnSp - Rated generator speed for simple variable-speed generator control (HSS side) [used only when VSContrl=1] (rpm) (read in rpm and converted to rad/sec here): - CALL ReadVar( UnIn, InputFile, InputFileData%VS_RtGnSp, "VS_RtGnSp", "Rated generator speed for simple variable-speed generator control (HSS side) [used only when VSContrl=1] (rpm)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%VS_RtGnSp, "VS_RtGnSp", "Rated generator speed for simple variable-speed generator control (HSS side) [used only when VSContrl=1] (rpm)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%VS_RtGnSp = InputFileData%VS_RtGnSp*RPM2RPS ! VS_RtTq - Rated generator torque/constant generator torque in Region 3 for simple variable-speed generator control (HSS side) [used only when VSContrl=1] (N-m): - CALL ReadVar( UnIn, InputFile, InputFileData%VS_RtTq, "VS_RtTq", "Rated generator torque/constant generator torque in Region 3 for simple variable-speed generator control (HSS side) [used only when VSContrl=1] (N-m)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%VS_RtTq, "VS_RtTq", "Rated generator torque/constant generator torque in Region 3 for simple variable-speed generator control (HSS side) [used only when VSContrl=1] (N-m)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! VS_Rgn2K - Generator torque constant in Region 2 for simple variable-speed generator control (HSS side) [used only when VSContrl=1] (N-m/rpm^2) (read in N-m/rpm^2 and converted to N-m/(rad/s)^2 here: - CALL ReadVar( UnIn, InputFile, InputFileData%VS_Rgn2K, "VS_Rgn2K", "Generator torque constant in Region 2 for simple variable-speed generator control (HSS side) [used only when VSContrl=1] (N-m/rpm^2)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%VS_Rgn2K, "VS_Rgn2K", "Generator torque constant in Region 2 for simple variable-speed generator control (HSS side) [used only when VSContrl=1] (N-m/rpm^2)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%VS_Rgn2K = InputFileData%VS_Rgn2K/( RPM2RPS**2 ) ! VS_SlPc - Rated generator slip percentage in Region 2 1/2 for simple variable-speed generator control [used only when VSContrl=1] (%) (read in percent and converted to a fraction here): - CALL ReadVar( UnIn, InputFile, InputFileData%VS_SlPc, "VS_SlPc", "Rated generator slip percentage in Region 2 1/2 for simple variable-speed generator control [used only when VSContrl=1] (%)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%VS_SlPc, "VS_SlPc", "Rated generator slip percentage in Region 2 1/2 for simple variable-speed generator control [used only when VSContrl=1] (%)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%VS_SlPc = InputFileData%VS_SlPc*.01 !---------------------- SIMPLE INDUCTION GENERATOR ------------------------------ - CALL ReadCom( UnIn, InputFile, 'Section Header: Simple Induction Generator', ErrStat2, ErrMsg2, UnEc ) + CALL ReadCom( UnIn, InitInp%InputFile, 'Section Header: Simple Induction Generator', ErrStat2, ErrMsg2, UnEc ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! SIG_SlPc - Rated generator slip percentage [used only when VSContrl=0 and GenModel=1] (%) (read in percent and converted to a fraction here): - CALL ReadVar( UnIn, InputFile, InputFileData%SIG_SlPc, "SIG_SlPc", "Rated generator slip percentage [used only when VSContrl=0 and GenModel=1] (%)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%SIG_SlPc, "SIG_SlPc", "Rated generator slip percentage [used only when VSContrl=0 and GenModel=1] (%)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%SIG_SlPc = InputFileData%SIG_SlPc*.01 ! SIG_SySp - Synchronous (zero-torque) generator speed [used only when VSContrl=0 and GenModel=1] (rpm) (read in rpm and convert to rad/sec here): - CALL ReadVar( UnIn, InputFile, InputFileData%SIG_SySp, "SIG_SySp", "Synchronous (zero-torque) generator speed [used only when VSContrl=0 and GenModel=1] (rpm)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%SIG_SySp, "SIG_SySp", "Synchronous (zero-torque) generator speed [used only when VSContrl=0 and GenModel=1] (rpm)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%SIG_SySp = InputFileData%SIG_SySp*RPM2RPS ! SIG_RtTq - Rated torque [used only when VSContrl=0 and GenModel=1] (N-m): - CALL ReadVar( UnIn, InputFile, InputFileData%SIG_RtTq, "SIG_RtTq", "Rated torque [used only when VSContrl=0 and GenModel=1] (N-m)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%SIG_RtTq, "SIG_RtTq", "Rated torque [used only when VSContrl=0 and GenModel=1] (N-m)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! SIG_PORt - Pull-out ratio (Tpullout/Trated) [used only when VSContrl=0 and GenModel=1] (-): - CALL ReadVar( UnIn, InputFile, InputFileData%SIG_PORt, "SIG_PORt", "Pull-out ratio (Tpullout/Trated) [used only when VSContrl=0 and GenModel=1] (-)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%SIG_PORt, "SIG_PORt", "Pull-out ratio (Tpullout/Trated) [used only when VSContrl=0 and GenModel=1] (-)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN !---------------------- THEVENIN-EQUIVALENT INDUCTION GENERATOR ----------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: Thevenin-Equivalent Induction Generator', ErrStat2, ErrMsg2, UnEc ) + CALL ReadCom( UnIn, InitInp%InputFile, 'Section Header: Thevenin-Equivalent Induction Generator', ErrStat2, ErrMsg2, UnEc ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! TEC_Freq - Line frequency [50 or 60] [used only when VSContrl=0 and GenModel=2] (Hz): - CALL ReadVar( UnIn, InputFile, InputFileData%TEC_Freq, "TEC_Freq", "Line frequency [50 or 60] [used only when VSContrl=0 and GenModel=2] (Hz)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%TEC_Freq, "TEC_Freq", "Line frequency [50 or 60] [used only when VSContrl=0 and GenModel=2] (Hz)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! TEC_NPol - Number of poles [even integer > 0] [used only when VSContrl=0 and GenModel=2] (-): - CALL ReadVar( UnIn, InputFile, InputFileData%TEC_NPol, "TEC_NPol", "Number of poles [even integer > 0] [used only when VSContrl=0 and GenModel=2] (-)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%TEC_NPol, "TEC_NPol", "Number of poles [even integer > 0] [used only when VSContrl=0 and GenModel=2] (-)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! TEC_SRes - Stator resistance [used only when VSContrl=0 and GenModel=2] (ohms): - CALL ReadVar( UnIn, InputFile, InputFileData%TEC_SRes, "TEC_SRes", "Stator resistance [used only when VSContrl=0 and GenModel=2] (ohms)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%TEC_SRes, "TEC_SRes", "Stator resistance [used only when VSContrl=0 and GenModel=2] (ohms)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! TEC_RRes - Rotor resistance [used only when VSContrl=0 and GenModel=2] (ohms): - CALL ReadVar( UnIn, InputFile, InputFileData%TEC_RRes, "TEC_RRes", "Rotor resistance [used only when VSContrl=0 and GenModel=2] (ohms)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%TEC_RRes, "TEC_RRes", "Rotor resistance [used only when VSContrl=0 and GenModel=2] (ohms)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! TEC_VLL - Line-to-line RMS voltage [used only when VSContrl=0 and GenModel=2] (volts): - CALL ReadVar( UnIn, InputFile, InputFileData%TEC_VLL, "TEC_VLL", "Line-to-line RMS voltage [used only when VSContrl=0 and GenModel=2] (volts)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%TEC_VLL, "TEC_VLL", "Line-to-line RMS voltage [used only when VSContrl=0 and GenModel=2] (volts)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! TEC_SLR - Stator leakage reactance [used only when VSContrl=0 and GenModel=2] (ohms): - CALL ReadVar( UnIn, InputFile, InputFileData%TEC_SLR, "TEC_SLR", "Stator leakage reactance [used only when VSContrl=0 and GenModel=2] (ohms)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%TEC_SLR, "TEC_SLR", "Stator leakage reactance [used only when VSContrl=0 and GenModel=2] (ohms)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! TEC_RLR - Rotor leakage reactance [used only when VSContrl=0 and GenModel=2] (ohms): - CALL ReadVar( UnIn, InputFile, InputFileData%TEC_RLR, "TEC_RLR", "Rotor leakage reactance [used only when VSContrl=0 and GenModel=2] (ohms)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%TEC_RLR, "TEC_RLR", "Rotor leakage reactance [used only when VSContrl=0 and GenModel=2] (ohms)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! TEC_MR - Magnetizing reactance [used only when VSContrl=0 and GenModel=2] (ohms): - CALL ReadVar( UnIn, InputFile, InputFileData%TEC_MR, "TEC_MR", "Magnetizing reactance [used only when VSContrl=0 and GenModel=2] (ohms)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%TEC_MR, "TEC_MR", "Magnetizing reactance [used only when VSContrl=0 and GenModel=2] (ohms)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN !---------------------- HIGH-SPEED SHAFT BRAKE ---------------------------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: High-Speed Shaft Brake', ErrStat2, ErrMsg2, UnEc ) + CALL ReadCom( UnIn, InitInp%InputFile, 'Section Header: High-Speed Shaft Brake', ErrStat2, ErrMsg2, UnEc ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN - ! HSSBrMode - HSS brake model {0: none, 1: simple, 3: user-defined from routine UserHSSBr, 4: user-defined from LabVIEW, 5: user-defined from Bladed-style DLL} (-): - CALL ReadVar( UnIn, InputFile, InputFileData%HSSBrMode, "HSSBrMode", "HSS brake model {0: none, 1: simple, 3: user-defined from routine UserHSSBr, 4: user-defined from LabVIEW} (-)", ErrStat2, ErrMsg2, UnEc) + ! HSSBrMode - HSS brake model {0: none, 1: simple, 3: user-defined from routine UserHSSBr, 4: user-defined from LabVIEW} (-): + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%HSSBrMode, "HSSBrMode", "HSS brake model {0: none, 1: simple, 3: user-defined from routine UserHSSBr, 4: user-defined from LabVIEW} (-)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! THSSBrDp - Time to initiate deployment of the HSS brake (s): - CALL ReadVar( UnIn, InputFile, InputFileData%THSSBrDp, "THSSBrDp", "Time to initiate deployment of the HSS brake (s)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%THSSBrDp, "THSSBrDp", "Time to initiate deployment of the HSS brake (s)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! HSSBrDT - Time for HSS-brake to reach full deployment once initiated [used only when HSSBrMode=1] (sec): - CALL ReadVar( UnIn, InputFile, InputFileData%HSSBrDT, "HSSBrDT", "Time for HSS-brake to reach full deployment once initiated [used only when HSSBrMode=1] (sec)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%HSSBrDT, "HSSBrDT", "Time for HSS-brake to reach full deployment once initiated [used only when HSSBrMode=1] (sec)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! HSSBrTqF - Fully deployed HSS-brake torque (N-m): - CALL ReadVar( UnIn, InputFile, InputFileData%HSSBrTqF, "HSSBrTqF", "Fully deployed HSS-brake torque (N-m)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%HSSBrTqF, "HSSBrTqF", "Fully deployed HSS-brake torque (N-m)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN !---------------------- YAW CONTROL --------------------------------------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: Yaw Control', ErrStat2, ErrMsg2, UnEc ) + CALL ReadCom( UnIn, InitInp%InputFile, 'Section Header: Yaw Control', ErrStat2, ErrMsg2, UnEc ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! YCMode - Yaw control mode {0: none, 3: user-defined from routine UserYawCont, 4: user-defined from Simulink/LabVIEW} (-): - CALL ReadVar( UnIn, InputFile, InputFileData%YCMode, "YCMode", "Yaw control mode (-)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%YCMode, "YCMode", "Yaw control mode (-)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! TYCOn - Time to enable active yaw control [unused when YCMode=0] (s): - CALL ReadVar( UnIn, InputFile, InputFileData%TYCOn, "TYCOn", "Time to enable active yaw control [unused when YCMode=0] (s)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%TYCOn, "TYCOn", "Time to enable active yaw control [unused when YCMode=0] (s)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! YawNeut - Neutral yaw position--yaw spring force is zero at this yaw (deg) (read from file in degrees and converted to radians here): - CALL ReadVar( UnIn, InputFile, InputFileData%YawNeut, "YawNeut", "Neutral yaw position--yaw spring force is zero at this yaw (deg)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%YawNeut, "YawNeut", "Neutral yaw position--yaw spring force is zero at this yaw (deg)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%YawNeut = InputFileData%YawNeut*D2R ! YawSpr - Nacelle-yaw spring constant (N-m/rad): - CALL ReadVar( UnIn, InputFile, InputFileData%YawSpr, "YawSpr", "Nacelle-yaw spring constant (N-m/rad)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%YawSpr, "YawSpr", "Nacelle-yaw spring constant (N-m/rad)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! YawDamp - Nacelle-yaw constant (N-m/(rad/s)): - CALL ReadVar( UnIn, InputFile, InputFileData%YawDamp, "YawDamp", "Nacelle-yaw constant (N-m/(rad/s))", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%YawDamp, "YawDamp", "Nacelle-yaw constant (N-m/(rad/s))", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! TYawManS - Time to start override yaw maneuver and end standard yaw control (s): - CALL ReadVar( UnIn, InputFile, InputFileData%TYawManS, "TYawManS", "Time to start override yaw maneuver and end standard yaw control (s)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%TYawManS, "TYawManS", "Time to start override yaw maneuver and end standard yaw control (s)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! YawManRat - Yaw maneuver rate (in absolute value) (deg/s) (read in degrees/second and converted to radians/second here): - CALL ReadVar( UnIn, InputFile, InputFileData%YawManRat, "YawManRat", "Yaw maneuver rate (in absolute value) (deg/s)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%YawManRat, "YawManRat", "Yaw maneuver rate (in absolute value) (deg/s)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%YawManRat = InputFileData%YawManRat*D2R ! NacYawF - Final yaw angle for override yaw maneuvers (deg) (read from file in degrees and converted to radians here): - CALL ReadVar( UnIn, InputFile, InputFileData%NacYawF, "NacYawF", "Final yaw angle for override yaw maneuvers (deg)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%NacYawF, "NacYawF", "Final yaw angle for override yaw maneuvers (deg)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%NacYawF = InputFileData%NacYawF*D2R !---------------------- TUNED MASS DAMPER ---------------------------------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: Tuned Mass Damper', ErrStat2, ErrMsg2, UnEc ) + CALL ReadCom( UnIn, InitInp%InputFile, 'Section Header: Tuned Mass Damper', ErrStat2, ErrMsg2, UnEc ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! CompNTMD - Compute nacelle tuned mass damper {true/false} (flag): - CALL ReadVar( UnIn, InputFile, InputFileData%CompNTMD, "CompNTMD", "Compute nacelle tuned mass damper {true/false} (flag)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%CompNTMD, "CompNTMD", "Compute nacelle tuned mass damper {true/false} (flag)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! NTMDfile - Name of the file for nacelle tuned mass damper (quoted string) [unused when CompNTMD is false]: - CALL ReadVar( UnIn, InputFile, InputFileData%NTMDfile, "NTMDfile", "Name of the file for nacelle tuned mass dampe [unused when CompNTMD is false] (-)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%NTMDfile, "NTMDfile", "Name of the file for nacelle tuned mass dampe [unused when CompNTMD is false] (-)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN IF ( PathIsRelative( InputFileData%NTMDfile ) ) InputFileData%NTMDfile = TRIM(PriPath)//TRIM(InputFileData%NTMDfile) ! CompTTMD - Compute tower tuned mass damper {true/false} (flag): - CALL ReadVar( UnIn, InputFile, InputFileData%CompTTMD, "CompTTMD", "Compute tower tuned mass damper {true/false} (flag)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%CompTTMD, "CompTTMD", "Compute tower tuned mass damper {true/false} (flag)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! TTMDfile - Name of the file for nacelle tuned mass damper (quoted string) [unused when CompNTMD is false]: - CALL ReadVar( UnIn, InputFile, InputFileData%TTMDfile, "TTMDfile", "Name of the file for tower tuned mass dampe [unused when CompTTMD is false] (-)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%TTMDfile, "TTMDfile", "Name of the file for tower tuned mass dampe [unused when CompTTMD is false] (-)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN IF ( PathIsRelative( InputFileData%TTMDfile ) ) InputFileData%TTMDfile = TRIM(PriPath)//TRIM(InputFileData%TTMDfile) !---------------------- BLADED INTERFACE ---------------------------------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: Bladed Interface', ErrStat2, ErrMsg2, UnEc ) + CALL ReadCom( UnIn, InitInp%InputFile, 'Section Header: Bladed Interface', ErrStat2, ErrMsg2, UnEc ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%UseLegacyInterface = .true. ! DLL_FileName - Name of the Bladed DLL [used only with DLL Interface] (-): - CALL ReadVar( UnIn, InputFile, InputFileData%DLL_FileName, "DLL_FileName", "Name/location of the external library {.dll [Windows]} in the Bladed-DLL format [used only with DLL Interface] (-)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%DLL_FileName, "DLL_FileName", "Name/location of the external library {.dll [Windows]} in the Bladed-DLL format [used only with DLL Interface] (-)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN IF ( PathIsRelative( InputFileData%DLL_FileName ) ) InputFileData%DLL_FileName = TRIM(PriPath)//TRIM(InputFileData%DLL_FileName) ! DLL_InFile - Name of input file used in DLL [used only with DLL Interface] (-): - CALL ReadVar( UnIn, InputFile, InputFileData%DLL_InFile, "DLL_InFile", "Name of input file used in DLL [used only with DLL Interface] (-)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%DLL_InFile, "DLL_InFile", "Name of input file used in DLL [used only with DLL Interface] (-)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN IF ( PathIsRelative( InputFileData%DLL_InFile ) ) InputFileData%DLL_InFile = TRIM(PriPath)//TRIM(InputFileData%DLL_InFile) ! DLL_ProcName - Name of procedure to be called in DLL [used only with DLL Interface] (-): - CALL ReadVar( UnIn, InputFile, InputFileData%DLL_ProcName, "DLL_ProcName", "Name of procedure to be called in DLL [used only with DLL Interface] (-)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%DLL_ProcName, "DLL_ProcName", "Name of procedure to be called in DLL [used only with DLL Interface] (-)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! DLL_DT - Communication interval for dynamic library (s): InputFileData%DLL_DT = InputFileData%DT - CALL ReadVar( UnIn, InputFile, Line, "DLL_DT", "Communication interval for dynamic library (s)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, Line, "DLL_DT", "Communication interval for dynamic library (s)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN CALL Conv2UC( Line ) IF ( INDEX(Line, "DEFAULT" ) /= 1 ) THEN ! If it's not "default", read this variable; otherwise use the value already stored in InputFileData%DLL_DT READ( Line, *, IOSTAT=IOS) InputFileData%DLL_DT - CALL CheckIOS ( IOS, InputFile, 'DLL_DT', NumType, ErrStat2, ErrMsg2 ) + CALL CheckIOS ( IOS, InitInp%InputFile, 'DLL_DT', NumType, ErrStat2, ErrMsg2 ) CALL CheckError(ErrStat2, ErrMsg2) IF ( ErrStat >= AbortErrLev ) RETURN END IF ! DLL_Ramp - Whether a linear ramp should be used between DLL_DT time steps [introduces time shift when true] (flag): - CALL ReadVar( UnIn, InputFile, InputFileData%DLL_Ramp, "DLL_Ramp", "Whether a linear ramp should be used between DLL_DT time steps [introduces time shift when true]", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%DLL_Ramp, "DLL_Ramp", "Whether a linear ramp should be used between DLL_DT time steps [introduces time shift when true]", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! BPCutoff - Cuttoff frequency for low-pass filter on blade pitch (Hz): - CALL ReadVar( UnIn, InputFile, InputFileData%BPCutoff, "BPCutoff", "Cuttoff frequency for low-pass filter on blade pitch (Hz)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%BPCutoff, "BPCutoff", "Cuttoff frequency for low-pass filter on blade pitch (Hz)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! NacYaw_North - Reference yaw angle of the nacelle when the upwind end points due North (deg) (read from file in degrees and converted to radians here): - CALL ReadVar( UnIn, InputFile, InputFileData%NacYaw_North, "NacYaw_North", "Reference yaw angle of the nacelle when the upwind end points due North (deg)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%NacYaw_North, "NacYaw_North", "Reference yaw angle of the nacelle when the upwind end points due North (deg)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%NacYaw_North = InputFileData%NacYaw_North*D2R ! Ptch_Cntrl - Record 28: Use individual pitch control {0: collective pitch; 1: individual pitch control} [used only with DLL Interface] (-): - CALL ReadVar( UnIn, InputFile, InputFileData%Ptch_Cntrl, "Ptch_Cntrl", "Record 28: Use individual pitch control {0: collective pitch; 1: individual pitch control} [used only with DLL Interface] (-)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%Ptch_Cntrl, "Ptch_Cntrl", "Record 28: Use individual pitch control {0: collective pitch; 1: individual pitch control} [used only with DLL Interface] (-)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! Ptch_SetPnt - Record 5: Below-rated pitch angle set-point [used only with DLL Interface] (deg) (read from file in degrees and converted to radians here): - CALL ReadVar( UnIn, InputFile, InputFileData%Ptch_SetPnt, "Ptch_SetPnt", "Record 5: Below-rated pitch angle set-point [used only with DLL Interface] (deg)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%Ptch_SetPnt, "Ptch_SetPnt", "Record 5: Below-rated pitch angle set-point [used only with DLL Interface] (deg)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%Ptch_SetPnt = InputFileData%Ptch_SetPnt*D2R ! Ptch_Min - Record 6: Minimum pitch angle [used only with DLL Interface] (deg) (read from file in degrees and converted to radians here): - CALL ReadVar( UnIn, InputFile, InputFileData%Ptch_Min, "Ptch_Min", "Record 6: Minimum pitch angle [used only with DLL Interface] (deg)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%Ptch_Min, "Ptch_Min", "Record 6: Minimum pitch angle [used only with DLL Interface] (deg)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%Ptch_Min = InputFileData%Ptch_Min*D2R ! Ptch_Max - Record 7: Maximum pitch angle [used only with DLL Interface] (deg) (read from file in degrees and converted to radians here): - CALL ReadVar( UnIn, InputFile, InputFileData%Ptch_Max, "Ptch_Max", "Record 7: Maximum pitch angle [used only with DLL Interface] (deg)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%Ptch_Max, "Ptch_Max", "Record 7: Maximum pitch angle [used only with DLL Interface] (deg)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%Ptch_Max = InputFileData%Ptch_Max*D2R ! PtchRate_Min - Record 8: Minimum pitch rate (most negative value allowed) [used only with DLL Interface] (deg/s) (read from file in deg/s and converted to rad/s here): - CALL ReadVar( UnIn, InputFile, InputFileData%PtchRate_Min, "PtchRate_Min", "Record 8: Minimum pitch rate (most negative value allowed) [used only with DLL Interface] (deg/s)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%PtchRate_Min, "PtchRate_Min", "Record 8: Minimum pitch rate (most negative value allowed) [used only with DLL Interface] (deg/s)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%PtchRate_Min = InputFileData%PtchRate_Min*D2R ! PtchRate_Max - Record 9: Maximum pitch rate [used only with DLL Interface] (deg/s) (read from file in deg/s and converted to rad/s here): - CALL ReadVar( UnIn, InputFile, InputFileData%PtchRate_Max, "PtchRate_Max", "Record 9: Maximum pitch rate [used only with DLL Interface] (deg/s)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%PtchRate_Max, "PtchRate_Max", "Record 9: Maximum pitch rate [used only with DLL Interface] (deg/s)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%PtchRate_Max = InputFileData%PtchRate_Max*D2R ! Gain_OM - Record 16: Optimal mode gain [used only with DLL Interface] (Nm/(rad/s)^2): - CALL ReadVar( UnIn, InputFile, InputFileData%Gain_OM, "Gain_OM", "Record 16: Optimal mode gain [used only with DLL Interface] (Nm/(rad/s)^2)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%Gain_OM, "Gain_OM", "Record 16: Optimal mode gain [used only with DLL Interface] (Nm/(rad/s)^2)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! GenSpd_MinOM - Record 17: Minimum generator speed [used only with DLL Interface] (rpm) (read from file in rpm and converted to rad/s here): - CALL ReadVar( UnIn, InputFile, InputFileData%GenSpd_MinOM, "GenSpd_MinOM", "Record 17: Minimum generator speed [used only with DLL Interface] (rpm)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%GenSpd_MinOM, "GenSpd_MinOM", "Record 17: Minimum generator speed [used only with DLL Interface] (rpm)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%GenSpd_MinOM = InputFileData%GenSpd_MinOM*RPM2RPS ! GenSpd_MaxOM - Record 18: Optimal mode maximum speed [used only with DLL Interface] (rpm) (read from file in rpm and converted to rad/s here): - CALL ReadVar( UnIn, InputFile, InputFileData%GenSpd_MaxOM, "GenSpd_MaxOM", "Record 18: Optimal mode maximum speed [used only with DLL Interface] (rpm)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%GenSpd_MaxOM, "GenSpd_MaxOM", "Record 18: Optimal mode maximum speed [used only with DLL Interface] (rpm)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%GenSpd_MaxOM = InputFileData%GenSpd_MaxOM*RPM2RPS ! GenSpd_Dem - Record 19: Demanded generator speed above rated [used only with DLL Interface] (rpm) (read from file in rpm and converted to rad/s here): - CALL ReadVar( UnIn, InputFile, InputFileData%GenSpd_Dem, "GenSpd_Dem", "Record 19: Demanded generator speed above rated [used only with DLL Interface] (rpm)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%GenSpd_Dem, "GenSpd_Dem", "Record 19: Demanded generator speed above rated [used only with DLL Interface] (rpm)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%GenSpd_Dem = InputFileData%GenSpd_Dem*RPM2RPS ! GenTrq_Dem - Record 22: Demanded generator torque above rated [used only with DLL Interface] (Nm): - CALL ReadVar( UnIn, InputFile, InputFileData%GenTrq_Dem, "GenTrq_Dem", "Record 22: Demanded generator torque above rated [used only with DLL Interface] (Nm)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%GenTrq_Dem, "GenTrq_Dem", "Record 22: Demanded generator torque above rated [used only with DLL Interface] (Nm)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! GenPwr_Dem - Record 13: Demanded power [used only with DLL Interface] (W): - CALL ReadVar( UnIn, InputFile, InputFileData%GenPwr_Dem, "GenPwr_Dem", "Record 13: Demanded power [used only with DLL Interface] (W)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%GenPwr_Dem, "GenPwr_Dem", "Record 13: Demanded power [used only with DLL Interface] (W)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN !---------------------- BLADED INTERFACE TORQUE-SPEED LOOK-UP TABLE ------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: Bladed Interface Torque-Speed Look-Up Table', ErrStat2, ErrMsg2, UnEc ) + CALL ReadCom( UnIn, InitInp%InputFile, 'Section Header: Bladed Interface Torque-Speed Look-Up Table', ErrStat2, ErrMsg2, UnEc ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! DLL_NumTrq - Record 26: No. of points in torque-speed look-up table {0 = none and use the optimal mode PARAMETERs instead, nonzero = ignore the optimal mode PARAMETERs by setting Gain_OM (Record 16) to 0.0} (-): - CALL ReadVar( UnIn, InputFile, InputFileData%DLL_NumTrq, "DLL_NumTrq", "Record 26: No. of points in torque-speed look-up table {0 = none and use the optimal mode PARAMETERs instead, nonzero = ignore the optimal mode PARAMETERs by setting Gain_OM (Record 16) to 0.0} (-)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%DLL_NumTrq, "DLL_NumTrq", "Record 26: No. of points in torque-speed look-up table {0 = none and use the optimal mode PARAMETERs instead, nonzero = ignore the optimal mode PARAMETERs by setting Gain_OM (Record 16) to 0.0} (-)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN @@ -2316,17 +2315,17 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, OutFileRoot, UnEc, ErrStat IF ( ErrStat >= AbortErrLev ) RETURN END IF - CALL ReadCom( UnIn, InputFile, 'Table Header: Bladed Interface Torque-Speed Look-Up Table', ErrStat2, ErrMsg2, UnEc ) + CALL ReadCom( UnIn, InitInp%InputFile, 'Table Header: Bladed Interface Torque-Speed Look-Up Table', ErrStat2, ErrMsg2, UnEc ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN - CALL ReadCom( UnIn, InputFile, 'Table Units: Bladed Interface Torque-Speed Look-Up Table', ErrStat2, ErrMsg2, UnEc ) + CALL ReadCom( UnIn, InitInp%InputFile, 'Table Units: Bladed Interface Torque-Speed Look-Up Table', ErrStat2, ErrMsg2, UnEc ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN DO I=1,InputFileData%DLL_NumTrq - CALL ReadAry( UnIn, InputFile, TmpRAry, 2_IntKi, 'Line'//TRIM(Num2LStr(I)), 'Bladed Interface Torque-Speed Look-Up Table', & + CALL ReadAry( UnIn, InitInp%InputFile, TmpRAry, 2_IntKi, 'Line'//TRIM(Num2LStr(I)), 'Bladed Interface Torque-Speed Look-Up Table', & ErrStat2, ErrMsg2, UnEc ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN @@ -2338,52 +2337,52 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, OutFileRoot, UnEc, ErrStat !---------------------- OUTPUT -------------------------------------------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: Output', ErrStat2, ErrMsg2, UnEc ) + CALL ReadCom( UnIn, InitInp%InputFile, 'Section Header: Output', ErrStat2, ErrMsg2, UnEc ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! SumPrint - Print summary data to .sum (flag): - CALL ReadVar( UnIn, InputFile, InputFileData%SumPrint, "SumPrint", "Print summary data to .sum (flag)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%SumPrint, "SumPrint", "Print summary data to .sum (flag)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! OutFile - Switch to determine where output will be placed: (1: in module output file only; 2: in glue code output file only; 3: both) (-): - CALL ReadVar( UnIn, InputFile, InputFileData%OutFile, "OutFile", "Switch to determine where output will be placed: {1: in module output file only; 2: in glue code output file only; 3: both} (-)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%OutFile, "OutFile", "Switch to determine where output will be placed: {1: in module output file only; 2: in glue code output file only; 3: both} (-)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! ! OutFileFmt - Format for module tabular (time-marching) output: (1: text file [.out], 2: binary file [.outb], 3: both): - !CALL ReadVar( UnIn, InputFile, InputFileData%OutFileFmt, "OutFileFmt", "Format for module tabular (time-marching) output: (1: text file [.out], 2: binary file [.outb], 3: both)", ErrStat2, ErrMsg2, UnEc) + !CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%OutFileFmt, "OutFileFmt", "Format for module tabular (time-marching) output: (1: text file [.out], 2: binary file [.outb], 3: both)", ErrStat2, ErrMsg2, UnEc) ! CALL CheckError( ErrStat2, ErrMsg2 ) ! IF ( ErrStat >= AbortErrLev ) RETURN ! TabDelim - Flag to cause tab-delimited text output (delimited by space otherwise) (flag): - CALL ReadVar( UnIn, InputFile, InputFileData%TabDelim, "TabDelim", "Flag to cause tab-delimited text output (delimited by space otherwise) (flag)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%TabDelim, "TabDelim", "Flag to cause tab-delimited text output (delimited by space otherwise) (flag)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! OutFmt - Format used for module's text tabult output (except time); resulting field should be 10 characters (-): - CALL ReadVar( UnIn, InputFile, InputFileData%OutFmt, "OutFmt", "Format used for module's text tabular output (except time); resulting field should be 10 characters (-)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%OutFmt, "OutFmt", "Format used for module's text tabular output (except time); resulting field should be 10 characters (-)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! Tstart - Time to start module's tabular output (seconds): - CALL ReadVar( UnIn, InputFile, InputFileData%Tstart, "Tstart", "Time to start module's tabular output (seconds)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%Tstart, "Tstart", "Time to start module's tabular output (seconds)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! ! ! DecFact - Decimation factor for module's tabular output (1=output every step) (-): - !CALL ReadVar( UnIn, InputFile, InputFileData%DecFact, "DecFact", "Decimation factor for module's tabular output (1=output every step) (-)", ErrStat2, ErrMsg2, UnEc) + !CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%DecFact, "DecFact", "Decimation factor for module's tabular output (1=output every step) (-)", ErrStat2, ErrMsg2, UnEc) ! CALL CheckError( ErrStat2, ErrMsg2 ) ! IF ( ErrStat >= AbortErrLev ) RETURN !---------------------- OUTLIST -------------------------------------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: OutList', ErrStat2, ErrMsg2, UnEc ) + CALL ReadCom( UnIn, InitInp%InputFile, 'Section Header: OutList', ErrStat2, ErrMsg2, UnEc ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! OutList - List of user-requested output channels (-): - CALL ReadOutputList ( UnIn, InputFile, InputFileData%OutList, InputFileData%NumOuts, 'OutList', "List of user-requested output channels", ErrStat2, ErrMsg2, UnEc ) ! Routine in NWTC Subroutine Library + CALL ReadOutputList ( UnIn, InitInp%InputFile, InputFileData%OutList, InputFileData%NumOuts, 'OutList', "List of user-requested output channels", ErrStat2, ErrMsg2, UnEc ) ! Routine in NWTC Subroutine Library CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN @@ -2428,14 +2427,13 @@ END SUBROUTINE CheckError END SUBROUTINE ReadPrimaryFile !---------------------------------------------------------------------------------------------------------------------------------- !> This routine validates the inputs from the primary input file. -SUBROUTINE ValidatePrimaryData( InitInp, InputFileData, NumBl, ErrStat, ErrMsg ) +SUBROUTINE ValidatePrimaryData( InitInp, InputFileData, ErrStat, ErrMsg ) !.................................................................................................................................. ! Passed variables: TYPE(SrvD_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine TYPE(SrvD_InputFile), INTENT(IN) :: InputFileData !< All the data in the ServoDyn input file - INTEGER(IntKi), INTENT(IN) :: NumBl !< Number of blades INTEGER(IntKi), INTENT(OUT) :: ErrStat !< Error status CHARACTER(*), INTENT(OUT) :: ErrMsg !< Error message @@ -2532,11 +2530,11 @@ SUBROUTINE Pitch_ValidateData( ) ! Make sure the number of blades in the simulation doesn't exceed 3: - IF ( NumBl > SIZE(InputFileData%TPitManS,1) ) CALL SetErrStat( ErrID_Fatal, 'Number of blades exceeds input values.', ErrStat, ErrMsg, RoutineName ) + IF ( InitInp%NumBl > SIZE(InputFileData%TPitManS,1) ) CALL SetErrStat( ErrID_Fatal, 'Number of blades exceeds input values.', ErrStat, ErrMsg, RoutineName ) ! Check the pitch-maneuver start times and rates: - DO K=1,MIN(NumBl,SIZE(InputFileData%TPitManS)) + DO K=1,MIN(InitInp%NumBl,SIZE(InputFileData%TPitManS)) IF ( InputFileData%TPitManS(K) < 0.0_DbKi ) & CALL SetErrStat( ErrID_Fatal, 'TPitManS('//TRIM( Num2LStr( K ) )//') must not be negative.', ErrStat, ErrMsg, RoutineName ) @@ -2609,7 +2607,7 @@ SUBROUTINE TipBrake_ValidateData( ) !IF ( p%TpBrDT < 0.0_DbKi ) CALL ProgAbort ( ' TpBrDT must not be negative.' ) - !DO K=1,MIN(NumBl,SIZE(InputFileData%TTpBrDp)) + !DO K=1,MIN(InitInp%NumBl,SIZE(InputFileData%TTpBrDp)) ! IF ( InputFileData%TTpBrDp(K) < 0.0_DbKi ) & ! CALL SetErrStat( ErrID_Fatal, 'TTpBrDp(' //TRIM( Num2LStr( K ) )//') must not be negative.', ErrStat, ErrMsg, RoutineName ) ! IF ( InputFileData%TBDepISp(K) < 0.0_DbKi ) & diff --git a/modules/servodyn/src/ServoDyn_Types.f90 b/modules/servodyn/src/ServoDyn_Types.f90 index 6e962a603c..2e228e0077 100644 --- a/modules/servodyn/src/ServoDyn_Types.f90 +++ b/modules/servodyn/src/ServoDyn_Types.f90 @@ -196,6 +196,8 @@ MODULE ServoDyn_Types REAL(ReKi) :: NcIMURAzs !< Nacelle inertial measurement unit angular (rotational) acceleration (absolute) [rad/s^2] REAL(ReKi) :: RotPwr !< Rotor power (this is equivalent to the low-speed shaft power) [W] REAL(ReKi) :: LSSTipMxa !< Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] + REAL(ReKi) , DIMENSION(1:3) :: RootMyc !< Out-of-plane moment (i.e., the moment caused by out-of-plane forces) at the blade root for each of the blades (max 3) [N-m] + REAL(ReKi) , DIMENSION(1:3) :: RootMxc !< In-plane moment (i.e., the moment caused by in-plane forces) at the blade root [N-m] REAL(DbKi) :: DLL_DT !< interval for calling DLL (integer multiple number of DT) [s] CHARACTER(1024) :: DLL_InFile !< Name of input file used in DLL [-] CHARACTER(1024) :: RootName !< RootName for writing output files [-] @@ -215,8 +217,6 @@ MODULE ServoDyn_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: GenSpd_TLU !< Table (array) containing DLL_NumTrq generator speeds for the torque-speed table look-up (TLU) -- this should be defined using an array constructor; for example, if DLL_NumTrq = 3, GenSpd_TLU(DLL_NumTrq) = (/ 0.0, 99.9, 999.9 /) [rad/s] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: GenTrq_TLU !< Table (array) containing DLL_NumTrq generator torques for the torque-speed table look-up (TLU) -- this should be defined using an array constructor, for example, if DLL_NumTrq = 3, GenTrq_TLU(DLL_NumTrq) = (/ 0.0, 10, 200.0 /) [Nm] INTEGER(IntKi) :: Yaw_Cntrl !< Yaw control: 0 = rate; 1 = torque [-] - REAL(ReKi) , DIMENSION(1:3) :: RootMyc !< Out-of-plane moment (i.e., the moment caused by out-of-plane forces) at the blade root for each of the blades (max 3) [N-m] - REAL(ReKi) , DIMENSION(1:3) :: RootMxc !< In-plane moment (i.e., the moment caused by in-plane forces) at the blade root [N-m] END TYPE BladedDLLType ! ======================= ! ========= SrvD_ContinuousStateType ======= @@ -2188,6 +2188,8 @@ SUBROUTINE SrvD_CopyBladedDLLType( SrcBladedDLLTypeData, DstBladedDLLTypeData, C DstBladedDLLTypeData%NcIMURAzs = SrcBladedDLLTypeData%NcIMURAzs DstBladedDLLTypeData%RotPwr = SrcBladedDLLTypeData%RotPwr DstBladedDLLTypeData%LSSTipMxa = SrcBladedDLLTypeData%LSSTipMxa + DstBladedDLLTypeData%RootMyc = SrcBladedDLLTypeData%RootMyc + DstBladedDLLTypeData%RootMxc = SrcBladedDLLTypeData%RootMxc DstBladedDLLTypeData%DLL_DT = SrcBladedDLLTypeData%DLL_DT DstBladedDLLTypeData%DLL_InFile = SrcBladedDLLTypeData%DLL_InFile DstBladedDLLTypeData%RootName = SrcBladedDLLTypeData%RootName @@ -2229,8 +2231,6 @@ SUBROUTINE SrvD_CopyBladedDLLType( SrcBladedDLLTypeData, DstBladedDLLTypeData, C DstBladedDLLTypeData%GenTrq_TLU = SrcBladedDLLTypeData%GenTrq_TLU ENDIF DstBladedDLLTypeData%Yaw_Cntrl = SrcBladedDLLTypeData%Yaw_Cntrl - DstBladedDLLTypeData%RootMyc = SrcBladedDLLTypeData%RootMyc - DstBladedDLLTypeData%RootMxc = SrcBladedDLLTypeData%RootMxc END SUBROUTINE SrvD_CopyBladedDLLType SUBROUTINE SrvD_DestroyBladedDLLType( BladedDLLTypeData, ErrStat, ErrMsg ) @@ -2388,6 +2388,8 @@ SUBROUTINE SrvD_PackBladedDLLType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Re_BufSz = Re_BufSz + 1 ! NcIMURAzs Re_BufSz = Re_BufSz + 1 ! RotPwr Re_BufSz = Re_BufSz + 1 ! LSSTipMxa + Re_BufSz = Re_BufSz + SIZE(InData%RootMyc) ! RootMyc + Re_BufSz = Re_BufSz + SIZE(InData%RootMxc) ! RootMxc Db_BufSz = Db_BufSz + 1 ! DLL_DT Int_BufSz = Int_BufSz + 1*LEN(InData%DLL_InFile) ! DLL_InFile Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName @@ -2415,8 +2417,6 @@ SUBROUTINE SrvD_PackBladedDLLType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Re_BufSz = Re_BufSz + SIZE(InData%GenTrq_TLU) ! GenTrq_TLU END IF Int_BufSz = Int_BufSz + 1 ! Yaw_Cntrl - Re_BufSz = Re_BufSz + SIZE(InData%RootMyc) ! RootMyc - Re_BufSz = Re_BufSz + SIZE(InData%RootMxc) ! RootMxc IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -2633,6 +2633,14 @@ SUBROUTINE SrvD_PackBladedDLLType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Re_Xferred = Re_Xferred + 1 ReKiBuf(Re_Xferred) = InData%LSSTipMxa Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%RootMyc,1), UBOUND(InData%RootMyc,1) + ReKiBuf(Re_Xferred) = InData%RootMyc(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%RootMxc,1), UBOUND(InData%RootMxc,1) + ReKiBuf(Re_Xferred) = InData%RootMxc(i1) + Re_Xferred = Re_Xferred + 1 + END DO DbKiBuf(Db_Xferred) = InData%DLL_DT Db_Xferred = Db_Xferred + 1 DO I = 1, LEN(InData%DLL_InFile) @@ -2701,14 +2709,6 @@ SUBROUTINE SrvD_PackBladedDLLType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, END IF IntKiBuf(Int_Xferred) = InData%Yaw_Cntrl Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%RootMyc,1), UBOUND(InData%RootMyc,1) - ReKiBuf(Re_Xferred) = InData%RootMyc(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%RootMxc,1), UBOUND(InData%RootMxc,1) - ReKiBuf(Re_Xferred) = InData%RootMxc(i1) - Re_Xferred = Re_Xferred + 1 - END DO END SUBROUTINE SrvD_PackBladedDLLType SUBROUTINE SrvD_UnPackBladedDLLType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2958,6 +2958,18 @@ SUBROUTINE SrvD_UnPackBladedDLLType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Re_Xferred = Re_Xferred + 1 OutData%LSSTipMxa = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 + i1_l = LBOUND(OutData%RootMyc,1) + i1_u = UBOUND(OutData%RootMyc,1) + DO i1 = LBOUND(OutData%RootMyc,1), UBOUND(OutData%RootMyc,1) + OutData%RootMyc(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + i1_l = LBOUND(OutData%RootMxc,1) + i1_u = UBOUND(OutData%RootMxc,1) + DO i1 = LBOUND(OutData%RootMxc,1), UBOUND(OutData%RootMxc,1) + OutData%RootMxc(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO OutData%DLL_DT = DbKiBuf(Db_Xferred) Db_Xferred = Db_Xferred + 1 DO I = 1, LEN(OutData%DLL_InFile) @@ -3032,18 +3044,6 @@ SUBROUTINE SrvD_UnPackBladedDLLType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta END IF OutData%Yaw_Cntrl = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%RootMyc,1) - i1_u = UBOUND(OutData%RootMyc,1) - DO i1 = LBOUND(OutData%RootMyc,1), UBOUND(OutData%RootMyc,1) - OutData%RootMyc(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%RootMxc,1) - i1_u = UBOUND(OutData%RootMxc,1) - DO i1 = LBOUND(OutData%RootMxc,1), UBOUND(OutData%RootMxc,1) - OutData%RootMxc(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO END SUBROUTINE SrvD_UnPackBladedDLLType SUBROUTINE SrvD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) From d121b62a17019058ae1617228caed00b4dd9683c Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Tue, 3 Dec 2019 11:13:20 -0700 Subject: [PATCH 14/72] SrvD linear bug fix: units on YawMomCom The units on the YawMomCom write-output channel in the linearization matrices were wrong. This would only be noticeable if you requested the YawMomCom channel from ServoDyn along with linearization matrices that included the outputs. --- 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 b282be860f..4217fd31f2 100644 --- a/modules/servodyn/src/ServoDyn.f90 +++ b/modules/servodyn/src/ServoDyn.f90 @@ -1362,9 +1362,9 @@ SUBROUTINE SrvD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, Er !......................................................................................................................... AllOuts = 0.0_R8Ki ! all variables not specified below are zeros (either constant or disabled): - AllOuts(:, GenTq) = 0.001_R8Ki*dYdu(SrvD_Indx_Y_GenTrq,:) - AllOuts(:, GenPwr) = 0.001_R8Ki*dYdu(SrvD_Indx_Y_ElecPwr,:) - AllOuts(:, YawMomCom) = dYdu(SrvD_Indx_Y_YawMom,:) + AllOuts(:, GenTq) = 0.001_R8Ki*dYdu(SrvD_Indx_Y_GenTrq,:) + AllOuts(:, GenPwr) = 0.001_R8Ki*dYdu(SrvD_Indx_Y_ElecPwr,:) + AllOuts(:, YawMomCom) = -0.001_R8Ki*dYdu(SrvD_Indx_Y_YawMom,:) !............................................................................................................................... ! Place the selected output channels into the WriteOutput(:) portion of the jacobian with the proper sign: From 3c247cdbdaa2986f52aa75190bf722563ec426f0 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Wed, 4 Dec 2019 13:48:52 -0700 Subject: [PATCH 15/72] Sync FAST library Adds - trim solution - vtk mode-shape visualization - vtk file-name stored as parameter instead of recalculating each time - ED%Output(1) renamed to ED%y for consistency (Output now used in save OP for trim solution) - additional damping may or may not actually work - CHECK: length of channel names (file format?) - simulink interface now allows 4000 channels instead of 1000 (all blade node outputs can significantly increase number of channels generated) - added logic to avoid calculating WriteOutput array when it is not necessary --- modules/openfast-library/src/FAST_Library.f90 | 2 +- modules/openfast-library/src/FAST_Library.h | 2 +- modules/openfast-library/src/FAST_Lin.f90 | 1883 ++++++++- .../openfast-library/src/FAST_Registry.txt | 99 +- modules/openfast-library/src/FAST_Solver.f90 | 771 ++-- modules/openfast-library/src/FAST_Subs.f90 | 1799 +++++--- modules/openfast-library/src/FAST_Types.f90 | 3697 +++++++++++++---- 7 files changed, 6492 insertions(+), 1761 deletions(-) diff --git a/modules/openfast-library/src/FAST_Library.f90 b/modules/openfast-library/src/FAST_Library.f90 index 1641fc0041..d447c8fde8 100644 --- a/modules/openfast-library/src/FAST_Library.f90 +++ b/modules/openfast-library/src/FAST_Library.f90 @@ -21,7 +21,7 @@ MODULE FAST_Data REAL(DbKi), PARAMETER :: t_initial = 0.0_DbKi ! Initial time INTEGER(IntKi) :: NumTurbines INTEGER, PARAMETER :: IntfStrLen = 1025 ! length of strings through the C interface - INTEGER(IntKi), PARAMETER :: MAXOUTPUTS = 1000 ! Maximum number of outputs + INTEGER(IntKi), PARAMETER :: MAXOUTPUTS = 4000 ! Maximum number of outputs INTEGER(IntKi), PARAMETER :: MAXInitINPUTS = 10 ! Maximum number of initialization values from Simulink INTEGER(IntKi), PARAMETER :: NumFixedInputs = 8 diff --git a/modules/openfast-library/src/FAST_Library.h b/modules/openfast-library/src/FAST_Library.h index 9e33e1c8c9..669cd03be7 100644 --- a/modules/openfast-library/src/FAST_Library.h +++ b/modules/openfast-library/src/FAST_Library.h @@ -42,7 +42,7 @@ EXTERNAL_ROUTINE void FAST_CreateCheckpoint(int * iTurb, const char *CheckpointR // make sure these parameters match with FAST_Library.f90 #define MAXIMUM_BLADES 3 -#define MAXIMUM_OUTPUTS 1000 +#define MAXIMUM_OUTPUTS 4000 #define CHANNEL_LENGTH 10 #define MAXInitINPUTS 10 diff --git a/modules/openfast-library/src/FAST_Lin.f90 b/modules/openfast-library/src/FAST_Lin.f90 index bde1f397a9..ffc24228ca 100644 --- a/modules/openfast-library/src/FAST_Lin.f90 +++ b/modules/openfast-library/src/FAST_Lin.f90 @@ -30,13 +30,14 @@ MODULE FAST_Linear !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !---------------------------------------------------------------------------------------------------------------------------------- !> Routine that initializes some variables for linearization. -SUBROUTINE Init_Lin(p_FAST, y_FAST, m_FAST, AD, NumBl, ErrStat, ErrMsg) +SUBROUTINE Init_Lin(p_FAST, y_FAST, m_FAST, AD, ED, NumBl, ErrStat, ErrMsg) TYPE(FAST_ParameterType), INTENT(INOUT) :: p_FAST !< Parameters for the glue code TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables TYPE(AeroDyn_Data), INTENT(IN ) :: AD !< AeroDyn data - INTEGER(IntKi), INTENT(IN) :: NumBl !< Number of blades (for index into ED input array) + TYPE(ElastoDyn_Data), INTENT(IN ) :: ED !< ElastoDyn data + INTEGER(IntKi), INTENT(IN ) :: NumBl !< Number of blades (for index into ED input array) INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None @@ -44,6 +45,7 @@ SUBROUTINE Init_Lin(p_FAST, y_FAST, m_FAST, AD, NumBl, ErrStat, ErrMsg) INTEGER(IntKi) :: i, j, k ! loop/temp variables INTEGER(IntKi) :: ThisModule ! Module ID # INTEGER(IntKi) :: NumInstances ! Number of instances of each module + INTEGER(IntKi) :: NumStates ! Number of states required for the x_eig arrays INTEGER(IntKi) :: i_u ! loop/temp variables INTEGER(IntKi) :: i_y, i_x ! loop/temp variables @@ -110,6 +112,7 @@ SUBROUTINE Init_Lin(p_FAST, y_FAST, m_FAST, AD, NumBl, ErrStat, ErrMsg) ! determine total number of inputs/outputs/contStates: !..................... y_FAST%Lin%Glue%SizeLin = 0 + y_FAST%Lin%Glue%NumOutputs = 0 do i = 1,p_FAST%Lin_NumMods ThisModule = p_FAST%Lin_ModOrder( i ) @@ -121,6 +124,8 @@ SUBROUTINE Init_Lin(p_FAST, y_FAST, m_FAST, AD, NumBl, ErrStat, ErrMsg) if (allocated(y_FAST%Lin%Modules(ThisModule)%Instance(k)%Names_x)) y_FAST%Lin%Modules(ThisModule)%Instance(k)%SizeLin(LIN_ContSTATE_COL) = size(y_FAST%Lin%Modules(ThisModule)%Instance(k)%Names_x) y_FAST%Lin%Glue%SizeLin = y_FAST%Lin%Glue%SizeLin + y_FAST%Lin%Modules(ThisModule)%Instance(k)%SizeLin ! total number of inputs, outputs, and continuous states + + y_FAST%Lin%Glue%NumOutputs = y_FAST%Lin%Glue%NumOutputs + y_FAST%Lin%Modules(ThisModule)%Instance(k)%NumOutputs ! total number of WriteOutputs end do end do @@ -130,6 +135,7 @@ SUBROUTINE Init_Lin(p_FAST, y_FAST, m_FAST, AD, NumBl, ErrStat, ErrMsg) NextStart = 1 ! whole array do i = 1,p_FAST%Lin_NumMods ThisModule = p_FAST%Lin_ModOrder( i ) + do k=1,size(y_FAST%Lin%Modules(ThisModule)%Instance) y_FAST%Lin%Modules(ThisModule)%Instance(k)%LinStartIndx = NextStart NextStart = NextStart + y_FAST%Lin%Modules(ThisModule)%Instance(k)%SizeLin @@ -140,7 +146,6 @@ SUBROUTINE Init_Lin(p_FAST, y_FAST, m_FAST, AD, NumBl, ErrStat, ErrMsg) ! ................................... ! determine which of the module inputs/outputs are written to file ! ................................... - !NumBl = size(u_ED%BlPitchCom) call Init_Lin_InputOutput(p_FAST, y_FAST, NumBl, ErrStat2, ErrMsg2) call SetErrStat(errStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) @@ -165,7 +170,6 @@ SUBROUTINE Init_Lin(p_FAST, y_FAST, m_FAST, AD, NumBl, ErrStat, ErrMsg) call SetErrStat(errStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) call AllocAry( y_FAST%Lin%Glue%DerivOrder_x, y_FAST%Lin%Glue%SizeLin(LIN_ContSTATE_COL), 'DerivOrder_x', ErrStat2, ErrMsg2) call SetErrStat(errStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call AllocAry( y_FAST%Lin%Glue%IsLoad_u, y_FAST%Lin%Glue%SizeLin(LIN_INPUT_COL), 'IsLoad_u', ErrStat2, ErrMsg2) call SetErrStat(errStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) @@ -202,7 +206,7 @@ SUBROUTINE Init_Lin(p_FAST, y_FAST, m_FAST, AD, NumBl, ErrStat, ErrMsg) end do ! outputs - do k=1,size(y_FAST%Lin%Modules(ThisModule)%Instance) + do k=1,NumInstances if (NumInstances > 1 .or. trim(y_FAST%Module_Abrev(ThisModule)) == "BD") then ModAbrev = TRIM(y_FAST%Module_Abrev(ThisModule))//'_'//trim(num2lstr(k)) end if @@ -220,11 +224,33 @@ SUBROUTINE Init_Lin(p_FAST, y_FAST, m_FAST, AD, NumBl, ErrStat, ErrMsg) end do ! continuous states - do k=1,size(y_FAST%Lin%Modules(ThisModule)%Instance) + do k=1,NumInstances if (NumInstances > 1 .or. trim(y_FAST%Module_Abrev(ThisModule)) == "BD") then ModAbrev = TRIM(y_FAST%Module_Abrev(ThisModule))//'_'//trim(num2lstr(k)) end if + if (y_FAST%Lin%Modules(ThisModule)%Instance(k)%SizeLin(LIN_ContSTATE_COL) > 0) then + if (p_FAST%WrVTK == VTK_ModeShapes) then ! allocate these for restart later + if (ThisModule == Module_ED) then + ! ED states are only the active DOFs, but when we perturb the OP [in PerturbOP()], we need the index + NumStates = ED%p%NDOF*2 + else + NumStates = y_FAST%Lin%Modules(ThisModule)%Instance(k)%SizeLin(LIN_ContSTATE_COL) + end if + + call AllocAry( y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_x_eig_mag, NumStates, 'op_x_eig_mag', ErrStat2, ErrMsg2) + call SetErrStat(errStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AllocAry( y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_x_eig_phase, NumStates, 'op_x_eig_phase', ErrStat2, ErrMsg2) + call SetErrStat(errStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + if (ErrStat >= AbortErrLev) return + + y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_x_eig_mag = 0.0_R8Ki + y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_x_eig_phase = 0.0_R8Ki + end if + end if + + do j=1,y_FAST%Lin%Modules(ThisModule)%Instance(k)%SizeLin(LIN_ContSTATE_COL) y_FAST%Lin%Glue%names_x( i_x) = TRIM(ModAbrev)//' '//y_FAST%Lin%Modules(ThisModule)%Instance(k)%Names_x( j) if (allocated(y_FAST%Lin%Modules(ThisModule)%Instance(k)%RotFrame_x)) then @@ -244,6 +270,62 @@ SUBROUTINE Init_Lin(p_FAST, y_FAST, m_FAST, AD, NumBl, ErrStat, ErrMsg) end do ! each module + + !..................... + ! initialize variables for periodic steady state solution + !..................... + + m_FAST%Lin%NextLinTimeIndx = 1 + m_FAST%Lin%CopyOP_CtrlCode = MESH_NEWCOPY + m_FAST%Lin%n_rot = 0 + m_FAST%Lin%IsConverged = .false. + m_FAST%Lin%FoundSteady = .false. + m_FAST%Lin%AzimIndx = 1 + + p_FAST%AzimDelta = TwoPi / p_FAST%NLinTimes + + ! allocate space to save operating points + if (p_FAST%CalcSteady .or. p_FAST%WrVTK==VTK_ModeShapes) then + + call AllocateOP(p_FAST, y_FAST, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! allocate spaces for variables needed to determine + if (p_FAST%CalcSteady) then + + !call AllocAry(m_FAST%Lin%AzimTarget, p_FAST%NLinTimes,'AzimTarget', ErrStat2, ErrMsg2) + allocate( m_FAST%Lin%AzimTarget(0 : p_FAST%NLinTimes+1), stat=ErrStat2 ) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal,"Unable to allocate space for AzimTarget.",ErrStat,ErrMsg,RoutineName) + end if + + call AllocAry( m_FAST%Lin%LinTimes, p_FAST%NLinTimes, 'LinTimes', ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + call AllocAry( m_FAST%Lin%Psi, p_FAST%LinInterpOrder+1, 'Psi', ErrStat2, ErrMsg2) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! these flattened output arrays will contain spaces for %WriteOutputs, which are being ignored for purposes of CalcSteady computations + call AllocAry( m_FAST%Lin%y_interp, y_FAST%Lin%Glue%SizeLin(LIN_OUTPUT_COL), 'y_interp', ErrStat2, ErrMsg2) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + call AllocAry( m_FAST%Lin%Y_prevRot, y_FAST%Lin%Glue%SizeLin(LIN_OUTPUT_COL), p_FAST%NLinTimes, 'Y_prevRot', ErrStat2, ErrMsg2) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + call AllocAry( m_FAST%Lin%y_ref, y_FAST%Lin%Glue%SizeLin(LIN_OUTPUT_COL), 'y_ref', ErrStat2, ErrMsg2) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + if (ErrStat < AbortErrLev) then + m_FAST%Lin%y_interp = 0.0_R8Ki + m_FAST%Lin%Y_prevRot = 0.0_R8Ki + m_FAST%Lin%y_ref = 1.0_R8Ki + end if + + end if + + end if + + END SUBROUTINE Init_Lin !---------------------------------------------------------------------------------------------------------------------------------- !> Routine that initializes the names and rotating frame portion of IfW. @@ -432,7 +514,7 @@ SUBROUTINE Init_Lin_InputOutput(p_FAST, y_FAST, NumBl, ErrStat, ErrMsg) ThisModule = p_FAST%Lin_ModOrder( i ) do k=1,size(y_FAST%Lin%Modules(ThisModule)%Instance) - col = y_FAST%Lin%Modules(ThisModule)%Instance(k)%SizeLin(LIN_OUTPUT_COL) - y_FAST%Lin%Modules(ThisModule)%Instance(k)%NumOutputs !first column where WriteOutput occurs + col = y_FAST%Lin%Modules(ThisModule)%Instance(k)%SizeLin(LIN_OUTPUT_COL) - y_FAST%Lin%Modules(ThisModule)%Instance(k)%NumOutputs !last column before WriteOutput occurs do j=1,col y_FAST%Lin%Modules(ThisModule)%Instance(k)%use_y(j) = .false. end do @@ -455,7 +537,7 @@ SUBROUTINE Init_Lin_InputOutput(p_FAST, y_FAST, NumBl, ErrStat, ErrMsg) END SUBROUTINE Init_Lin_InputOutput !---------------------------------------------------------------------------------------------------------------------------------- !> Routine that performs lineaization at current operating point for a turbine. -SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, MAPp, FEAM, MD, Orca, & +SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & IceF, IceD, MeshMapData, ErrStat, ErrMsg ) REAL(DbKi), INTENT(IN ) :: t_global !< current (global) simulation time @@ -467,12 +549,12 @@ SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD1 TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data - TYPE(AeroDyn14_Data), INTENT(INOUT) :: AD14 !< AeroDyn14 data TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpFM !< OpenFOAM data TYPE(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 @@ -500,35 +582,53 @@ SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD1 integer(intki) :: k CHARACTER(1024) :: LinRootName CHARACTER(1024) :: OutFileName + CHARACTER(200) :: SimStr + CHARACTER(MaxWrScrLen) :: BlankLine ErrStat = ErrID_None ErrMsg = "" Un = -1 + + !..................... + SimStr = '(RotSpeed='//trim(num2lstr(ED%y%RotSpeed*RPS2RPM))//' rpm, BldPitch1='//trim(num2lstr(ED%y%BlPitch(1)*R2D))//' deg)' + BlankLine = "" + CALL WrOver( BlankLine ) ! BlankLine contains MaxWrScrLen spaces + CALL WrOver ( ' Performing linearization '//trim(num2lstr(m_FAST%Lin%NextLinTimeIndx))//' at simulation time '//TRIM( Num2LStr(t_global) )//' s. '//trim(SimStr) ) + CALL WrScr('') + + !..................... + + LinRootName = TRIM(p_FAST%OutFileRoot)//'.'//trim(num2lstr(m_FAST%Lin%NextLinTimeIndx)) - LinRootName = TRIM(p_FAST%OutFileRoot)//'.'//trim(num2lstr(m_FAST%NextLinTimeIndx)) + if (p_FAST%WrVTK == VTK_ModeShapes .and. .not. p_FAST%CalcSteady) then ! we already saved these for the CalcSteady case + call SaveOP(m_FAST%Lin%NextLinTimeIndx, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + IceF, IceD, ErrStat, ErrMsg, m_FAST%Lin%CopyOP_CtrlCode ) + !m_FAST%Lin%CopyOP_CtrlCode = MESH_UPDATECOPY ! we need a new copy for each LinTime + end if + NumBl = size(ED%Input(1)%BlPitchCom) - y_FAST%Lin%RotSpeed = ED%Output(1)%RotSpeed - y_FAST%Lin%Azimuth = ED%Output(1)%LSSTipPxa + y_FAST%Lin%RotSpeed = ED%y%RotSpeed + y_FAST%Lin%Azimuth = ED%y%LSSTipPxa !..................... ! ElastoDyn !..................... ! get the jacobians call ED_JacobianPInput( t_global, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), & - ED%Output(1), 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 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) call ED_JacobianPContState( t_global, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), & - ED%Output(1), 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 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! get the operating point call ED_GetOP( t_global, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), & - ED%Output(1), 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 ) + ED%y, ED%m, ErrStat2, ErrMsg2, u_op=y_FAST%Lin%Modules(Module_ED)%Instance(1)%op_u, y_op=y_FAST%Lin%Modules(Module_ED)%Instance(1)%op_y, & + x_op=y_FAST%Lin%Modules(Module_ED)%Instance(1)%op_x, dx_op=y_FAST%Lin%Modules(Module_ED)%Instance(1)%op_dx ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if (ErrStat >=AbortErrLev) then call cleanup() @@ -631,7 +731,9 @@ SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD1 end if end do - end if + end if !BeamDyn + + !..................... ! InflowWind !..................... @@ -937,7 +1039,7 @@ SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD1 end if ! get the dUdu and dUdy matrices, which linearize SolveOption2 for the modules we've included in linearization - call Glue_Jacobians( t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, MAPp, FEAM, MD, Orca, & + call Glue_Jacobians( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, MAPp, FEAM, MD, Orca, & IceF, IceD, MeshMapData, dUdu, dUdy, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if (ErrStat >=AbortErrLev) then @@ -973,6 +1075,8 @@ SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD1 ! Write the results to the file: call WrLinFile_txt_End(Un, p_FAST, y_FAST%Lin%Glue ) + m_FAST%Lin%NextLinTimeIndx = m_FAST%Lin%NextLinTimeIndx + 1 + contains subroutine cleanup() #ifdef OLD_AD_LINEAR @@ -1077,6 +1181,7 @@ SUBROUTINE WrLinFile_txt_Head(t_global, p_FAST, y_FAST, LinData, FileName, Un, E Desc = 'Simulation time:'; WRITE (Un, fmt) Desc, t_global, 's' Desc = 'Rotor Speed:'; WRITE (Un, fmt) Desc, y_FAST%Lin%RotSpeed, 'rad/s' Desc = 'Azimuth:'; WRITE (Un, fmt) Desc, y_FAST%Lin%Azimuth, 'rad' + Desc = 'Wind Speed:'; WRITE (Un, fmt) Desc, y_FAST%Lin%WindSpeed, 'm/s' fmt = '(3x,A,1x,I5)' do i=1,size(n) @@ -1185,6 +1290,7 @@ SUBROUTINE WrLinFile_txt_Table(p_FAST, Un, RowCol, op, names, rotFrame, deriv, d INTEGER(IntKi) :: TS ! tab stop column INTEGER(IntKi) :: i, i_print ! loop counter INTEGER(IntKi) :: i_op ! loop counter + logical :: UseDerivNames !< flag that tells us if we need to modify the channel names for derivatives (xdot) logical :: UseThisCol !< flag that tells us if we should use this particular column or skip it logical :: RotatingCol !< flag that tells us if this column is in the rotating frame @@ -1310,6 +1416,7 @@ SUBROUTINE Glue_GetOP(p_FAST, y_FAST, ErrStat, ErrMsg) call SetErrStat(errStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) call AllocAry( y_FAST%Lin%Glue%op_dx, y_FAST%Lin%Glue%SizeLin(LIN_ContSTATE_COL), 'op_dx', ErrStat2, ErrMsg2) call SetErrStat(errStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat >=AbortErrLev) return end if @@ -1343,6 +1450,7 @@ SUBROUTINE Glue_GetOP(p_FAST, y_FAST, ErrStat, ErrMsg) i_x = i_x + 1; end do end if + end do end do @@ -1350,11 +1458,9 @@ END SUBROUTINE Glue_GetOP !---------------------------------------------------------------------------------------------------------------------------------- !> This routine forms the Jacobian for the glue-code input-output solves. -SUBROUTINE Glue_Jacobians( t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, MAPp, FEAM, MD, Orca, & +SUBROUTINE Glue_Jacobians( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, MAPp, FEAM, MD, Orca, & IceF, IceD, MeshMapData, dUdu, dUdy, ErrStat, ErrMsg ) - REAL(DbKi), INTENT(IN ) :: t_global !< current (global) simulation time - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables @@ -1362,7 +1468,6 @@ SUBROUTINE Glue_Jacobians( t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data - TYPE(AeroDyn14_Data), INTENT(INOUT) :: AD14 !< AeroDyn14 data TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpFM !< OpenFOAM data @@ -1465,8 +1570,8 @@ SUBROUTINE Glue_Jacobians( t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, ! \f$ \frac{\partial U_\Lambda^{ED}}{\partial u^{BD}} \end{bmatrix} = \f$ (dUdu block row 3=ED) !............ ! we need to do this for CompElast=ED and CompElast=BD - - call Linear_ED_InputSolve_du( p_FAST, y_FAST, ED%Input(1), ED%Output(1), AD%y, AD%Input(1), BD, HD, MAPp, MeshMapData, dUdu, ErrStat2, ErrMsg2 ) + + call Linear_ED_InputSolve_du( p_FAST, y_FAST, ED%Input(1), ED%y, AD%y, AD%Input(1), BD, HD, MAPp, MeshMapData, dUdu, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) !............ @@ -1474,24 +1579,24 @@ SUBROUTINE Glue_Jacobians( t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, ! \f$ \frac{\partial U_\Lambda^{BD}}{\partial u^{BD}} \end{bmatrix} = \f$ (dUdu block row 4=BD) !............ IF (p_FAST%CompElast == Module_BD) THEN - call Linear_BD_InputSolve_du( p_FAST, y_FAST, ED%Output(1), AD%y, AD%Input(1), BD, MeshMapData, dUdu, ErrStat2, ErrMsg2 ) + call Linear_BD_InputSolve_du( p_FAST, y_FAST, ED%y, AD%y, AD%Input(1), BD, MeshMapData, dUdu, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) END IF - + !............ ! \f$ \frac{\partial U_\Lambda^{AD}}{\partial u^{AD}} \end{bmatrix} = \f$ (dUdu block row 5=AD) !............ IF (p_FAST%CompAero == MODULE_AD) THEN - call Linear_AD_InputSolve_du( p_FAST, y_FAST, AD%Input(1), ED%Output(1), BD, MeshMapData, dUdu, ErrStat2, ErrMsg2 ) + call Linear_AD_InputSolve_du( p_FAST, y_FAST, AD%Input(1), ED%y, BD, MeshMapData, dUdu, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) end if !............ - ! \f$ \frac{\partial U_\Lambda^{AD}}{\partial u^{AD}} \end{bmatrix} = \f$ (dUdu block row 5=AD) + ! \f$ \frac{\partial U_\Lambda^{HD}}{\partial u^{HD}} \end{bmatrix} = \f$ (dUdu block row 6=HD) !............ IF (p_FAST%CompHydro == MODULE_HD) THEN - call Linear_HD_InputSolve_du( p_FAST, y_FAST, HD%Input(1), ED%Output(1), MeshMapData, dUdu, ErrStat2, ErrMsg2 ) + call Linear_HD_InputSolve_du( p_FAST, y_FAST, HD%Input(1), ED%y, MeshMapData, dUdu, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) end if @@ -1533,7 +1638,6 @@ SUBROUTINE Glue_Jacobians( t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, end if - !............ ! \f$ \frac{\partial U_\Lambda^{ED}}{\partial y^{SrvD}} \end{bmatrix} = \f$ ! \f$ \frac{\partial U_\Lambda^{ED}}{\partial y^{ED}} \end{bmatrix} = \f$ @@ -1541,7 +1645,7 @@ SUBROUTINE Glue_Jacobians( t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, ! \f$ \frac{\partial U_\Lambda^{ED}}{\partial y^{AD}} \end{bmatrix} = \f$ (dUdy block row 3=ED) !............ - call Linear_ED_InputSolve_dy( p_FAST, y_FAST, ED%Input(1), ED%Output(1), AD%y, AD%Input(1), BD, HD, MAPp, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) + call Linear_ED_InputSolve_dy( p_FAST, y_FAST, ED%Input(1), ED%y, AD%y, AD%Input(1), BD, HD, MAPp, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) !............ @@ -1550,7 +1654,7 @@ SUBROUTINE Glue_Jacobians( t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, ! \f$ \frac{\partial U_\Lambda^{BD}}{\partial y^{AD}} \end{bmatrix} = \f$ (dUdy block row 4=BD) !............ if (p_FAST%CompElast == MODULE_BD) then - call Linear_BD_InputSolve_dy( p_FAST, y_FAST, ED%Input(1), ED%Output(1), AD%y, AD%Input(1), BD, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) + call Linear_BD_InputSolve_dy( p_FAST, y_FAST, ED%Input(1), ED%y, AD%y, AD%Input(1), BD, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) end if @@ -1565,7 +1669,7 @@ SUBROUTINE Glue_Jacobians( t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, call Linear_AD_InputSolve_IfW_dy( p_FAST, y_FAST, AD%Input(1), dUdy ) end if - call Linear_AD_InputSolve_NoIfW_dy( p_FAST, y_FAST, AD%Input(1), ED%Output(1), BD, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) + call Linear_AD_InputSolve_NoIfW_dy( p_FAST, y_FAST, AD%Input(1), ED%y, BD, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) end if @@ -1575,7 +1679,7 @@ SUBROUTINE Glue_Jacobians( t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, ! \f$ \frac{\partial U_\Lambda^{HD}}{\partial y^{ED}} \end{bmatrix} = \f$ (dUdy block row 6=HD) !............ if (p_FAST%CompHydro == MODULE_HD) then - call Linear_HD_InputSolve_dy( p_FAST, y_FAST, HD%Input(1), ED%Output(1), MeshMapData, dUdy, ErrStat2, ErrMsg2 ) + call Linear_HD_InputSolve_dy( p_FAST, y_FAST, HD%Input(1), ED%y, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) end if @@ -1584,7 +1688,7 @@ SUBROUTINE Glue_Jacobians( t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, ! \f$ \frac{\partial U_\Lambda^{MAP}}{\partial y^{ED}} \end{bmatrix} = \f$ (dUdy block row 7=MAP) !............ if (p_FAST%CompMooring == MODULE_MAP) then - call Linear_MAP_InputSolve_dy( p_FAST, y_FAST, MAPp%Input(1), ED%Output(1), MeshMapData, dUdy, ErrStat2, ErrMsg2 ) + call Linear_MAP_InputSolve_dy( p_FAST, y_FAST, MAPp%Input(1), ED%y, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) end if @@ -1668,7 +1772,6 @@ SUBROUTINE Linear_ED_InputSolve_du( p_FAST, y_FAST, u_ED, y_ED, y_AD, u_AD, BD, CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message ! local variables - INTEGER(IntKi) :: i ! rows/columns INTEGER(IntKi) :: K ! Loops through blades INTEGER(IntKi) :: BD_Start ! starting index of dUdu (column) where BD root motion inputs are located INTEGER(IntKi) :: AD_Start_Bl ! starting index of dUdu (column) where AD blade motion inputs are located @@ -1964,7 +2067,7 @@ SUBROUTINE Linear_AD_InputSolve_du( p_FAST, y_FAST, u_AD, y_ED, BD, MeshMapData, ! tower IF (u_AD%TowerMotion%Committed) THEN - + CALL Linearize_Line2_to_Line2( y_ED%TowerLn2Mesh, u_AD%TowerMotion, MeshMapData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_AD%TowerMotion' ) @@ -2025,17 +2128,18 @@ SUBROUTINE Linear_SrvD_InputSolve_dy( p_FAST, y_FAST, dUdy ) REAL(R8Ki), INTENT(INOUT) :: dUdy(:,:) !< Jacobian matrix of which we are computing the dU^{SrvD}/dy^{ED} block integer(intKi) :: ED_Start_Yaw !< starting index of dUdy (column) where ED Yaw/YawRate/HSS_Spd outputs are located (just before WriteOutput) - + integer(intKi) :: thisModule INTEGER(IntKi) :: i ! loop counter CHARACTER(*), PARAMETER :: RoutineName = 'Linear_SrvD_InputSolve_dy' - ED_Start_Yaw = y_FAST%Lin%Modules(Module_ED)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + y_FAST%Lin%Modules(Module_ED)%Instance(1)%SizeLin(LIN_OUTPUT_COL) & !end of ED outputs (+1) - - y_FAST%Lin%Modules(Module_ED)%Instance(1)%NumOutputs - 3 ! start of ED where Yaw, YawRate, HSS_Spd occur (right before WriteOutputs) - do i=1,3 - dUdy(y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + i - 1, ED_Start_Yaw + i - 1) = -1.0_ReKi + thisModule = Module_ED + ED_Start_Yaw = Indx_y_Yaw_Start(y_FAST, ThisModule) ! start of ED where Yaw, YawRate, HSS_Spd occur (right before WriteOutputs) + + do i=1,size(SrvD_Indx_Y_BlPitchCom) + dUdy(y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + SrvD_Indx_Y_BlPitchCom(i) - 1, ED_Start_Yaw + i - 1) = -1.0_ReKi end do !IF (u_SrvD%NTMD%Mesh%Committed) THEN @@ -2097,10 +2201,9 @@ SUBROUTINE Linear_ED_InputSolve_dy( p_FAST, y_FAST, u_ED, y_ED, y_AD, u_AD, BD, ! BlPitchCom, YawMom, GenTrq ED_Start = Indx_u_ED_BlPitchCom_Start(u_ED, y_FAST) do i=1,size(u_ED%BlPitchCom)+2 ! BlPitchCom, YawMom, GenTrq (NOT collective pitch) - dUdy(ED_Start + i - 1, y_FAST%Lin%Modules(Module_SrvD)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + i - 1) = -1.0_ReKi + dUdy(ED_Start + i - 1, y_FAST%Lin%Modules(Module_SrvD)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + i - 1) = -1.0_ReKi !SrvD_Indx_Y_BlPitchCom end do - !IF (y_SrvD%NTMD%Mesh%Committed) THEN ! CALL Linearize_Point_to_Point( y_SrvD%NTMD%Mesh, u_ED%NacelleLoads, MeshMapData%SrvD_P_2_ED_P_N, ErrStat2, ErrMsg2, u_SrvD%NTMD%Mesh, y_ED%NacelleMotion ) ! CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg,RoutineName//':u_ED%NacelleLoads' ) @@ -2195,7 +2298,7 @@ SUBROUTINE Linear_ED_InputSolve_dy( p_FAST, y_FAST, u_ED, y_ED, y_AD, u_AD, BD, !!! ! while forming dUdy, too. ! call Linearize_Point_to_Point( HD%y%AllHdroOrigin, u_ED%PlatformPtMesh, MeshMapData%HD_W_P_2_ED_P, ErrStat2, ErrMsg2, HD%Input(1)%Mesh, y_ED%PlatformPtMesh) !HD%Input(1)%Mesh and y_ED%PlatformPtMesh contain the displaced positions for load calculations HD_Out_Start = Indx_y_HD_AllHdro_Start(HD%y, y_FAST) - ED_Start = Indx_u_ED_Platform_Start(u_ED, y_FAST) ! start of u_ED%PlatformPtMesh%TranslationDisp field + ED_Start = Indx_u_ED_Platform_Start(u_ED, y_FAST) ! start of u_ED%PlatformPtMesh%Moment field call Assemble_dUdy_Loads(HD%y%AllHdroOrigin, u_ED%PlatformPtMesh, MeshMapData%HD_W_P_2_ED_P, ED_Start, HD_Out_Start, dUdy) ! ED translation displacement-to-ED moment transfer (dU^{ED}/dy^{ED}): @@ -2238,7 +2341,7 @@ SUBROUTINE Linear_BD_InputSolve_dy( p_FAST, y_FAST, u_ED, y_ED, y_AD, u_AD, BD, 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(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 @@ -2655,11 +2758,8 @@ SUBROUTINE Linear_HD_InputSolve_dy( p_FAST, y_FAST, u_HD, y_ED, MeshMapData, dUd ! Local variables: - INTEGER(IntKi) :: K ! Loops through blades INTEGER(IntKi) :: HD_Start ! starting index of dUdy (column) where particular HD fields are located INTEGER(IntKi) :: ED_Out_Start! starting index of dUdy (row) where particular ED fields are located - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Linear_HD_InputSolve_dy' @@ -2709,6 +2809,7 @@ SUBROUTINE Linear_HD_InputSolve_dy( p_FAST, y_FAST, u_HD, y_ED, MeshMapData, dUd ED_Out_Start = Indx_y_ED_Platform_Start(y_ED, y_FAST) ! start of y_ED%PlatformPtMesh%TranslationDisp field call Assemble_dUdy_Motions(y_ED%PlatformPtMesh, u_HD%Mesh, MeshMapData%ED_P_2_HD_W_P, HD_Start, ED_Out_Start, dUdy, .false.) + END IF @@ -2748,10 +2849,12 @@ SUBROUTINE Linear_MAP_InputSolve_dy( p_FAST, y_FAST, u_MAP, y_ED, MeshMapData, d !................................... IF (u_MAP%PtFairDisplacement%Committed) THEN MAP_Start = y_FAST%Lin%Modules(MODULE_MAP)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + ED_Out_Start = Indx_y_ED_Platform_Start(y_ED, y_FAST) ! start of y_ED%PlatformPtMesh%TranslationDisp field call Linearize_Point_to_Point( y_ED%PlatformPtMesh, u_MAP%PtFairDisplacement, MeshMapData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) - call Assemble_dUdy_Motions(y_ED%PlatformPtMesh, u_MAP%PtFairDisplacement, MeshMapData%ED_P_2_Mooring_P, MAP_Start, ED_Out_Start, dUdy, onlyTranslationDisp=.true.) + call Assemble_dUdy_Motions(y_ED%PlatformPtMesh, u_MAP%PtFairDisplacement, MeshMapData%ED_P_2_Mooring_P, MAP_Start, ED_Out_Start, dUdy, OnlyTranslationDisp=.true.) + END IF @@ -3466,9 +3569,9 @@ SUBROUTINE Assemble_dUdy_Loads(y, u, MeshMap, BlockRowStart, BlockColStart, dUdy row = BlockRowStart + u%NNodes*3 ! start of u%Moment field [skip 1 field with 3 components] col = BlockColStart ! start of y%Force field call SetBlockMatrix( dUdy, MeshMap%dM%m_f, row, col ) -!LIN-TODO: There are no moments for the MAP outputs! Need to modifiy this could + if (allocated(y%Moment)) then - ! source moment to moment: + ! source moment to destination moment: row = BlockRowStart + u%NNodes*3 ! start of u%Moment field [skip 1 field with 3 components] col = BlockColStart + y%NNodes*3 ! start of y%Moment field [skip 1 field with 3 components] call SetBlockMatrix( dUdy, MeshMap%dM%li, row, col ) @@ -3618,6 +3721,19 @@ FUNCTION Indx_y_ED_BladeRoot_Start(y_ED, y_FAST, BladeNum) RESULT(ED_Out_Start) end do END FUNCTION Indx_y_ED_BladeRoot_Start !---------------------------------------------------------------------------------------------------------------------------------- +!> This routine returns the starting index for y_ED%Yaw in the FAST linearization outputs. +FUNCTION Indx_y_Yaw_Start(y_FAST, ThisModule) RESULT(ED_Out_Start) + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + INTEGER, INTENT(IN ) :: ThisModule !< which structural module this is for + + INTEGER :: ED_Out_Start !< starting index of this blade mesh in ElastoDyn outputs + + + ED_Out_Start = y_FAST%Lin%Modules(thisModule)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + y_FAST%Lin%Modules(thisModule)%Instance(1)%SizeLin(LIN_OUTPUT_COL) & !end of ED outputs (+1) + - y_FAST%Lin%Modules(thisModule)%Instance(1)%NumOutputs - 3 ! start of ED where Yaw, YawRate, HSS_Spd occur (right before WriteOutputs) + +END FUNCTION Indx_y_Yaw_Start +!---------------------------------------------------------------------------------------------------------------------------------- !---------------------------------------------------------------------------------------------------------------------------------- !> This routine returns the starting index for the u_AD%TowerMotion mesh in the FAST linearization inputs. @@ -3771,4 +3887,1667 @@ FUNCTION Indx_y_HD_AllHdro_Start(y_HD, y_FAST) RESULT(HD_Start) if (y_HD%Mesh%committed) HD_Start = HD_Start + y_HD%Mesh%NNodes * 6 ! 2 fields (MASKID_FORCE,MASKID_MOMENT) with 3 components END FUNCTION Indx_y_HD_AllHdro_Start + + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This subroutine allocates the arrays that store the operating point at each linearization time for later producing VTK +!! files of the mode shapes. +SUBROUTINE AllocateOP(p_FAST, y_FAST, ErrStat, ErrMsg ) + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables + INTEGER(IntKi) :: ErrStat2 + CHARACTER(*), PARAMETER :: RoutineName = 'AllocateOP' + + + ErrStat = ErrID_None + ErrMsg = "" + + !---------------------------------------------------------------------------------------- + !! copy the operating point of the states and inputs at LinTimes(i) + !---------------------------------------------------------------------------------------- + + + ALLOCATE( y_FAST%op%x_ED(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%xd_ED(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%z_ED(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%OtherSt_ED(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%u_ED(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + + IF ( p_FAST%CompElast == Module_BD ) THEN + ALLOCATE( y_FAST%op%x_BD(p_FAST%nBeams, p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%xd_BD(p_FAST%nBeams, p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%z_BD(p_FAST%nBeams, p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%OtherSt_BD(p_FAST%nBeams, p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%u_BD(p_FAST%nBeams, p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + END IF + + + + !IF ( p_FAST%CompAero == Module_AD14 ) THEN + !ELSE + IF ( p_FAST%CompAero == Module_AD ) THEN + ALLOCATE( y_FAST%op%x_AD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%xd_AD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%z_AD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%OtherSt_AD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%u_AD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + END IF + + IF ( p_FAST%CompInflow == Module_IfW ) THEN + ALLOCATE( y_FAST%op%x_IfW(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%xd_IfW(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%z_IfW(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%OtherSt_IfW(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%u_IfW(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + END IF + + + IF ( p_FAST%CompServo == Module_SrvD ) THEN + ALLOCATE( y_FAST%op%x_SrvD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%xd_SrvD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%z_SrvD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%OtherSt_SrvD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%u_SrvD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + END IF + + + IF ( p_FAST%CompHydro == Module_HD ) THEN + ALLOCATE( y_FAST%op%x_HD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%xd_HD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%z_HD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%OtherSt_HD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%u_HD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + END IF + + + ! SubDyn: copy final predictions to actual states + IF ( p_FAST%CompSub == Module_SD ) THEN + ALLOCATE( y_FAST%op%x_SD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%xd_SD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%z_SD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%OtherSt_SD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%u_SD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ELSE IF ( p_FAST%CompSub == Module_ExtPtfm ) THEN + ALLOCATE( y_FAST%op%x_ExtPtfm(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%xd_ExtPtfm(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%z_ExtPtfm(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%OtherSt_ExtPtfm(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%u_ExtPtfm(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + END IF + + + ! MAP/MoorDyn/FEAM: copy states and inputs to OP array + IF (p_FAST%CompMooring == Module_MAP) THEN + ALLOCATE( y_FAST%op%x_MAP(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%xd_MAP(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%z_MAP(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + !ALLOCATE( y_FAST%op%OtherSt_MAP(p_FAST%NLinTimes), STAT=ErrStat2 ) + ! if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%u_MAP(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ELSEIF (p_FAST%CompMooring == Module_MD) THEN + ALLOCATE( y_FAST%op%x_MD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%xd_MD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%z_MD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%OtherSt_MD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%u_MD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ELSEIF (p_FAST%CompMooring == Module_FEAM) THEN + ALLOCATE( y_FAST%op%x_FEAM(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%xd_FEAM(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%z_FEAM(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%OtherSt_FEAM(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%u_FEAM(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + !ELSEIF (p_FAST%CompMooring == Module_Orca) THEN + END IF + + ! IceFloe/IceDyn: copy states and inputs to OP array + IF ( p_FAST%CompIce == Module_IceF ) THEN + ALLOCATE( y_FAST%op%x_IceF(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%xd_IceF(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%z_IceF(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%OtherSt_IceF(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%u_IceF(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ELSEIF ( p_FAST%CompIce == Module_IceD ) THEN + ALLOCATE( y_FAST%op%x_IceD(p_FAST%numIceLegs, p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%xd_IceD(p_FAST%numIceLegs, p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%z_IceD(p_FAST%numIceLegs, p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%OtherSt_IceD(p_FAST%numIceLegs, p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%u_IceD(p_FAST%numIceLegs, p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + END IF + +END SUBROUTINE AllocateOP +!---------------------------------------------------------------------------------------------------------------------------------- +!> This subroutine is the inverse of SetOperatingPoint(). It saves the current operating points so they can be retrieved +!> when visualizing mode shapes. +SUBROUTINE SaveOP(i, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + IceF, IceD, ErrStat, ErrMsg, CtrlCode ) + + INTEGER(IntKi) , INTENT(IN ) :: i !< current index into LinTimes + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data + TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpFM !< OpenFOAM data + TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data + TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module + TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + INTEGER(IntKi), INTENT(IN ) :: CtrlCode !< mesh copy control code (new, vs update) + + ! local variables + INTEGER(IntKi) :: k ! generic loop counters + + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SaveOP' + + + ErrStat = ErrID_None + ErrMsg = "" + + + !---------------------------------------------------------------------------------------- + !! copy the operating point of the states and inputs at LinTimes(i) + !---------------------------------------------------------------------------------------- + + ! ElastoDyn: copy states and inputs to OP array + CALL ED_CopyContState (ED%x( STATE_CURR), y_FAST%op%x_ED( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyDiscState (ED%xd(STATE_CURR), y_FAST%op%xd_ED( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyConstrState (ED%z( STATE_CURR), y_FAST%op%z_ED( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyOtherState (ED%OtherSt( STATE_CURR), y_FAST%op%OtherSt_ED( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL ED_CopyInput (ED%Input(1), y_FAST%op%u_ED( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! BeamDyn: copy states and inputs to OP array + IF ( p_FAST%CompElast == Module_BD ) THEN + DO k=1,p_FAST%nBeams + CALL BD_CopyContState (BD%x( k,STATE_CURR), y_FAST%op%x_BD(k, i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyDiscState (BD%xd(k,STATE_CURR), y_FAST%op%xd_BD(k, i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyConstrState (BD%z( k,STATE_CURR), y_FAST%op%z_BD(k, i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyOtherState (BD%OtherSt( k,STATE_CURR), y_FAST%op%OtherSt_BD(k, i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL BD_CopyInput (BD%Input(k,1), y_FAST%op%u_BD(k, i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END DO + END IF + + + + ! AeroDyn: copy states and inputs to OP array + !IF ( p_FAST%CompAero == Module_AD14 ) THEN + !ELSE + IF ( p_FAST%CompAero == Module_AD ) THEN + CALL AD_CopyContState (AD%x( STATE_CURR), y_FAST%op%x_AD( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyDiscState (AD%xd(STATE_CURR), y_FAST%op%xd_AD( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyConstrState (AD%z( STATE_CURR), y_FAST%op%z_AD( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyOtherState (AD%OtherSt(STATE_CURR), y_FAST%op%OtherSt_AD( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL AD_CopyInput (AD%Input(1), y_FAST%op%u_AD(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + + ! InflowWind: copy states and inputs to OP array + IF ( p_FAST%CompInflow == Module_IfW ) THEN + CALL InflowWind_CopyContState (IfW%x( STATE_CURR), y_FAST%op%x_IfW( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyDiscState (IfW%xd(STATE_CURR), y_FAST%op%xd_IfW( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyConstrState (IfW%z( STATE_CURR), y_FAST%op%z_IfW( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyOtherState( IfW%OtherSt( STATE_CURR), y_FAST%op%OtherSt_IfW( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL InflowWind_CopyInput (IfW%Input(1), y_FAST%op%u_IfW(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END IF + + + ! ServoDyn: copy states and inputs to OP array + IF ( p_FAST%CompServo == Module_SrvD ) THEN + CALL SrvD_CopyContState (SrvD%x( STATE_CURR), y_FAST%op%x_SrvD( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyDiscState (SrvD%xd(STATE_CURR), y_FAST%op%xd_SrvD( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyConstrState (SrvD%z( STATE_CURR), y_FAST%op%z_SrvD( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyOtherState (SrvD%OtherSt( STATE_CURR), y_FAST%op%OtherSt_SrvD( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL SrvD_CopyInput (SrvD%Input(1), y_FAST%op%u_SrvD(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + + + ! HydroDyn: copy states and inputs to OP array + IF ( p_FAST%CompHydro == Module_HD ) THEN + CALL HydroDyn_CopyContState (HD%x( STATE_CURR), y_FAST%op%x_HD( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyDiscState (HD%xd(STATE_CURR), y_FAST%op%xd_HD( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyConstrState (HD%z( STATE_CURR), y_FAST%op%z_HD( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyOtherState (HD%OtherSt(STATE_CURR), y_FAST%op%OtherSt_HD( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL HydroDyn_CopyInput (HD%Input(1), y_FAST%op%u_HD(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + + + ! SubDyn: copy final predictions to actual states + IF ( p_FAST%CompSub == Module_SD ) THEN + CALL SD_CopyContState (y_FAST%op%x_SD(i), SD%x( STATE_CURR), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyDiscState (y_FAST%op%xd_SD(i), SD%xd(STATE_CURR), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyConstrState( y_FAST%op%z_SD(i), SD%z( STATE_CURR), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyOtherState (y_FAST%op%OtherSt_SD(i), SD%OtherSt(STATE_CURR), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL SD_CopyInput (y_FAST%op%u_SD(i), SD%Input(1), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ELSE IF ( p_FAST%CompSub == Module_ExtPtfm ) THEN + CALL ExtPtfm_CopyContState (ExtPtfm%x( STATE_CURR), y_FAST%op%x_ExtPtfm(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyDiscState (ExtPtfm%xd(STATE_CURR), y_FAST%op%xd_ExtPtfm(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyConstrState (ExtPtfm%z( STATE_CURR), y_FAST%op%z_ExtPtfm(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyOtherState (ExtPtfm%OtherSt(STATE_CURR), y_FAST%op%OtherSt_ExtPtfm(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL ExtPtfm_CopyInput (ExtPtfm%Input(1), y_FAST%op%u_ExtPtfm(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + + + ! MAP/MoorDyn/FEAM: copy states and inputs to OP array + IF (p_FAST%CompMooring == Module_MAP) THEN + CALL MAP_CopyContState (MAPp%x( STATE_CURR), y_FAST%op%x_MAP(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MAP_CopyDiscState (MAPp%xd(STATE_CURR), y_FAST%op%xd_MAP(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MAP_CopyConstrState (MAPp%z( STATE_CURR), y_FAST%op%z_MAP(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + !CALL MAP_CopyOtherState (MAPp%OtherSt(STATE_CURR), y_FAST%op%OtherSt_MAP(i), CtrlCode, Errstat2, ErrMsg2) + ! CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL MAP_CopyInput (MAPp%Input(1), y_FAST%op%u_MAP(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ELSEIF (p_FAST%CompMooring == Module_MD) THEN + CALL MD_CopyContState (MD%x( STATE_CURR), y_FAST%op%x_MD(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyDiscState (MD%xd(STATE_CURR), y_FAST%op%xd_MD(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyConstrState (MD%z( STATE_CURR), y_FAST%op%z_MD(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyOtherState (MD%OtherSt(STATE_CURR), y_FAST%op%OtherSt_MD(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL MD_CopyInput (MD%Input(1), y_FAST%op%u_MD(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ELSEIF (p_FAST%CompMooring == Module_FEAM) THEN + CALL FEAM_CopyContState (FEAM%x( STATE_CURR), y_FAST%op%x_FEAM(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyDiscState (FEAM%xd(STATE_CURR), y_FAST%op%xd_FEAM(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyConstrState (FEAM%z( STATE_CURR), y_FAST%op%z_FEAM(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyOtherState (FEAM%OtherSt( STATE_CURR), y_FAST%op%OtherSt_FEAM(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL FEAM_CopyInput (FEAM%Input(1), y_FAST%op%u_FEAM(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + !ELSEIF (p_FAST%CompMooring == Module_Orca) THEN + END IF + + ! IceFloe/IceDyn: copy states and inputs to OP array + IF ( p_FAST%CompIce == Module_IceF ) THEN + CALL IceFloe_CopyContState (IceF%x( STATE_CURR), y_FAST%op%x_IceF(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyDiscState (IceF%xd(STATE_CURR), y_FAST%op%xd_IceF(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyConstrState (IceF%z( STATE_CURR), y_FAST%op%z_IceF(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyOtherState (IceF%OtherSt(STATE_CURR), y_FAST%op%OtherSt_IceF(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL IceFloe_CopyInput (IceF%Input(1), y_FAST%op%u_IceF(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ELSEIF ( p_FAST%CompIce == Module_IceD ) THEN + DO k=1,p_FAST%numIceLegs + CALL IceD_CopyContState (IceD%x( k,STATE_CURR), y_FAST%op%x_IceD(k, i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyDiscState (IceD%xd(k,STATE_CURR), y_FAST%op%xd_IceD(k, i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyConstrState (IceD%z( k,STATE_CURR), y_FAST%op%z_IceD(k, i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyOtherState (IceD%OtherSt( k,STATE_CURR), y_FAST%op%OtherSt_IceD(k, i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL IceD_CopyInput (IceD%Input(1,k), y_FAST%op%u_IceD(k, i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + END IF + + +END SUBROUTINE SaveOP +!---------------------------------------------------------------------------------------------------------------------------------- +!> This subroutine takes arrays representing the eigenvector of the states and uses it to modify the operating points for +!! continuous states. It is highly tied to the module organizaton. +SUBROUTINE PerturbOP(t, iLinTime, iMode, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + IceF, IceD, ErrStat, ErrMsg ) + + REAL(DbKi), INTENT(IN ) :: t + INTEGER(IntKi), INTENT(IN ) :: iLinTime !< index into LinTimes dimension of arrays (azimuth) + INTEGER(IntKi), INTENT(IN ) :: iMode !< index into Mode dimension of arrays + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data + TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpFM !< OpenFOAM data + TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data + TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module + TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop + + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables + INTEGER(IntKi) :: k ! generic loop counters + INTEGER(IntKi) :: i ! generic loop counters + INTEGER(IntKi) :: j ! generic loop counters + INTEGER(IntKi) :: indx ! generic loop counters + INTEGER(IntKi) :: indx_last ! generic loop counters + INTEGER(IntKi) :: i_x ! index into packed array + INTEGER(IntKi) :: nStates ! number of second-order states + INTEGER(IntKi) :: ThisModule ! identifier of current module + + CHARACTER(*), PARAMETER :: RoutineName = 'PerturbOP' + + + ErrStat = ErrID_None + ErrMsg = "" + + + i_x = 1 + + do i = 1,p_FAST%Lin_NumMods + ThisModule = p_FAST%Lin_ModOrder( i ) + + do k=1,size(y_FAST%Lin%Modules(ThisModule)%Instance) + + if (allocated(y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_x_eig_mag)) then + do j=1,size(y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_x) ! use this for the loop because ED may have a larger op_x_eig_mag array than op_x + + ! this is a hack because not all modules pack the continuous states in the same way: + if (ThisModule == Module_ED) then + if (j<= ED%p%DOFs%NActvDOF) then + indx = ED%p%DOFs%PS(j) + else + indx = ED%p%DOFs%PS(j-ED%p%DOFs%NActvDOF) + ED%p%NDOF + end if + else + indx = j + end if + y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_x_eig_mag( indx) = p_FAST%VTK_modes%x_eig_magnitude(i_x, iLinTime, iMode) ! this is going to hold the magnitude of the eigenvector + y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_x_eig_phase(indx) = p_FAST%VTK_modes%x_eig_phase( i_x, iLinTime, iMode) ! this is going to hold the phase of the eigenvector + i_x = i_x + 1; + end do + end if + + end do + end do + + + + ! ElastoDyn: + ThisModule = Module_ED + if (allocated(y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_mag)) then + nStates = size(y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_mag)/2 + + call GetStateAry(p_FAST, iMode, t, ED%x( STATE_CURR)%QT, y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_mag( :nStates), y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_phase( :nStates)) + call GetStateAry(p_FAST, iMode, t, ED%x( STATE_CURR)%QDT, y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_mag(1+nStates: ), y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_phase(1+nStates: )) + end if + + ! BeamDyn: + IF ( p_FAST%CompElast == Module_BD ) THEN + ThisModule = Module_BD + DO k=1,p_FAST%nBeams + if (allocated(y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_x_eig_mag)) then + nStates = size(y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_x_eig_mag)/2 + + indx = 1 + do i=2,BD%p(k)%node_total + indx_last = indx + BD%p(k)%dof_node - 1 + call GetStateAry(p_FAST, iMode, t, BD%x(k, STATE_CURR)%q( :,i), y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_x_eig_mag( indx:indx_last ), y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_x_eig_phase( indx:indx_last )) + call GetStateAry(p_FAST, iMode, t, BD%x(k, STATE_CURR)%dqdt(:,i), y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_x_eig_mag(nStates+indx:indx_last+nStates), y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_x_eig_phase(nStates+indx:indx_last+nStates)) + indx = indx_last+1 + end do + + end if + + END DO + END IF + + + !!! ! AeroDyn: copy final predictions to actual states; copy current outputs to next + !!!!IF ( p_FAST%CompAero == Module_AD14 ) THEN + !!!!ELSE + !!!IF ( p_FAST%CompAero == Module_AD ) THEN + !!!END IF + !!! + !!!! InflowWind: copy op to actual states and inputs + !!!IF ( p_FAST%CompInflow == Module_IfW ) THEN + !!!END IF + !!! + !!! + !!!! ServoDyn: copy op to actual states and inputs + !!!IF ( p_FAST%CompServo == Module_SrvD ) THEN + !!!END IF + + + ! HydroDyn: copy op to actual states and inputs + IF ( p_FAST%CompHydro == Module_HD ) THEN + ThisModule = Module_HD + if (allocated(y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_mag)) then + nStates = HD%p%WAMIT%SS_Exctn%N + if (nStates > 0) then + call GetStateAry(p_FAST, iMode, t, HD%x( STATE_CURR)%WAMIT%SS_Exctn%x, y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_mag( :nStates), y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_phase( :nStates)) + end if + if (nStates < size(y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_mag)) then + call GetStateAry(p_FAST, iMode, t, HD%x( STATE_CURR)%WAMIT%SS_Rdtn%x, y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_mag(1+nStates: ), y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_phase(1+nStates: )) + end if + end if + END IF + + + !!!! SubDyn: copy final predictions to actual states + !!!IF ( p_FAST%CompSub == Module_SD ) THEN + !!!ELSE IF ( p_FAST%CompSub == Module_ExtPtfm ) THEN + !!!END IF + !!! + !!! + !!!! MAP/MoorDyn/FEAM: copy op to actual states and inputs + !!!IF (p_FAST%CompMooring == Module_MAP) THEN + !!!ELSEIF (p_FAST%CompMooring == Module_MD) THEN + !!!ELSEIF (p_FAST%CompMooring == Module_FEAM) THEN + !!!!ELSEIF (p_FAST%CompMooring == Module_Orca) THEN + !!!END IF + !!! + !!! ! IceFloe/IceDyn: copy op to actual states and inputs + !!!IF ( p_FAST%CompIce == Module_IceF ) THEN + !!!ELSEIF ( p_FAST%CompIce == Module_IceD ) THEN + !!! DO k=1,p_FAST%numIceLegs + !!! END DO + !!!END IF + + +END SUBROUTINE PerturbOP +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE SetOperatingPoint(i, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, ExtPtfm, & + MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat, ErrMsg ) + + INTEGER(IntKi), INTENT(IN ) :: i !< Index into LinTimes (to determine which operating point to copy) + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data + TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpFM !< OpenFOAM data + TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data + TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module + TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables + INTEGER(IntKi) :: k ! generic loop counters + + + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SetOperatingPoint' + + + ErrStat = ErrID_None + ErrMsg = "" + + + !---------------------------------------------------------------------------------------- + !! copy the operating point of the states and inputs at LinTimes(i) + !---------------------------------------------------------------------------------------- + ! ElastoDyn: copy op to actual states and inputs + CALL ED_CopyContState (y_FAST%op%x_ED( i), ED%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyDiscState (y_FAST%op%xd_ED( i), ED%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyConstrState (y_FAST%op%z_ED( i), ED%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyOtherState (y_FAST%op%OtherSt_ED( i), ED%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL ED_CopyInput (y_FAST%op%u_ED( i), ED%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! BeamDyn: copy op to actual states and inputs + IF ( p_FAST%CompElast == Module_BD ) THEN + DO k=1,p_FAST%nBeams + CALL BD_CopyContState (y_FAST%op%x_BD(k, i), BD%x( k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyDiscState (y_FAST%op%xd_BD(k, i), BD%xd(k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyConstrState (y_FAST%op%z_BD(k, i), BD%z( k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyOtherState (y_FAST%op%OtherSt_BD(k, i), BD%OtherSt( k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL BD_CopyInput (y_FAST%op%u_BD(k, i), BD%Input(k,1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END DO + END IF + + ! AeroDyn: copy final predictions to actual states; copy current outputs to next + !IF ( p_FAST%CompAero == Module_AD14 ) THEN + !ELSE + IF ( p_FAST%CompAero == Module_AD ) THEN + CALL AD_CopyContState (y_FAST%op%x_AD( i), AD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyDiscState (y_FAST%op%xd_AD( i), AD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyConstrState (y_FAST%op%z_AD( i), AD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyOtherState (y_FAST%op%OtherSt_AD( i), AD%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL AD_CopyInput (y_FAST%op%u_AD(i), AD%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + + ! InflowWind: copy op to actual states and inputs + IF ( p_FAST%CompInflow == Module_IfW ) THEN + CALL InflowWind_CopyContState (y_FAST%op%x_IfW( i), IfW%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyDiscState (y_FAST%op%xd_IfW( i), IfW%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyConstrState (y_FAST%op%z_IfW( i), IfW%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyOtherState (y_FAST%op%OtherSt_IfW( i), IfW%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL InflowWind_CopyInput (y_FAST%op%u_IfW(i), IfW%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END IF + + + ! ServoDyn: copy op to actual states and inputs + IF ( p_FAST%CompServo == Module_SrvD ) THEN + CALL SrvD_CopyContState (y_FAST%op%x_SrvD( i), SrvD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyDiscState (y_FAST%op%xd_SrvD( i), SrvD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyConstrState (y_FAST%op%z_SrvD( i), SrvD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyOtherState (y_FAST%op%OtherSt_SrvD( i), SrvD%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL SrvD_CopyInput (y_FAST%op%u_SrvD(i), SrvD%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + + + ! HydroDyn: copy op to actual states and inputs + IF ( p_FAST%CompHydro == Module_HD ) THEN + CALL HydroDyn_CopyContState (y_FAST%op%x_HD( i), HD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyDiscState (y_FAST%op%xd_HD( i), HD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyConstrState (y_FAST%op%z_HD( i), HD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyOtherState (y_FAST%op%OtherSt_HD( i), HD%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL HydroDyn_CopyInput (y_FAST%op%u_HD(i), HD%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + + + ! SubDyn: copy final predictions to actual states + IF ( p_FAST%CompSub == Module_SD ) THEN + CALL SD_CopyContState (y_FAST%op%x_SD(i), SD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyDiscState (y_FAST%op%xd_SD(i), SD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyConstrState( y_FAST%op%z_SD(i), SD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyOtherState (y_FAST%op%OtherSt_SD(i), SD%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL SD_CopyInput (y_FAST%op%u_SD(i), SD%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ELSE IF ( p_FAST%CompSub == Module_ExtPtfm ) THEN + CALL ExtPtfm_CopyContState (y_FAST%op%x_ExtPtfm(i), ExtPtfm%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyDiscState (y_FAST%op%xd_ExtPtfm(i), ExtPtfm%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyConstrState (y_FAST%op%z_ExtPtfm(i), ExtPtfm%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyOtherState (y_FAST%op%OtherSt_ExtPtfm(i), ExtPtfm%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL ExtPtfm_CopyInput (y_FAST%op%u_ExtPtfm(i), ExtPtfm%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + + + ! MAP/MoorDyn/FEAM: copy op to actual states and inputs + IF (p_FAST%CompMooring == Module_MAP) THEN + CALL MAP_CopyContState (y_FAST%op%x_MAP(i), MAPp%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MAP_CopyDiscState (y_FAST%op%xd_MAP(i), MAPp%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MAP_CopyConstrState (y_FAST%op%z_MAP(i), MAPp%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + !CALL MAP_CopyOtherState (y_FAST%op%OtherSt_MAP(i), MAPp%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + ! CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL MAP_CopyInput (y_FAST%op%u_MAP(i), MAPp%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ELSEIF (p_FAST%CompMooring == Module_MD) THEN + CALL MD_CopyContState (y_FAST%op%x_MD(i), MD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyDiscState (y_FAST%op%xd_MD(i), MD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyConstrState (y_FAST%op%z_MD(i), MD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyOtherState (y_FAST%op%OtherSt_MD(i), MD%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL MD_CopyInput (y_FAST%op%u_MD(i), MD%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ELSEIF (p_FAST%CompMooring == Module_FEAM) THEN + CALL FEAM_CopyContState (y_FAST%op%x_FEAM(i), FEAM%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyDiscState (y_FAST%op%xd_FEAM(i), FEAM%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyConstrState (y_FAST%op%z_FEAM(i), FEAM%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyOtherState (y_FAST%op%OtherSt_FEAM(i), FEAM%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL FEAM_CopyInput (y_FAST%op%u_FEAM(i), FEAM%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + !ELSEIF (p_FAST%CompMooring == Module_Orca) THEN + END IF + + ! IceFloe/IceDyn: copy op to actual states and inputs + IF ( p_FAST%CompIce == Module_IceF ) THEN + CALL IceFloe_CopyContState (y_FAST%op%x_IceF(i), IceF%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyDiscState (y_FAST%op%xd_IceF(i), IceF%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyConstrState (y_FAST%op%z_IceF(i), IceF%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyOtherState (y_FAST%op%OtherSt_IceF(i), IceF%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL IceFloe_CopyInput (y_FAST%op%u_IceF(i), IceF%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ELSEIF ( p_FAST%CompIce == Module_IceD ) THEN + DO k=1,p_FAST%numIceLegs + CALL IceD_CopyContState (y_FAST%op%x_IceD(k, i), IceD%x( k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyDiscState (y_FAST%op%xd_IceD(k, i), IceD%xd(k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyConstrState (y_FAST%op%z_IceD(k, i), IceD%z( k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyOtherState (y_FAST%op%OtherSt_IceD(k, i), IceD%OtherSt( k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL IceD_CopyInput (y_FAST%op%u_IceD(k, i), IceD%Input(1,k), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + END IF + +END SUBROUTINE SetOperatingPoint +!---------------------------------------------------------------------------------------------------------------------------------- +subroutine GetStateAry(p_FAST, iMode, t, x, x_eig_magnitude, x_eig_phase) + INTEGER(IntKi), INTENT(IN ) :: iMode !< index into Mode dimension of arrays + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + REAL(DbKi) , INTENT(IN ) :: t !< time + REAL(R8Ki), INTENT(INOUT) :: x(:) !< in: state at its operating point; out: added perturbation + REAL(R8Ki), INTENT(IN) :: x_eig_magnitude(:) !< magnitude of the eigenvector + REAL(R8Ki), INTENT(IN) :: x_eig_phase(:) !< phase of the eigenvector + + ! note that this assumes p_FAST%VTK_modes%VTKLinPhase is zero for VTKLinTim=2 + x = x + x_eig_magnitude * p_FAST%VTK_modes%VTKLinScale * cos( TwoPi_D * p_FAST%VTK_modes%DampedFreq_Hz(iMode)*t + x_eig_phase + p_FAST%VTK_modes%VTKLinPhase ) +end subroutine GetStateAry + + + +!---------------------------------------------------------------------------------------------------------------------------------- +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine performs the algorithm for computing a periodic steady-state solution. +SUBROUTINE FAST_CalcSteady( n_t_global, t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + IceF, IceD, ErrStat, ErrMsg ) + + INTEGER(IntKi), INTENT(IN ) :: n_t_global !< integer time step + REAL(DbKi), INTENT(IN ) :: t_global ! current simulation time + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data + TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpFM !< OpenFOAM data + TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm data + TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module + TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables + REAL(DbKi) :: DeltaAzim + REAL(DbKi) :: psi !< psi (rotor azimuth) at which the outputs are defined + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + LOGICAL :: NextAzimuth + + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CalcSteady' + + + ErrStat = ErrID_None + ErrMsg = "" + + + ! get azimuth angle + + psi = ED%y%LSSTipPxa + call Zero2TwoPi( psi ) + + if (n_t_global == 0) then + ! initialize a few things on the first call: + call FAST_InitSteadyOutputs( psi, p_FAST, m_FAST, ED, BD, SrvD, AD, IfW, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + IceF, IceD, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + else + DeltaAzim = psi - m_FAST%Lin%Psi(1) + call Zero2TwoPi(DeltaAzim) + + if (DeltaAzim > p_FAST%AzimDelta) then + call SetErrStat(ErrID_Fatal, "The rotor is spinning too fast. The time step or NLinTimes is too large when CalcSteady=true.", ErrStat, ErrMsg, RoutineName) + return + end if + + ! save the outputs and azimuth angle for possible interpolation later + call FAST_SaveOutputs( psi, p_FAST, m_FAST, ED, BD, SrvD, AD, IfW, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + IceF, IceD, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + end if + if (ErrStat >= AbortErrLev) return + + + + if ( m_FAST%Lin%AzimTarget(m_FAST%Lin%AzimIndx-1) <= m_FAST%Lin%AzimTarget(m_FAST%Lin%AzimIndx) ) then ! the equal sign takes care of the zero-rpm case + NextAzimuth = psi >= m_FAST%Lin%AzimTarget(m_FAST%Lin%AzimIndx) + else + ! this is the 2pi boundary, so we are either larger than the last target azimuth or less than the next one + NextAzimuth = psi >= m_FAST%Lin%AzimTarget(m_FAST%Lin%AzimIndx) .and. psi < m_FAST%Lin%AzimTarget(m_FAST%Lin%AzimIndx-1) + end if + + if (NextAzimuth) then + + ! interpolate to find y at the target azimuth + call FAST_DiffInterpOutputs( m_FAST%Lin%AzimTarget(m_FAST%Lin%AzimIndx), p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + IceF, IceD, ErrStat, ErrMsg ) + + if (m_FAST%Lin%IsConverged .or. m_FAST%Lin%n_rot == 0) then ! save this operating point for linearization later + m_FAST%Lin%LinTimes(m_FAST%Lin%AzimIndx) = t_global + call SaveOP(m_FAST%Lin%AzimIndx, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + IceF, IceD, ErrStat, ErrMsg, m_FAST%Lin%CopyOP_CtrlCode ) + end if + + ! increment the counter to check the next azimuth: + m_FAST%Lin%AzimIndx = m_FAST%Lin%AzimIndx + 1 + + ! check if we've completed one rotor revolution + if (m_FAST%Lin%AzimIndx > p_FAST%NLinTimes) then + m_FAST%Lin%n_rot = m_FAST%Lin%n_rot + 1 + + m_FAST%Lin%FoundSteady = m_FAST%Lin%IsConverged + + if (.not. m_FAST%Lin%FoundSteady) then + ! compute the reference values for this rotor revolution + call ComputeOutputRanges(p_FAST, y_FAST, m_FAST, SrvD%y) + m_FAST%Lin%IsConverged = .true. ! check errors next rotor revolution + m_FAST%Lin%AzimIndx = 1 + m_FAST%Lin%CopyOP_CtrlCode = MESH_UPDATECOPY + end if + end if + + end if + + +END SUBROUTINE FAST_CalcSteady +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine initializes variables for calculating periodic steady-state solution. +SUBROUTINE FAST_InitSteadyOutputs( psi, p_FAST, m_FAST, ED, BD, SrvD, AD, IfW, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + IceF, IceD, ErrStat, ErrMsg ) + + REAL(DbKi), INTENT(IN ) :: psi !< psi (rotor azimuth) at which the outputs are defined + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data + TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm data + TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module + TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables + INTEGER(IntKi) :: j, k ! loop counters + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_InitSteadyOutputs' + + + ErrStat = ErrID_None + ErrMsg = "" + + do j=1,p_FAST%NLinTimes + m_FAST%Lin%AzimTarget(j) = (j-1) * p_FAST%AzimDelta + psi + call Zero2TwoPi( m_FAST%Lin%AzimTarget(j) ) + end do + ! this is circular, so I am going to add points at the beginning and end to avoid + ! more IF statements later + m_FAST%Lin%AzimTarget(0) = m_FAST%Lin%AzimTarget(p_FAST%NLinTimes) + m_FAST%Lin%AzimTarget(p_FAST%NLinTimes+1) = m_FAST%Lin%AzimTarget(1) + + + ! Azimuth angles that correspond to Output arrays for interpolation: + !m_FAST%Lin%Psi = psi ! initialize entire array (note that we won't be able to interpolate with a constant array + DO j = 1, p_FAST%LinInterpOrder + 1 + m_FAST%Lin%Psi(j) = psi - (j - 1) * D2R_D ! arbitrarily say azimuth is one degree different + END DO + + + ! ElastoDyn + allocate( ED%Output( p_FAST%LinInterpOrder+1 ), STAT = ErrStat2 ) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating ED%Output.", ErrStat, ErrMsg, RoutineName ) + else + do j = 1, p_FAST%LinInterpOrder + 1 + call ED_CopyOutput(ED%y, ED%Output(j), MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end do + + call ED_CopyOutput(ED%y, ED%y_interp, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end if + + ! BeamDyn + IF (p_FAST%CompElast == Module_BD) THEN + + allocate( BD%Output( p_FAST%LinInterpOrder+1, p_FAST%nBeams ), STAT = ErrStat2 ) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating BD%Output.", ErrStat, ErrMsg, RoutineName ) + else + do k=1,p_FAST%nBeams + do j = 1, p_FAST%LinInterpOrder + 1 + call BD_CopyOutput(BD%y(k), BD%Output(j,k), MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end do + end do + + allocate( BD%y_interp( p_FAST%nBeams ), STAT = ErrStat2 ) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating BD%Output.", ErrStat, ErrMsg, RoutineName ) + else + do k=1,p_FAST%nBeams + call BD_CopyOutput(BD%y(k), BD%y_interp(k), MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end do + end if + + end if + + END IF ! BeamDyn + + ! AeroDyn + IF ( p_FAST%CompAero == Module_AD ) THEN + + allocate( AD%Output( p_FAST%LinInterpOrder+1 ), STAT = ErrStat2 ) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating AD%Output.", ErrStat, ErrMsg, RoutineName ) + else + do j = 1, p_FAST%LinInterpOrder + 1 + call AD_CopyOutput(AD%y, AD%Output(j), MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end do + + call AD_CopyOutput(AD%y, AD%y_interp, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end if + + END IF ! CompAero + + + ! InflowWind + IF ( p_FAST%CompInflow == Module_IfW ) THEN + + allocate( IfW%Output( p_FAST%LinInterpOrder+1 ), STAT = ErrStat2 ) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating IfW%Output.", ErrStat, ErrMsg, RoutineName ) + else + do j = 1, p_FAST%LinInterpOrder + 1 + call InflowWind_CopyOutput(IfW%y, IfW%Output(j), MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end do + + call InflowWind_CopyOutput(IfW%y, IfW%y_interp, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end if + + END IF ! CompInflow + + + ! ServoDyn + IF ( p_FAST%CompServo == Module_SrvD ) THEN + + allocate( SrvD%Output( p_FAST%LinInterpOrder+1 ), STAT = ErrStat2 ) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating SrvD%Output.", ErrStat, ErrMsg, RoutineName ) + else + do j = 1, p_FAST%LinInterpOrder + 1 + call SrvD_CopyOutput(SrvD%y, SrvD%Output(j), MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end do + + call SrvD_CopyOutput(SrvD%y, SrvD%y_interp, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end if + + END IF ! ServoDyn + + ! HydroDyn + IF ( p_FAST%CompHydro == Module_HD ) THEN + + allocate( HD%Output( p_FAST%LinInterpOrder+1 ), STAT = ErrStat2 ) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating HD%Output.", ErrStat, ErrMsg, RoutineName ) + else + do j = 1, p_FAST%LinInterpOrder + 1 + call HydroDyn_CopyOutput(HD%y, HD%Output(j), MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end do + + call HydroDyn_CopyOutput(HD%y, HD%y_interp, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end if + + END IF ! HydroDyn + + + !! SubDyn/ExtPtfm_MCKF + !IF ( p_FAST%CompSub == Module_SD ) THEN + !ELSE IF ( p_FAST%CompSub == Module_ExtPtfm ) THEN + !END IF ! SubDyn/ExtPtfm_MCKF + + + ! Mooring (MAP , FEAM , MoorDyn) + ! MAP + IF ( p_FAST%CompMooring == Module_MAP ) THEN + + allocate( MAPp%Output( p_FAST%LinInterpOrder+1 ), STAT = ErrStat2 ) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating MAPp%Output.", ErrStat, ErrMsg, RoutineName ) + else + do j = 1, p_FAST%LinInterpOrder + 1 + call MAP_CopyOutput(MAPp%y, MAPp%Output(j), MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end do + + call MAP_CopyOutput(MAPp%y, MAPp%y_interp, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end if + + !! MoorDyn + !ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN + !! FEAM + !ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN + !! OrcaFlex + !ELSEIF ( p_FAST%CompMooring == Module_Orca ) THEN + + END IF ! MAP/FEAM/MoorDyn/OrcaFlex + + + + !! Ice (IceFloe or IceDyn) + !! IceFloe + !IF ( p_FAST%CompIce == Module_IceF ) THEN + ! + !! IceDyn + !ELSEIF ( p_FAST%CompIce == Module_IceD ) THEN + ! + !END IF ! IceFloe/IceDyn + + +END SUBROUTINE FAST_InitSteadyOutputs +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine saves outputs for future interpolation at a desired azimuth. +SUBROUTINE FAST_SaveOutputs( psi, p_FAST, m_FAST, ED, BD, SrvD, AD, IfW, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + IceF, IceD, ErrStat, ErrMsg ) + + REAL(DbKi), INTENT(IN ) :: psi !< psi (rotor azimuth) at which the outputs are defined + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data + TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm data + TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module + TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables + INTEGER(IntKi) :: j, k ! loop counters + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_SaveOutputs' + + + ErrStat = ErrID_None + ErrMsg = "" + + DO j = p_FAST%LinInterpOrder, 1, -1 + m_FAST%Lin%Psi(j+1) = m_FAST%Lin%Psi(j) + END DO + + if (psi < m_FAST%Lin%Psi(1)) then + ! if we go around a 2pi boundary, we will subtract 2pi from the saved values so that interpolation works as expected + m_FAST%Lin%Psi = m_FAST%Lin%Psi - TwoPi_D + end if + m_FAST%Lin%Psi(1) = psi + + ! ElastoDyn + DO j = p_FAST%LinInterpOrder, 1, -1 + CALL ED_CopyOutput(ED%Output(j), ED%Output(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + END DO + + CALL ED_CopyOutput (ED%y, ED%Output(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + ! BeamDyn + IF (p_FAST%CompElast == Module_BD) THEN + + DO k = 1,p_FAST%nBeams + + DO j = p_FAST%LinInterpOrder, 1, -1 + CALL BD_CopyOutput (BD%Output(j,k), BD%Output(j+1,k), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + END DO + + CALL BD_CopyOutput (BD%y(k), BD%Output(1,k), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + END DO ! k=p_FAST%nBeams + + END IF ! BeamDyn + + + ! AeroDyn + IF ( p_FAST%CompAero == Module_AD ) THEN + + DO j = p_FAST%LinInterpOrder, 1, -1 + CALL AD_CopyOutput (AD%Output(j), AD%Output(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + END DO + + CALL AD_CopyOutput (AD%y, AD%Output(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + END IF ! CompAero + + + ! InflowWind + IF ( p_FAST%CompInflow == Module_IfW ) THEN + + DO j = p_FAST%LinInterpOrder, 1, -1 + CALL InflowWind_CopyOutput (IfW%Output(j), IfW%Output(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + END DO + + CALL InflowWind_CopyOutput (IfW%y, IfW%Output(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + END IF ! CompInflow + + + ! ServoDyn + IF ( p_FAST%CompServo == Module_SrvD ) THEN + + DO j = p_FAST%LinInterpOrder, 1, -1 + CALL SrvD_CopyOutput (SrvD%Output(j), SrvD%Output(j+1), MESH_UPDATECOPY, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + END DO + + CALL SrvD_CopyOutput (SrvD%y, SrvD%Output(1), MESH_UPDATECOPY, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + END IF ! ServoDyn + + ! HydroDyn + IF ( p_FAST%CompHydro == Module_HD ) THEN + + DO j = p_FAST%LinInterpOrder, 1, -1 + + CALL HydroDyn_CopyOutput (HD%Output(j), HD%Output(j+1), MESH_UPDATECOPY, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + END DO + + CALL HydroDyn_CopyOutput (HD%y, HD%Output(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + END IF ! HydroDyn + + + !! SubDyn/ExtPtfm_MCKF + !IF ( p_FAST%CompSub == Module_SD ) THEN + !ELSE IF ( p_FAST%CompSub == Module_ExtPtfm ) THEN + !END IF ! SubDyn/ExtPtfm_MCKF + + + ! Mooring (MAP , FEAM , MoorDyn) + ! MAP + IF ( p_FAST%CompMooring == Module_MAP ) THEN + + DO j = p_FAST%LinInterpOrder, 1, -1 + CALL MAP_CopyOutput (MAPp%Output(j), MAPp%Output(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + END DO + + CALL MAP_CopyOutput (MAPp%y, MAPp%Output(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + !! MoorDyn + !ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN + !! FEAM + !ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN + !! OrcaFlex + !ELSEIF ( p_FAST%CompMooring == Module_Orca ) THEN + + END IF ! MAP/FEAM/MoorDyn/OrcaFlex + + + + !! Ice (IceFloe or IceDyn) + !! IceFloe + !IF ( p_FAST%CompIce == Module_IceF ) THEN + ! + !! IceDyn + !ELSEIF ( p_FAST%CompIce == Module_IceD ) THEN + ! + !END IF ! IceFloe/IceDyn + + +END SUBROUTINE FAST_SaveOutputs +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine interpolates the outputs at the target azimuths, computes the compared to the previous rotation, and stores +!! them for future rotation . +SUBROUTINE FAST_DiffInterpOutputs( psi_target, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + IceF, IceD, ErrStat, ErrMsg ) + + REAL(DbKi), INTENT(IN ) :: psi_target !< psi (rotor azimuth) at which the outputs are requested + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data + TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm data + TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module + TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables + INTEGER(IntKi) :: k ! loop counters + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + REAL(DbKi) :: t_global + REAL(ReKi) :: eps_squared + + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DiffInterpOutputs' + + ErrStat = ErrID_None + ErrMsg = "" + t_global = 0.0_DbKi ! we don't really need this to get the output OPs + + !................................................................................................ + ! Extrapolate outputs to the target azimuth and pack into OP arrays + !................................................................................................ + + ! ElastoDyn + CALL ED_Output_ExtrapInterp (ED%Output, m_FAST%Lin%Psi, ED%y_interp, psi_target, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + call ED_GetOP( t_global, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), & + ED%y_interp, ED%m, ErrStat2, ErrMsg2, y_op=y_FAST%Lin%Modules(Module_ED)%Instance(1)%op_y, NeedLogMap=.true.) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ! BeamDyn + IF (p_FAST%CompElast == Module_BD) THEN + + DO k = 1,p_FAST%nBeams + + CALL BD_Output_ExtrapInterp (BD%Output(:,k), m_FAST%Lin%Psi, BD%y_interp(k), psi_target, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + call BD_GetOP( t_global, BD%Input(1,k), BD%p(k), BD%x(k,STATE_CURR), BD%xd(k,STATE_CURR), BD%z(k,STATE_CURR), BD%OtherSt(k,STATE_CURR), & + BD%y_interp(k), BD%m(k), ErrStat2, ErrMsg2, y_op=y_FAST%Lin%Modules(Module_BD)%Instance(k)%op_y, NeedLogMap=.true.) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + END DO ! k=p_FAST%nBeams + + END IF ! BeamDyn + + + ! AeroDyn + IF ( p_FAST%CompAero == Module_AD ) THEN + + CALL AD_Output_ExtrapInterp (AD%Output, m_FAST%Lin%Psi, AD%y_interp, psi_target, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + call AD_GetOP( t_global, AD%Input(1), AD%p, AD%x(STATE_CURR), AD%xd(STATE_CURR), AD%z(STATE_CURR), AD%OtherSt(STATE_CURR), & + AD%y_interp, AD%m, ErrStat2, ErrMsg2, y_op=y_FAST%Lin%Modules(Module_AD)%Instance(1)%op_y) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + END IF ! CompAero + + + ! InflowWind + IF ( p_FAST%CompInflow == Module_IfW ) THEN + + CALL InflowWind_Output_ExtrapInterp (IfW%Output, m_FAST%Lin%Psi, IfW%y_interp, psi_target, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + call InflowWind_GetOP( t_global, IfW%Input(1), IfW%p, IfW%x(STATE_CURR), IfW%xd(STATE_CURR), IfW%z(STATE_CURR), IfW%OtherSt(STATE_CURR), & + IfW%y_interp, IfW%m, ErrStat2, ErrMsg2, y_op=y_FAST%Lin%Modules(Module_IfW)%Instance(1)%op_y) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + END IF ! CompInflow + + + ! ServoDyn + IF ( p_FAST%CompServo == Module_SrvD ) THEN + + CALL SrvD_Output_ExtrapInterp (SrvD%Output, m_FAST%Lin%Psi, SrvD%y_interp, psi_target, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + call SrvD_GetOP( t_global, SrvD%Input(1), SrvD%p, SrvD%x(STATE_CURR), SrvD%xd(STATE_CURR), SrvD%z(STATE_CURR), SrvD%OtherSt(STATE_CURR), & + SrvD%y_interp, SrvD%m, ErrStat2, ErrMsg2, y_op=y_FAST%Lin%Modules(Module_SrvD)%Instance(1)%op_y) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + END IF ! ServoDyn + + ! HydroDyn + IF ( p_FAST%CompHydro == Module_HD ) THEN + + CALL HydroDyn_Output_ExtrapInterp (HD%Output, m_FAST%Lin%Psi, HD%y_interp, psi_target, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + call HD_GetOP( t_global, HD%Input(1), HD%p, HD%x(STATE_CURR), HD%xd(STATE_CURR), HD%z(STATE_CURR), HD%OtherSt(STATE_CURR), & + HD%y_interp, HD%m, ErrStat2, ErrMsg2, y_op=y_FAST%Lin%Modules(Module_HD)%Instance(1)%op_y) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + END IF ! HydroDyn + + + !! SubDyn/ExtPtfm_MCKF + !IF ( p_FAST%CompSub == Module_SD ) THEN + !ELSE IF ( p_FAST%CompSub == Module_ExtPtfm ) THEN + !END IF ! SubDyn/ExtPtfm_MCKF + + + ! Mooring (MAP , FEAM , MoorDyn) + ! MAP + IF ( p_FAST%CompMooring == Module_MAP ) THEN + + CALL MAP_Output_ExtrapInterp (MAPp%Output, m_FAST%Lin%Psi, MAPp%y_interp, psi_target, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + call MAP_GetOP( t_global, MAPp%Input(1), MAPp%p, MAPp%x(STATE_CURR), MAPp%xd(STATE_CURR), MAPp%z(STATE_CURR), MAPp%OtherSt, & + MAPp%y_interp, ErrStat2, ErrMsg2, y_op=y_FAST%Lin%Modules(Module_MAP)%Instance(1)%op_y) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + !! MoorDyn + !ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN + !! FEAM + !ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN + !! OrcaFlex + !ELSEIF ( p_FAST%CompMooring == Module_Orca ) THEN + + END IF ! MAP/FEAM/MoorDyn/OrcaFlex + + + + !! Ice (IceFloe or IceDyn) + !! IceFloe + !IF ( p_FAST%CompIce == Module_IceF ) THEN + ! + !! IceDyn + !ELSEIF ( p_FAST%CompIce == Module_IceD ) THEN + ! + !END IF ! IceFloe/IceDyn + + + call pack_in_array(p_FAST, y_FAST, m_FAST) + + if (m_FAST%Lin%IsConverged) then + ! check that error equation is less than TrimTol !!!call + call calc_error(p_FAST, y_FAST, m_FAST, SrvD%y, eps_squared) + m_FAST%Lin%IsConverged = eps_squared < p_FAST%TrimTol + end if + + + m_FAST%Lin%Y_prevRot(:,m_FAST%Lin%AzimIndx) = m_FAST%Lin%y_interp + +END SUBROUTINE FAST_DiffInterpOutputs +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE pack_in_array(p_FAST, y_FAST, m_FAST) + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + + INTEGER(IntKi) :: ThisModule !< module identifier + INTEGER(IntKi) :: ThisInstance !< index of the module instance + + integer :: i, j + integer :: ny + integer :: indx + + ! note that op_y may be larger than SizeLin if there are orientations; also, we are NOT including the WriteOutputs + + do i = 1,p_FAST%Lin_NumMods + ThisModule = p_FAST%Lin_ModOrder( i ) + + do ThisInstance=1,size(y_FAST%Lin%Modules(ThisModule)%Instance) + + ny = y_FAST%Lin%Modules(ThisModule)%Instance(ThisInstance)%SizeLin(LIN_OUTPUT_COL) - y_FAST%Lin%Modules(ThisModule)%Instance(ThisInstance)%NumOutputs !last column before WriteOutput occurs + do j=1,ny + indx = y_FAST%Lin%Modules(ThisModule)%Instance(ThisInstance)%LinStartIndx(LIN_OUTPUT_COL) + j - 1 + + m_FAST%Lin%y_interp( indx ) = y_FAST%Lin%Modules(ThisModule)%Instance(ThisInstance)%op_y(j) + end do + + end do + end do + +END SUBROUTINE pack_in_array +!---------------------------------------------------------------------------------------------------------------------------------- +!> This function computes the error function between this rotor revolution and the previous one. +!! Angles represented in m_FAST%Lin%y_interp may have 2pi added or subtracted to allow the angles to be closer to the previous +!! rotor revolution. +SUBROUTINE calc_error(p_FAST, y_FAST, m_FAST, y_SrvD, eps_squared) + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + TYPE(FAST_OutputFileType),INTENT(IN ) :: y_FAST !< Output variables for the glue code + TYPE(SrvD_OutputType), INTENT(IN ) :: y_SrvD !< Output variables for the glue code + REAL(ReKi) ,INTENT( OUT) :: eps_squared !< epsilon squared + + INTEGER(IntKi) :: ThisModule !< module identifier + INTEGER(IntKi) :: ThisInstance !< index of the module instance + + integer :: i, j + integer :: ny + integer :: indx + real(ReKi) :: diff + + + ! special cases for angles: + indx = Indx_y_Yaw_Start(y_FAST, Module_ED) ! start of ED where Yaw, YawRate, HSS_Spd occur (right before WriteOutputs) + call AddOrSub2Pi(m_FAST%Lin%Y_prevRot( indx, m_FAST%Lin%AzimIndx ), m_FAST%Lin%y_interp( indx )) + + if (p_FAST%CompServo == Module_SrvD) then + do i = 1, size( y_SrvD%BlPitchCom ) + indx = y_FAST%Lin%Modules(Module_SrvD)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + i - 1 + call AddOrSub2Pi(m_FAST%Lin%Y_prevRot( indx, m_FAST%Lin%AzimIndx ), m_FAST%Lin%y_interp( indx )) + end do + end if + + + ! compute the error: + eps_squared = 0.0_ReKi + + do i = 1,p_FAST%Lin_NumMods + ThisModule = p_FAST%Lin_ModOrder( i ) + + do ThisInstance=1,size(y_FAST%Lin%Modules(ThisModule)%Instance) + + ny = y_FAST%Lin%Modules(ThisModule)%Instance(ThisInstance)%SizeLin(LIN_OUTPUT_COL) - y_FAST%Lin%Modules(ThisModule)%Instance(ThisInstance)%NumOutputs !last column before WriteOutput occurs + + do j=1,ny + indx = y_FAST%Lin%Modules(ThisModule)%Instance(ThisInstance)%LinStartIndx(LIN_OUTPUT_COL) + j - 1 + + if (EqualRealNos(m_FAST%Lin%y_interp( indx ), m_FAST%Lin%Y_prevRot( indx, m_FAST%Lin%AzimIndx ))) then + diff = 0.0_ReKi ! take care of some potential numerical issues + else + diff = m_FAST%Lin%y_interp( indx ) - m_FAST%Lin%Y_prevRot( indx, m_FAST%Lin%AzimIndx ) + end if + + eps_squared = eps_squared + ( diff / m_FAST%Lin%y_ref( indx ) ) ** 2 + end do + + end do + end do + + + !................................. + ! Normalize: + !................................. + eps_squared = eps_squared / ( y_FAST%Lin%Glue%SizeLin(LIN_OUTPUT_COL) - y_FAST%Lin%Glue%NumOutputs ) + +! write(50+m_FAST%Lin%AzimIndx,'(3000(F15.7,1x))') m_FAST%Lin%y_interp, eps_squared +END SUBROUTINE calc_error +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE ComputeOutputRanges(p_FAST, y_FAST, m_FAST, y_SrvD) + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + TYPE(FAST_OutputFileType),INTENT(IN ) :: y_FAST !< Output variables for the glue code + TYPE(SrvD_OutputType), INTENT(IN ) :: y_SrvD !< Output variables for the glue code + + integer :: indx + integer :: i + + ! note that op_y may be larger than SizeLin if there are orientations; also, we are NOT including the WriteOutputs + + do indx = 1,y_FAST%Lin%Glue%SizeLin(LIN_OUTPUT_COL) + m_FAST%Lin%y_ref(indx) = maxval( m_FAST%Lin%Y_prevRot( indx, : ) ) - minval( m_FAST%Lin%Y_prevRot( indx, : ) ) + m_FAST%Lin%y_ref(indx) = max( m_FAST%Lin%y_ref(indx), 0.01_ReKi ) +! if (m_FAST%Lin%y_ref(indx) < 1.0e-4) m_FAST%Lin%y_ref(indx) = 1.0_ReKi ! not sure why we wouldn't just do m_FAST%Lin%y_ref(indx) = max(1.0_ReKi, m_FAST%Lin%y_ref(indx)) or max(1e-4, y_ref(indx)) + end do + + ! special case for angles: + indx = Indx_y_Yaw_Start(y_FAST, Module_ED) ! start of ED where Yaw, YawRate, HSS_Spd occur (right before WriteOutputs) + m_FAST%Lin%y_ref(indx) = min( m_FAST%Lin%y_ref(indx), Pi ) + + if (p_FAST%CompServo == Module_SrvD) then + do i = 1, size( y_SrvD%BlPitchCom ) + indx = y_FAST%Lin%Modules(Module_SrvD)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + i - 1 + m_FAST%Lin%y_ref(indx) = min( m_FAST%Lin%y_ref(indx), Pi ) + end do + end if + + ! Note: I'm ignoring the periodicity of the log maps that represent orientations + +END SUBROUTINE ComputeOutputRanges +!---------------------------------------------------------------------------------------------------------------------------------- + END MODULE FAST_Linear diff --git a/modules/openfast-library/src/FAST_Registry.txt b/modules/openfast-library/src/FAST_Registry.txt index 0e68ca8c12..ee121790c7 100644 --- a/modules/openfast-library/src/FAST_Registry.txt +++ b/modules/openfast-library/src/FAST_Registry.txt @@ -70,21 +70,20 @@ typedef ^ FAST_VTK_SurfaceType SiKi WaveElev {:}{:} - - "wave elevation at WaveE typedef ^ FAST_VTK_SurfaceType FAST_VTK_BLSurfaceType BladeShape {:} - - "AirfoilCoords for each blade" m typedef ^ FAST_VTK_SurfaceType SiKi MorisonRad {:} - - "radius of each Morison node" m - -typedef ^ FAST_VTK_ModeShapeType CHARACTER(1024) CheckpointRoot - - - "name of the checkpoint file written by FAST when linearization data was produced" -typedef ^ FAST_VTK_ModeShapeType CHARACTER(1024) MatlabFileName - - - "name of the file with eigenvectors written by Matlab" -typedef ^ FAST_VTK_ModeShapeType IntKi VTKLinModes - - - "Number of modes to visualize" - -typedef ^ FAST_VTK_ModeShapeType IntKi VTKModes {:} - - "Which modes to visualize" - -typedef ^ FAST_VTK_ModeShapeType IntKi VTKLinTim - - - "Switch to make one animation for all LinTimes together (1) or separate animations for each LinTimes(2)" - -typedef ^ FAST_VTK_ModeShapeType IntKi VTKNLinTimes - - - "number of linearization times to use when VTKLinTim==2" - -typedef ^ FAST_VTK_ModeShapeType ReKi VTKLinScale - - - "Mode shape visualization scaling factor" - -typedef ^ FAST_VTK_ModeShapeType ReKi VTKLinPhase - - - "Phase when making one animation for all LinTimes together (used only when VTKLinTim=1)" - -typedef ^ FAST_VTK_ModeShapeType R8Ki DampingRatio {:} - - "damping ratios from mbc3 analysis" - -typedef ^ FAST_VTK_ModeShapeType R8Ki NaturalFreq_Hz {:} - - "natural frequency from mbc3 analysis" - -typedef ^ FAST_VTK_ModeShapeType R8Ki DampedFreq_Hz {:} - - "damped frequency from mbc3 analysis" - -typedef ^ FAST_VTK_ModeShapeType R8Ki x_eig_magnitude {:}{:}{:} - - "magnitude of eigenvector (dimension 1=state, dim 2= azimuth, dim 3 = mode)" - -typedef ^ FAST_VTK_ModeShapeType R8Ki x_eig_phase {:}{:}{:} - - "phase of eigenvector (dimension 1=state, dim 2= azimuth, dim 3 = mode)" - +typedef ^ FAST_VTK_ModeShapeType CHARACTER(1024) CheckpointRoot - - - "name of the checkpoint file written by FAST when linearization data was produced" +typedef ^ FAST_VTK_ModeShapeType CHARACTER(1024) MatlabFileName - - - "name of the file with eigenvectors written by Matlab" +typedef ^ FAST_VTK_ModeShapeType IntKi VTKLinModes - - - "Number of modes to visualize" - +typedef ^ FAST_VTK_ModeShapeType IntKi VTKModes {:} - - "Which modes to visualize" - +typedef ^ FAST_VTK_ModeShapeType IntKi VTKLinTim - - - "Switch to make one animation for all LinTimes together (1) or separate animations for each LinTimes(2)" - +typedef ^ FAST_VTK_ModeShapeType IntKi VTKNLinTimes - - - "number of linearization times to use when VTKLinTim==2" - +typedef ^ FAST_VTK_ModeShapeType ReKi VTKLinScale - - - "Mode shape visualization scaling factor" - +typedef ^ FAST_VTK_ModeShapeType ReKi VTKLinPhase - - - "Phase when making one animation for all LinTimes together (used only when VTKLinTim=1)" - +typedef ^ FAST_VTK_ModeShapeType R8Ki DampingRatio {:} - - "damping ratios from mbc3 analysis" - +typedef ^ FAST_VTK_ModeShapeType R8Ki NaturalFreq_Hz {:} - - "natural frequency from mbc3 analysis" - +typedef ^ FAST_VTK_ModeShapeType R8Ki DampedFreq_Hz {:} - - "damped frequency from mbc3 analysis" - +typedef ^ FAST_VTK_ModeShapeType R8Ki x_eig_magnitude {:}{:}{:} - - "magnitude of eigenvector (dimension 1=state, dim 2= azimuth, dim 3 = mode)" - +typedef ^ FAST_VTK_ModeShapeType R8Ki x_eig_phase {:}{:}{:} - - "phase of eigenvector (dimension 1=state, dim 2= azimuth, dim 3 = mode)" - # ..... FAST_ParameterType data ....................................................................................................... @@ -133,6 +132,7 @@ typedef ^ FAST_ParameterType DbKi DT_Out - - - "Time step for tabular output" s typedef ^ FAST_ParameterType LOGICAL WrSttsTime - - - "Whether we should write the status times to the screen" - typedef ^ FAST_ParameterType INTEGER n_SttsTime - - - "Number of time steps between screen status messages" - typedef ^ FAST_ParameterType INTEGER n_ChkptTime - - - "Number of time steps between writing checkpoint files" - +typedef ^ FAST_ParameterType INTEGER n_DT_Out - - - "Number of time steps between writing a line in the time-marching output files" - typedef ^ FAST_ParameterType INTEGER n_VTKTime - - - "Number of time steps between writing VTK files" - typedef ^ FAST_ParameterType IntKi TurbineType - - - "Type_LandBased, Type_Offshore_Fixed, or Type_Offshore_Floating" - typedef ^ FAST_ParameterType LOGICAL WrBinOutFile - - - "Write a binary output file? (.outb)" - @@ -149,19 +149,33 @@ typedef ^ FAST_ParameterType IntKi FmtWidth - - - "width of the time OutFmt spec typedef ^ FAST_ParameterType IntKi TChanLen - - - "width of the time channel" - typedef ^ FAST_ParameterType CHARACTER(1024) OutFileRoot - - - "The rootname of the output files" - typedef ^ FAST_ParameterType CHARACTER(1024) FTitle - - - "The description line from the FAST (glue-code) input file" - -typedef ^ FAST_ParameterType DbKi VTK_fps - - - "number of frames per second to output VTK data" - -typedef ^ FAST_ParameterType DbKi LinTimes {:} - - "List of times at which to linearize" s +typedef ^ FAST_ParameterType CHARACTER(1024) VTK_OutFileRoot - "''" - "The rootname of the VTK output files" - +typedef ^ FAST_ParameterType INTEGER VTK_tWidth - - - "Width of number of files for leading zeros in file name format" - +typedef ^ FAST_ParameterType DbKi VTK_fps - - - "number of frames per second to output VTK data" - +typedef ^ FAST_ParameterType FAST_VTK_SurfaceType VTK_surface - - - "Data for VTK surface visualization" +typedef ^ FAST_ParameterType SiKi TurbinePos {3} - - "Initial position of turbine base (origin used for graphics)" m +typedef ^ FAST_ParameterType CHARACTER(4) Tdesc - - - "description of turbine ID (for FAST.Farm) screen printing" + +# Parameters for linearization +typedef ^ FAST_ParameterType LOGICAL CalcSteady - - - "Calculate a steady-state periodic operating point before linearization [unused if Linearize=False]" - +typedef ^ FAST_ParameterType IntKi TrimCase - - - "Controller parameter to be trimmed {1:yaw; 2:torque; 3:pitch} [unused if Linearize=False; used only if CalcSteady=True]" - +typedef ^ FAST_ParameterType ReKi TrimTol - - - "Tolerance for the rotational speed convergence (>0) [unused if Linearize=False; used only if CalcSteady=True]" - +typedef ^ FAST_ParameterType ReKi TrimGain - - - "Proportional gain for the rotational speed error (>0) [unused if Linearize=False; used only if CalcSteady=True]" "rad/(rad/s) for yaw or pitch; Nm/(rad/s) for torque" +typedef ^ FAST_ParameterType ReKi Twr_Kdmp - - - "Damping factor for the tower [unused if Linearize=False; used only if CalcSteady=True]" "N/(m/s)" +typedef ^ FAST_ParameterType ReKi Bld_Kdmp - - - "Damping factor for the blades [unused if Linearize=False; used only if CalcSteady=True]" "N/(m/s)" +typedef ^ FAST_ParameterType IntKi NLinTimes - - - "Number of LinTimes, or equally-spaced azimuth steps in periodic linearized model (>0)[unused if Linearize=False]" - +typedef ^ FAST_ParameterType DbKi AzimDelta - - - "difference between two consecutive azimuth positions in CalcSteady algorithm" rad + typedef ^ FAST_ParameterType IntKi LinInputs - - - "Inputs included in linearization (switch) {0=none; 1=standard; 2=all module inputs (debug)} [unused if Linearize=False]" - typedef ^ FAST_ParameterType IntKi LinOutputs - - - "Outputs included in linearization (switch) {0=none; 1=from OutList(s); 2=all module outputs (debug)} [unused if Linearize=False]" - typedef ^ FAST_ParameterType LOGICAL LinOutJac - - - "Include full Jacabians in linearization output (for debug) (flag) [unused if Linearize=False; used only if LinInputs=LinOutputs=2]" - typedef ^ FAST_ParameterType LOGICAL LinOutMod - - - "Write module-level linearization output files in addition to output for full system? (flag) [unused if Linearize=False]" - -typedef ^ FAST_ParameterType FAST_VTK_SurfaceType VTK_surface - - - "Data for VTK surface visualization" typedef ^ FAST_ParameterType FAST_VTK_ModeShapeType VTK_modes - - - "Data for VTK mode-shape visualization" -typedef ^ FAST_ParameterType SiKi TurbinePos {3} - - "Initial position of turbine base (origin used for graphics)" m typedef ^ FAST_ParameterType IntKi Lin_NumMods - - - "number of modules in the linearization" -typedef ^ FAST_ParameterType Integer Lin_ModOrder {NumModules} - - "indices that determine which order the modules are in the glue-code linearization matrix" -typedef ^ FAST_ParameterType CHARACTER(4) Tdesc - - - "description of turbine ID (for FAST.Farm) screen printing" +typedef ^ FAST_ParameterType IntKi Lin_ModOrder {NumModules} - - "indices that determine which order the modules are in the glue-code linearization matrix" +typedef ^ FAST_ParameterType IntKi LinInterpOrder - - - "Interpolation order for CalcSteady solution" - +#typedef ^ FAST_ParameterType LOGICAL CheckHSSBrTrqC - - - "Flag to determine if we should check HSSBrTrqC extrapolation to ElastoDyn" - # SAVED OPERATING POINT DATA FOR VTKLIN (visualization of mode shapes from linearization analysis) @@ -280,14 +294,31 @@ typedef ^ FAST_LinType IntKi SizeLin {3} - - "sizes of (1) the module's inputs, typedef ^ FAST_LinType IntKi LinStartIndx {3} - - "the starting index in combined matrices of (1) the module's inputs, (2) the module's linearized outputs, and (3) the module's continuous states" - typedef ^ FAST_LinType IntKi NumOutputs - - - "number of WriteOutputs in each linearized module" - -# ..... FAST_ModLinType data ....................................................................................................... +# ..... FAST_ModLinType data (for output) ........................................................................................... typedef ^ FAST_ModLinType FAST_LinType Instance {:} - - "Linearization data for each module instance (e.g., 3 blades for BD)" # ..... FAST_LinFileType data ....................................................................................................... typedef FAST FAST_LinFileType FAST_ModLinType Modules {NumModules} - - "Linearization data for each module" typedef ^ FAST_LinFileType FAST_LinType Glue - - - "Linearization data for the glue code (coupled system)" typedef ^ FAST_LinFileType ReKi RotSpeed - - - "Rotor azimuth angular speed" rad/s -typedef ^ FAST_LinFileType ReKi Azimuth - - - +typedef ^ FAST_LinFileType ReKi Azimuth - - - "Rotor azimuth position" rad +typedef ^ FAST_LinFileType ReKi WindSpeed - - - "Wind speed at reference height" m/s + + +# ..... FAST_MiscLinType data ....................................................................................................... +typedef ^ FAST_MiscLinType DbKi LinTimes {:} - - "List of times at which to linearize" s +typedef ^ FAST_MiscLinType IntKi CopyOP_CtrlCode - - - "if we are mesh control code for copy type" - +typedef ^ FAST_MiscLinType DbKi AzimTarget {:} - - "target azimuth positions in CalcSteady algorithm" rad +typedef ^ FAST_MiscLinType logical IsConverged - - - "whether the error calculation in the CalcSteady algorithm is converged" - +typedef ^ FAST_MiscLinType logical FoundSteady - - - "whether the CalcSteady algorithm found a steady-state solution" - +typedef ^ FAST_MiscLinType IntKi n_rot - - - "number of rotations completed in CalcSteady algorithm" - +typedef ^ FAST_MiscLinType IntKi AzimIndx - - - "index into target azimuth array in CalcSteady algorithm" - +typedef ^ FAST_MiscLinType IntKi NextLinTimeIndx - - - "index for next time in LinTimes where linearization should occur" - +typedef ^ FAST_MiscLinType DbKi Psi {:} - - "Azimuth angle at the current and previous time steps (uses LinInterpOrder); DbKi so that we can use registry-generated extrap/interp routines" - +typedef ^ FAST_MiscLinType ReKi y_interp {:} - - "Interpolated outputs packed into an array" - +typedef ^ FAST_MiscLinType ReKi y_ref {:} - - "Reference output range for CalcSteady error calculation" - +typedef ^ FAST_MiscLinType ReKi Y_prevRot {:}{:} - - "Linearization outputs from previous rotor revolution at each target azimuth " - + # ..... FAST_OutputFileType data ....................................................................................................... typedef FAST FAST_OutputFileType DbKi TimeData {:} - - "Array to contain the time output data for the binary file (first output time and a time [fixed] increment)" @@ -303,9 +334,12 @@ typedef ^ FAST_OutputFileType CHARACTER(ChanLen) ChannelNames {:} - - "Names of typedef ^ FAST_OutputFileType CHARACTER(ChanLen) ChannelUnits {:} - - "Units for the output channels" typedef ^ FAST_OutputFileType ProgDesc Module_Ver {NumModules} - - "version information from all modules" typedef ^ FAST_OutputFileType CHARACTER(ChanLen) Module_Abrev {NumModules} - - "abbreviation for module (used in file output naming conventions)" +typedef ^ FAST_OutputFileType LOGICAL WriteThisStep - - - "Whether this step will be written in the FAST output files" typedef ^ FAST_OutputFileType IntKi VTK_count - - - "Number of VTK files written (for naming output files)" 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 CHARACTER(30) OutFmt_a - - - "Format used for text tabular output (except time); combines OutFmt with delim and appropriate spaces" - typedef ^ FAST_OutputFileType FAST_LinStateSave op - - - "operating points of states and inputs for VTK output of mode shapes" @@ -334,6 +368,8 @@ 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" +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" @@ -346,7 +382,8 @@ 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 InputTimes" +typedef ^ ^ ED_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" +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" @@ -360,6 +397,8 @@ 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_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" @@ -384,6 +423,8 @@ 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" +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" @@ -396,6 +437,8 @@ 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" +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" @@ -443,6 +486,8 @@ 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" +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" @@ -467,6 +512,8 @@ typedef ^ ^ MAP_ParameterType p - - - "Parameters" typedef ^ ^ MAP_InputType u - - - "System inputs" typedef ^ ^ MAP_OutputType y - - - "System outputs" 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" @@ -572,9 +619,9 @@ typedef ^ FAST_ModuleMapType MeshType u_ExtPtfm_PtfmMesh - - - "copy of ExtPtfm_ # ..... FAST_ExternalInput data ....................................................................................................... typedef FAST FAST_ExternInputType ReKi GenTrq - - - "generator torque input from Simulink/Labview" typedef ^ FAST_ExternInputType ReKi ElecPwr - - - "electric power input from Simulink/Labview" -typedef ^ FAST_ExternInputType ReKi YawPosCom - - - "yaw position command from Simulink/Labview" +typedef ^ FAST_ExternInputType ReKi YawPosCom - - 2pi "yaw position command from Simulink/Labview" typedef ^ FAST_ExternInputType ReKi YawRateCom - - - "yaw rate command from Simulink/Labview" -typedef ^ FAST_ExternInputType ReKi BlPitchCom 3 - - "blade pitch commands from Simulink/Labview" "rad/s" +typedef ^ FAST_ExternInputType ReKi BlPitchCom 3 - 2pi "blade pitch commands from Simulink/Labview" "rad" typedef ^ FAST_ExternInputType ReKi HSSBrFrac - - - "Fraction of full braking torque: 0 (off) <= HSSBrFrac <= 1 (full) from Simulink or LabVIEW" typedef ^ FAST_ExternInputType ReKi LidarFocus 3 - - "lidar focus (relative to lidar location)" m @@ -590,7 +637,7 @@ typedef ^ FAST_MiscVarType INTEGER SimStrtTime {8} - - "Start time of simulation #typedef ^ FAST_MiscVarType IntKi n_t_global - - - "simulation time step, loop counter for global (FAST) simulation" (s) 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 INTEGER NextLinTimeIndx - - - "index for next time in LinTimes where linearization should occur" - +typedef ^ FAST_MiscVarType FAST_MiscLinType Lin - - - "misc data for linearization analysis" - # ..... FAST External Initialization Input data ....................................................................................................... typedef ^ FAST_ExternInitType DbKi Tmax - -1 - "External code specified Tmax" s diff --git a/modules/openfast-library/src/FAST_Solver.f90 b/modules/openfast-library/src/FAST_Solver.f90 index 37af8fccd3..46249f2d64 100644 --- a/modules/openfast-library/src/FAST_Solver.f90 +++ b/modules/openfast-library/src/FAST_Solver.f90 @@ -52,19 +52,26 @@ MODULE FAST_Solver !---------------------------------------------------------------------------------------------------------------------------------- !> This routine sets the inputs required for BD--using the Option 2 solve method; currently the only inputs solved in this routine !! are the blade distributed loads from AD15; other inputs are solved in option 1. -SUBROUTINE BD_InputSolve( p_FAST, BD, y_AD, u_AD, MeshMapData, ErrStat, ErrMsg ) +SUBROUTINE BD_InputSolve( p_FAST, BD, y_AD, u_AD, y_ED, MeshMapData, 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(ED_OutputType), INTENT(IN ) :: y_ED !< ElastoDyn outputs 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 + REAL(R8Ki) :: omega_c(3) ! variable for adding damping + REAL(R8Ki) :: r(3) ! variable for adding damping + REAL(R8Ki) :: r_hub(3) ! variable for adding damping + REAL(R8Ki) :: Vrot(3) ! variable for adding damping + + INTEGER(IntKi) :: J ! Loops through blade nodes 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 @@ -115,7 +122,37 @@ SUBROUTINE BD_InputSolve( p_FAST, BD, y_AD, u_AD, MeshMapData, ErrStat, ErrMsg ) END IF - + ! add damping in blades for linearization convergence + if (p_FAST%CalcSteady) then + + ! note that this assumes sibling meshes for input and output + + omega_c = y_ED%RotSpeed * y_ED%HubPtMotion%Orientation(1,:,1) + r_hub = y_ED%HubPtMotion%Position(:,1) + y_ED%HubPtMotion%TranslationDisp(:,1) + + if (p_FAST%BD_OutputSibling) then + + do k = 1,p_FAST%nBeams ! Loop through all blades + do j = 1,BD%Input(1,k)%DistrLoad%NNodes + r = BD%y(k)%BldMotion%Position(:,j) + BD%y(k)%BldMotion%TranslationDisp(:,j) - r_hub + Vrot = cross_product(omega_c, r) + BD%Input(1,k)%DistrLoad%Force(:,j) = BD%Input(1,k)%DistrLoad%Force(:,j) - p_FAST%Bld_Kdmp * ( BD%y(k)%BldMotion%TranslationVel(:,j) - Vrot ) + end do + end do + + else + + do k = 1,p_FAST%nBeams ! Loop through all blades + do j = 1,BD%Input(1,k)%DistrLoad%NNodes + r = MeshMapData%y_BD_BldMotion_4Loads(k)%Position(:,j) + MeshMapData%y_BD_BldMotion_4Loads(k)%TranslationDisp(:,j) - r_hub + Vrot = cross_product(omega_c, r) + BD%Input(1,k)%DistrLoad%Force(:,j) = BD%Input(1,k)%DistrLoad%Force(:,j) - p_FAST%Bld_Kdmp * ( MeshMapData%y_BD_BldMotion_4Loads(k)%TranslationVel(:,j) - Vrot ) + end do + end do + + end if + + end if END SUBROUTINE BD_InputSolve !---------------------------------------------------------------------------------------------------------------------------------- @@ -139,6 +176,11 @@ SUBROUTINE ED_InputSolve( p_FAST, u_ED, y_ED, p_AD14, y_AD14, y_AD, y_SrvD, u_AD CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message ! local variables + REAL(R8Ki) :: omega_c(3) ! variable for adding damping + REAL(R8Ki) :: r(3) ! variable for adding damping + REAL(R8Ki) :: r_hub(3) ! variable for adding damping + REAL(R8Ki) :: Vrot(3) ! variable for adding damping + INTEGER(IntKi) :: J ! Loops through nodes / elements INTEGER(IntKi) :: K ! Loops through blades INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation @@ -261,6 +303,30 @@ SUBROUTINE ED_InputSolve( p_FAST, u_ED, y_ED, p_AD14, y_AD14, y_AD, y_SrvD, u_AD u_ED%TwrAddedMass = 0.0_ReKi u_ED%PtfmAddedMass = 0.0_ReKi + + ! add damping in blades and tower for linearization convergence + if (p_FAST%CalcSteady) then + + ! note that this assumes sibling meshes for input and output (the ED bladeLn2Mesh has the same first same first BladePtLoads%NNodes nodes as BladePtLoads, so this is okay) + do j = 1,u_ED%TowerPtLoads%NNodes ! u_ED%TowerPtLoads%NNodes is two less than y_ED%TowerLn2Mesh%NNodes + u_ED%TowerPtLoads%Force(:,j) = u_ED%TowerPtLoads%Force(:,j) - p_FAST%Twr_Kdmp * y_ED%TowerLn2Mesh%TranslationVel(:,j) + end do + + IF (p_FAST%CompElast == Module_ED) THEN + omega_c = y_ED%RotSpeed * y_ED%HubPtMotion%Orientation(1,:,1) + r_hub = y_ED%HubPtMotion%Position(:,1) + y_ED%HubPtMotion%TranslationDisp(:,1) + + do k=1,SIZE(u_ED%BladePtLoads,1) + do j = 1,u_ED%BladePtLoads(k)%NNodes + r = y_ED%BladeLn2Mesh(k)%Position(:,j) + y_ED%BladeLn2Mesh(k)%TranslationDisp(:,j) - r_hub + Vrot = cross_product(omega_c, r) + u_ED%BladePtLoads(k)%Force(:,j) = u_ED%BladePtLoads(k)%Force(:,j) - p_FAST%Bld_Kdmp * ( y_ED%BladeLn2Mesh(k)%TranslationVel(:,j) - Vrot ) + end do + end do + END IF + + end if + END SUBROUTINE ED_InputSolve !---------------------------------------------------------------------------------------------------------------------------------- !> This routine determines the points in space where InflowWind needs to compute wind speeds. @@ -270,7 +336,7 @@ SUBROUTINE IfW_InputSolve( p_FAST, m_FAST, u_IfW, p_IfW, u_AD14, u_AD, y_ED, Err TYPE(InflowWind_ParameterType), INTENT(IN ) :: p_IfW !< The parameters to InflowWind TYPE(AD14_InputType), INTENT(IN) :: u_AD14 !< The input meshes (already calculated) from AeroDyn14 TYPE(AD_InputType), INTENT(IN) :: u_AD !< The input meshes (already calculated) from AeroDyn - TYPE(ED_OutputType), INTENT(IN) :: y_ED !< The outputs of the structural dynamics module + TYPE(ED_OutputType), INTENT(IN) :: y_ED !< The outputs of the structural dynamics module (for IfW Lidar) TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< FAST parameter data TYPE(FAST_MiscVarType), INTENT(IN ) :: m_FAST !< misc FAST data, including inputs from external codes like Simulink @@ -344,7 +410,6 @@ SUBROUTINE IfW_SetExternalInputs( p_IfW, m_FAST, y_ED, u_IfW ) TYPE(ED_OutputType), INTENT(IN) :: y_ED !< The outputs of the structural dynamics module TYPE(InflowWind_InputType), INTENT(INOUT) :: u_IfW !< InflowWind Inputs at t - ! local variables ! bjj: this is a total hack to get the lidar inputs into InflowWind. We should use a mesh to take care of this messiness (and, really this Lidar Focus should come ! from Fortran (a scanning pattern or file-lookup inside InflowWind), not MATLAB. @@ -728,14 +793,9 @@ SUBROUTINE SrvD_InputSolve( p_FAST, m_FAST, u_SrvD, y_ED, y_IfW, y_OpFM, y_BD, M ErrStat = ErrID_None ErrMsg = "" - ! ServoDyn inputs from combination of InflowWind and ElastoDyn - - u_SrvD%YawAngle = y_ED%YawAngle !nacelle yaw plus platform yaw - - ! Calculate horizontal hub-height wind direction and the nacelle yaw error estimate (both positive about zi-axis); these are + ! Calculate horizontal hub-height wind direction (positive about zi-axis); these are ! zero if there is no wind input when InflowWind is not used: - - !bjj: rename pass YawAngle (not YawErr from ED) + IF ( p_FAST%CompInflow == Module_IfW ) THEN u_SrvD%WindDir = ATAN2( y_IfW%VelocityUVW(2,1), y_IfW%VelocityUVW(1,1) ) @@ -751,16 +811,23 @@ SUBROUTINE SrvD_InputSolve( p_FAST, m_FAST, u_SrvD, y_ED, y_IfW, y_OpFM, y_BD, M if ( allocated(u_SrvD%SuperController) ) then u_SrvD%SuperController = y_OpFM%SuperController end if - - + ELSE ! No wind inflow u_SrvD%WindDir = 0.0 - u_SrvD%YawErr = 0.0 u_SrvD%HorWindV = 0.0 ENDIF + + + + ! ServoDyn inputs from combination of InflowWind and ElastoDyn + + u_SrvD%YawAngle = y_ED%YawAngle !nacelle yaw plus platform yaw + u_SrvD%YawErr = u_SrvD%WindDir - u_SrvD%YawAngle ! the nacelle yaw error estimate (positive about zi-axis) + + ! ServoDyn inputs from ElastoDyn u_SrvD%Yaw = y_ED%Yaw !nacelle yaw u_SrvD%YawRate = y_ED%YawRate @@ -778,8 +845,8 @@ SUBROUTINE SrvD_InputSolve( p_FAST, m_FAST, u_SrvD, y_ED, y_IfW, y_OpFM, y_BD, M end do ELSE - u_SrvD%RootMxc = y_ED%RootMxc - u_SrvD%RootMyc = y_ED%RootMyc + u_SrvD%RootMxc = y_ED%RootMxc ! fixed-size arrays: always size 3 + u_SrvD%RootMyc = y_ED%RootMyc ! fixed-size arrays: always size 3 END IF @@ -893,10 +960,10 @@ SUBROUTINE Transfer_SD_to_HD( y_SD, u_HD_M_LumpedMesh, u_HD_M_DistribMesh, MeshM END SUBROUTINE Transfer_SD_to_HD !---------------------------------------------------------------------------------------------------------------------------------- -!> This routine transfers the ED outputs into inputs required for HD -SUBROUTINE Transfer_ED_to_HD( y_ED, u_HD, MeshMapData, ErrStat, ErrMsg ) +!> This routine transfers the platform motion output of the structural module (ED) into inputs required for HD +SUBROUTINE Transfer_PlatformMotion_to_HD( PlatformMotion, u_HD, MeshMapData, ErrStat, ErrMsg ) !.................................................................................................................................. - TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< The outputs of the structural dynamics module + TYPE(MeshType), INTENT(IN ) :: PlatformMotion !< The platform motion outputs of the structural dynamics module TYPE(HydroDyn_InputType), INTENT(INOUT) :: u_HD !< HydroDyn input TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< data for mapping meshes between modules @@ -906,6 +973,7 @@ SUBROUTINE Transfer_ED_to_HD( y_ED, u_HD, MeshMapData, ErrStat, ErrMsg ) ! local variables INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None + CHARACTER(*), PARAMETER :: RoutineName = 'Transfer_PlatformMotion_to_HD' ErrStat = ErrID_None @@ -919,8 +987,8 @@ SUBROUTINE Transfer_ED_to_HD( y_ED, u_HD, MeshMapData, ErrStat, ErrMsg ) ! wave kinematics, additional preload, additional stiffness, additional linear damping, additional quadratic damping, ! hydrodynamic added mass - CALL Transfer_Point_to_Point( y_ED%PlatformPtMesh, u_HD%Mesh, MeshMapData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg,'Transfer_ED_to_HD (u_HD%Mesh)' ) + CALL Transfer_Point_to_Point( PlatformMotion, u_HD%Mesh, MeshMapData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg, RoutineName//' (u_HD%Mesh)' ) END IF !WAMIT @@ -928,20 +996,20 @@ SUBROUTINE Transfer_ED_to_HD( y_ED, u_HD, MeshMapData, ErrStat, ErrMsg ) IF ( u_HD%Morison%LumpedMesh%Committed ) THEN ! 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 - CALL Transfer_Point_to_Point( y_ED%PlatformPtMesh, u_HD%Morison%LumpedMesh, MeshMapData%ED_P_2_HD_M_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg,'Transfer_ED_to_HD (u_HD%Morison%LumpedMesh)' ) + CALL Transfer_Point_to_Point( PlatformMotion, u_HD%Morison%LumpedMesh, MeshMapData%ED_P_2_HD_M_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg, RoutineName//' (u_HD%Morison%LumpedMesh)' ) END IF IF ( u_HD%Morison%DistribMesh%Committed ) THEN ! These are the motions for the line2 (distributed) loads associated viscous drag on the WAMIT body and/or filled/flooded distributed forces of the WAMIT body - CALL Transfer_Point_to_Line2( y_ED%PlatformPtMesh, u_HD%Morison%DistribMesh, MeshMapData%ED_P_2_HD_M_L, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg,'Transfer_ED_to_HD (u_HD%Morison%DistribMesh)' ) + CALL Transfer_Point_to_Line2( PlatformMotion, u_HD%Morison%DistribMesh, MeshMapData%ED_P_2_HD_M_L, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg, RoutineName//' (u_HD%Morison%DistribMesh)' ) END IF -END SUBROUTINE Transfer_ED_to_HD +END SUBROUTINE Transfer_PlatformMotion_to_HD !---------------------------------------------------------------------------------------------------------------------------------- !> This routine transfers the ED outputs into inputs required for HD, SD, ExtPtfm, BD, MAP, and/or FEAM SUBROUTINE Transfer_ED_to_HD_SD_BD_Mooring( p_FAST, y_ED, u_HD, u_SD, u_ExtPtfm, u_MAP, u_FEAM, u_MD, u_Orca, u_BD, MeshMapData, ErrStat, ErrMsg ) @@ -986,7 +1054,7 @@ SUBROUTINE Transfer_ED_to_HD_SD_BD_Mooring( p_FAST, y_ED, u_HD, u_SD, u_ExtPtfm, ELSEIF ( p_FAST%CompHydro == Module_HD ) THEN ! Map ED outputs to HD inputs: - CALL Transfer_ED_to_HD( y_ED, u_HD, MeshMapData, ErrStat2, ErrMsg2 ) + CALL Transfer_PlatformMotion_to_HD( y_ED%PlatformPtMesh, u_HD, MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg,RoutineName ) END IF @@ -1299,7 +1367,7 @@ SUBROUTINE ED_HD_InputOutputSolve( this_time, p_FAST, calcJacobian & , u_ED, p_ED, x_ED, xd_ED, z_ED, OtherSt_ED, y_ED, m_ED & , u_HD, p_HD, x_HD, xd_HD, z_HD, OtherSt_HD, y_HD, m_HD & , u_MAP, y_MAP, u_FEAM, y_FEAM, u_MD, y_MD & - , MeshMapData , ErrStat, ErrMsg ) + , MeshMapData , ErrStat, ErrMsg, WriteThisStep ) !.................................................................................................................................. USE ElastoDyn @@ -1342,6 +1410,7 @@ SUBROUTINE ED_HD_InputOutputSolve( this_time, p_FAST, calcJacobian & 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 + LOGICAL , INTENT(IN ) :: WriteThisStep !< Will we print the WriteOutput values this step? ! Local variables: INTEGER, PARAMETER :: NumInputs = SizeJac_ED_HD !12 @@ -1376,6 +1445,7 @@ SUBROUTINE ED_HD_InputOutputSolve( this_time, p_FAST, calcJacobian & #ifdef OUTPUT_JACOBIAN INTEGER :: UnJac #endif + 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... @@ -1398,12 +1468,12 @@ SUBROUTINE ED_HD_InputOutputSolve( this_time, p_FAST, calcJacobian & ! Local copies for perturbing inputs and outputs (computing Jacobian): IF ( calcJacobian ) THEN CALL ED_CopyInput( u_ED, u_ED_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyOutput( y_ED, y_ED_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyOutput( y_ED, y_ED_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyInput( u_HD, u_HD_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) + CALL HydroDyn_CopyInput( u_HD, u_HD_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyOutput( y_HD, y_HD_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) + CALL HydroDyn_CopyOutput( y_HD, y_HD_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF @@ -1418,14 +1488,14 @@ SUBROUTINE ED_HD_InputOutputSolve( this_time, p_FAST, calcJacobian & ! make hydrodyn inputs consistant with elastodyn outputs ! (do this because we're using outputs in the u vector): - CALL Transfer_ED_to_HD(y_ED_input, u_HD, MeshMapData, ErrStat2, ErrMsg2 ) ! get u_HD from y_ED_input - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL Transfer_PlatformMotion_to_HD(y_ED_input%PlatformPtMesh, u_HD, MeshMapData, ErrStat2, ErrMsg2 ) ! get u_HD from y_ED_input + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - u( 1: 3) = u_ED%PlatformPtMesh%Force(:,1) / p_FAST%UJacSclFact - u( 4: 6) = u_ED%PlatformPtMesh%Moment(:,1) / p_FAST%UJacSclFact - u( 7: 9) = y_ED_input%PlatformPtMesh%TranslationAcc(:,1) - u(10:12) = y_ED_input%PlatformPtMesh%RotationAcc(:,1) + u( 1: 3) = u_ED%PlatformPtMesh%Force(:,1) / p_FAST%UJacSclFact + u( 4: 6) = u_ED%PlatformPtMesh%Moment(:,1) / p_FAST%UJacSclFact + u( 7: 9) = y_ED_input%PlatformPtMesh%TranslationAcc(:,1) + u(10:12) = y_ED_input%PlatformPtMesh%RotationAcc(:,1) K = 0 @@ -1435,8 +1505,8 @@ SUBROUTINE ED_HD_InputOutputSolve( this_time, p_FAST, calcJacobian & ! Calculate outputs at this_time, based on inputs at this_time !------------------------------------------------------------------------------------------------- - CALL ED_CalcOutput( this_time, u_ED, p_ED, x_ED, xd_ED, z_ED, OtherSt_ED, y_ED, m_ED, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CalcOutput( this_time, u_ED, p_ED, x_ED, xd_ED, z_ED, OtherSt_ED, y_ED, m_ED, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL HydroDyn_CalcOutput( this_time, u_HD, p_HD, x_HD, xd_HD, z_HD, OtherSt_HD, y_HD, m_HD, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -1492,7 +1562,7 @@ SUBROUTINE ED_HD_InputOutputSolve( this_time, p_FAST, calcJacobian & !............................... ! Get HydroDyn's contribution: - !............................... + !............................... DO i=7,12 !call HD_CalcOutput ! we want to perturb u_HD, but we're going to perturb the input y_ED and transfer that to HD to get u_HD @@ -1500,7 +1570,7 @@ SUBROUTINE ED_HD_InputOutputSolve( this_time, p_FAST, calcJacobian & CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) u_perturb = u CALL Perturb_u( i, u_perturb, y_ED_perturb=y_ED_perturb, perturb=ThisPerturb ) ! perturb u and y_ED by ThisPerturb [routine sets ThisPerturb] - CALL Transfer_ED_to_HD( y_ED_perturb, u_HD_perturb, MeshMapData, ErrStat2, ErrMsg2 ) ! get u_HD_perturb + CALL Transfer_PlatformMotion_to_HD( y_ED_perturb%PlatformPtMesh, u_HD_perturb, MeshMapData, ErrStat2, ErrMsg2 ) ! get u_HD_perturb CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! calculate outputs with perturbed inputs: @@ -1517,7 +1587,7 @@ SUBROUTINE ED_HD_InputOutputSolve( this_time, p_FAST, calcJacobian & MeshMapData%Jacobian_Opt1(:,i) = (Fn_U_perturb - Fn_U_Resid) / ThisPerturb END DO ! HydroDyn contribution ( columns 7-12 ) - + #ifdef OUTPUT_ADDEDMASS UnAM = -1 CALL GetNewUnit( UnAM, ErrStat, ErrMsg ) @@ -1602,10 +1672,9 @@ SUBROUTINE ED_HD_InputOutputSolve( this_time, p_FAST, calcJacobian & y_ED_input%PlatformPtMesh%TranslationAcc(:,1) = y_ED_input%PlatformPtMesh%TranslationAcc(:,1) + u_delta( 7: 9) y_ED_input%PlatformPtMesh%RotationAcc( :,1) = y_ED_input%PlatformPtMesh%RotationAcc( :,1) + u_delta(10:12) - CALL Transfer_ED_to_HD( y_ED_input, u_HD, MeshMapData, ErrStat2, ErrMsg2 ) ! get u_HD with u_delta changes + CALL Transfer_PlatformMotion_to_HD( y_ED_input%PlatformPtMesh, u_HD, MeshMapData, ErrStat2, ErrMsg2 ) ! get u_HD with u_delta changes CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - K = K + 1 END DO ! K @@ -1655,14 +1724,15 @@ END SUBROUTINE Perturb_u SUBROUTINE U_ED_HD_Residual( y_ED2, y_HD2, u_IN, U_Resid) !............................................................................................................................... - TYPE(ED_OutputType) , INTENT(IN ) :: y_ED2 ! System outputs + TYPE(ED_OutputType), TARGET , INTENT(IN ) :: y_ED2 ! System outputs TYPE(HydroDyn_OutputType) , INTENT(IN ) :: y_HD2 ! System outputs REAL(ReKi) , INTENT(IN ) :: u_in(NumInputs) REAL(ReKi) , INTENT( OUT) :: U_Resid(NumInputs) - - + TYPE(MeshType), POINTER :: PlatformMotions + PlatformMotions => y_ED2%PlatformPtMesh + ! ! Transfer motions: !.................. @@ -1673,46 +1743,45 @@ SUBROUTINE U_ED_HD_Residual( y_ED2, y_HD2, u_IN, U_Resid) ! note: MAP_InputSolve must be called before setting ED loads inputs (so that motions are known for loads [moment] mapping) CALL MAP_InputSolve( u_map, y_ED2, MeshMapData, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Transfer_Point_to_Point( y_MAP%PtFairleadLoad, MeshMapData%u_ED_PlatformPtMesh_2, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, u_MAP%PtFairDisplacement, y_ED2%PlatformPtMesh ) !u_MAP and y_ED contain the displacements needed for moment calculations - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL Transfer_Point_to_Point( y_MAP%PtFairleadLoad, MeshMapData%u_ED_PlatformPtMesh_2, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, u_MAP%PtFairDisplacement, PlatformMotions ) !u_MAP and y_ED contain the displacements needed for moment calculations + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN ! note: MD_InputSolve must be called before setting ED loads inputs (so that motions are known for loads [moment] mapping) CALL MD_InputSolve( u_MD, y_ED2, MeshMapData, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Transfer_Point_to_Point( y_MD%PtFairleadLoad, MeshMapData%u_ED_PlatformPtMesh_2, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, u_MD%PtFairleadDisplacement, y_ED2%PlatformPtMesh ) !u_MD and y_ED contain the displacements needed for moment calculations - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL Transfer_Point_to_Point( y_MD%PtFairleadLoad, MeshMapData%u_ED_PlatformPtMesh_2, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, u_MD%PtFairleadDisplacement, PlatformMotions ) !u_MD and y_ED contain the displacements needed for moment calculations + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN ! note: FEAM_InputSolve must be called before setting ED loads inputs (so that motions are known for loads [moment] mapping) CALL FEAM_InputSolve( u_FEAM, y_ED2, MeshMapData, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Transfer_Point_to_Point( y_FEAM%PtFairleadLoad, MeshMapData%u_ED_PlatformPtMesh_2, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, u_FEAM%PtFairleadDisplacement, y_ED2%PlatformPtMesh ) !u_FEAM and y_ED contain the displacements needed for moment calculations - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL Transfer_Point_to_Point( y_FEAM%PtFairleadLoad, MeshMapData%u_ED_PlatformPtMesh_2, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, u_FEAM%PtFairleadDisplacement, PlatformMotions ) !u_FEAM and y_ED contain the displacements needed for moment calculations + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSE MeshMapData%u_ED_PlatformPtMesh_2%Force = 0.0_ReKi MeshMapData%u_ED_PlatformPtMesh_2%Moment = 0.0_ReKi - END IF + END IF ! we use copies of the input meshes (we don't need to update values in the original data structures): !bjj: why don't we update u_HD2 here? shouldn't we update before using it to transfer the loads? - CALL Transfer_Point_to_Point( y_ED2%PlatformPtMesh, MeshMapData%u_HD_Mesh, MeshMapData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - + CALL Transfer_Point_to_Point( PlatformMotions, MeshMapData%u_HD_Mesh, MeshMapData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! we're mapping loads, so we also need the sibling meshes' displacements: - CALL Transfer_Point_to_Point( y_HD2%AllHdroOrigin, MeshMapData%u_ED_PlatformPtMesh, MeshMapData%HD_W_P_2_ED_P, ErrStat2, ErrMsg2, MeshMapData%u_HD_Mesh, y_ED2%PlatformPtMesh) !u_HD and u_mapped_positions contain the displaced positions for load calculations + CALL Transfer_Point_to_Point( y_HD2%AllHdroOrigin, MeshMapData%u_ED_PlatformPtMesh, MeshMapData%HD_W_P_2_ED_P, ErrStat2, ErrMsg2, MeshMapData%u_HD_Mesh, PlatformMotions) !u_HD and u_mapped_positions contain the displaced positions for load calculations CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) MeshMapData%u_ED_PlatformPtMesh%Force = MeshMapData%u_ED_PlatformPtMesh%Force + MeshMapData%u_ED_PlatformPtMesh_2%Force @@ -1720,10 +1789,12 @@ SUBROUTINE U_ED_HD_Residual( y_ED2, y_HD2, u_IN, U_Resid) U_Resid( 1: 3) = u_in( 1: 3) - MeshMapData%u_ED_PlatformPtMesh%Force(:,1) / p_FAST%UJacSclFact - U_Resid( 4: 6) = u_in( 4: 6) - MeshMapData%u_ED_PlatformPtMesh%Moment(:,1) / p_FAST%UJacSclFact - U_Resid( 7: 9) = u_in( 7: 9) - y_ED2%PlatformPtMesh%TranslationAcc(:,1) - U_Resid(10:12) = u_in(10:12) - y_ED2%PlatformPtMesh%RotationAcc(:,1) - + U_Resid( 4: 6) = u_in( 4: 6) - MeshMapData%u_ED_PlatformPtMesh%Moment(:,1) / p_FAST%UJacSclFact + + U_Resid( 7: 9) = u_in( 7: 9) - PlatformMotions%TranslationAcc(:,1) + U_Resid(10:12) = u_in(10:12) - PlatformMotions%RotationAcc(:,1) + + PlatformMotions => NULL() END SUBROUTINE U_ED_HD_Residual !............................................................................................................................... @@ -1766,7 +1837,7 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & , u_MD, y_MD & , u_IceF, y_IceF & , u_IceD, y_IceD & - , MeshMapData , ErrStat, ErrMsg ) + , MeshMapData , ErrStat, ErrMsg, WriteThisStep ) !.................................................................................................................................. USE ElastoDyn @@ -1788,7 +1859,7 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & TYPE(ED_OtherStateType) , INTENT(IN ) :: OtherSt_ED !< Other states TYPE(ED_ParameterType) , INTENT(IN ) :: p_ED !< Parameters TYPE(ED_InputType) , INTENT(INOUT) :: u_ED !< System inputs - TYPE(ED_OutputType) , INTENT(INOUT) :: y_ED !< System outputs + TYPE(ED_OutputType), TARGET , INTENT(INOUT) :: y_ED !< System outputs TYPE(ED_MiscVarType) , INTENT(INOUT) :: m_ED !< misc/optimization variables !BeamDyn (one instance per blade): @@ -1857,6 +1928,7 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & 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 + LOGICAL , INTENT(IN ) :: WriteThisStep !< Will we print the WriteOutput values this step? ! Local variables: REAL(ReKi), PARAMETER :: TOL_Squared = (1.0E-4)**2 !not currently used because KMax = 1 @@ -1891,6 +1963,8 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None + TYPE(MeshType), POINTER :: PlatformMotionMesh + #ifdef OUTPUT_ADDEDMASS REAL(ReKi) :: AddedMassMatrix(6,6) INTEGER :: UnAM @@ -1901,7 +1975,8 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & INTEGER :: TmpIndx #endif - + 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 @@ -1993,6 +2068,7 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & !------------------------------------------------------------------------------------------------- ! Calculate outputs at this_time, based on inputs at this_time !------------------------------------------------------------------------------------------------- + GetWriteOutput = WriteThisStep .and. K >= p_FAST%KMax ! we need this only on the last call to BD CALL ED_CalcOutput( this_time, u_ED, p_ED, x_ED, xd_ED, z_ED, OtherSt_ED, y_ED, m_ED, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -2011,9 +2087,9 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF - IF ( p_FAST%CompElast == Module_BD .and. BD_Solve_Option1) THEN + IF ( p_FAST%CompElast == Module_BD .and. BD_Solve_Option1) THEN do nb=1,p_FAST%nBeams - CALL BD_CalcOutput( this_time, u_BD(nb), p_BD(nb), x_BD(nb), xd_BD(nb), z_BD(nb), OtherSt_BD(nb), y_BD(nb), m_BD(nb), ErrStat2, ErrMsg2 ) + CALL BD_CalcOutput( this_time, u_BD(nb), p_BD(nb), x_BD(nb), xd_BD(nb), z_BD(nb), OtherSt_BD(nb), y_BD(nb), m_BD(nb), ErrStat2, ErrMsg2, GetWriteOutput ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) end do END IF @@ -2045,12 +2121,14 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & END IF IF ( calcJacobian ) THEN + i = 0 !............................... ! Get ElastoDyn's contribution: !............................... - DO i=1,p_FAST%SizeJac_Opt1(2) !call ED_CalcOutput - + DO j=1,p_FAST%SizeJac_Opt1(2) !call ED_CalcOutput + i = i + 1 + ! perturb u_ED: CALL ED_CopyInput( u_ED, u_ED_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -2074,7 +2152,6 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & END DO ! ElastoDyn contribution ( columns 1-p_FAST%SizeJac_Opt1(2) ) - i = p_FAST%SizeJac_Opt1(2) !............................... ! Get SubDyn's contribution: (note if p_FAST%CompSub /= Module_SD, SizeJac_Opt1(3) = 0) !............................... @@ -2157,7 +2234,7 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & CALL Perturb_u_FullOpt1( p_FAST, MeshMapData%Jac_u_indx, i, u_perturb, u_BD_perturb=u_BD_perturb, perturb=ThisPerturb ) ! perturb u and u_HD by ThisPerturb [routine sets ThisPerturb] ! calculate outputs with perturbed inputs: - CALL BD_CalcOutput( this_time, u_BD_perturb, p_BD(nb), x_BD(nb), xd_BD(nb), z_BD(nb), OtherSt_BD(nb), y_BD_perturb(nb), m_BD(nb), ErrStat2, ErrMsg2 ) + CALL BD_CalcOutput( this_time, u_BD_perturb, p_BD(nb), x_BD(nb), xd_BD(nb), z_BD(nb), OtherSt_BD(nb), y_BD_perturb(nb), m_BD(nb), ErrStat2, ErrMsg2, .false. ) ! We don't use the WriteOutput when computing the Jacobian CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL U_FullOpt1_Residual(y_ED, y_SD, y_HD, y_BD_perturb, y_Orca, y_ExtPtfm, u_perturb, Fn_U_perturb) ! get this perturbation @@ -2175,7 +2252,7 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & !............................... ! Get OrcaFlex's contribution: (note if p_FAST%CompMooring /= Module_Orca, SizeJac_Opt1(8) = 0) - !............................... + !............................... DO j=1,p_FAST%SizeJac_Opt1(8) !call Orca_CalcOutput i = i + 1 @@ -2409,6 +2486,9 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & ! This is effectively doing option 2, where we set the input velocities and displacements based on the outputs we just calculated !............................................... + PlatformMotionMesh => y_ED%PlatformPtMesh + + ! BD motion inputs: (from ED) IF (p_FAST%CompElast == Module_BD .and. BD_Solve_Option1) THEN @@ -2458,12 +2538,12 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & ! Map ED outputs to HD inputs (keeping the accelerations we just calculated): - CALL Transfer_Point_to_Point( y_ED%PlatformPtMesh, u_HD%Mesh, MeshMapData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2 ) + CALL Transfer_Point_to_Point( PlatformMotionMesh, u_HD%Mesh, MeshMapData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSE - CALL Transfer_ED_to_HD( y_ED, u_HD, MeshMapData, ErrStat2, ErrMsg2 ) + CALL Transfer_PlatformMotion_to_HD( PlatformMotionMesh, u_HD, MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF @@ -2496,7 +2576,7 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & MeshMapData%u_SD_TPMesh%RotationAcc = u_SD%TPMesh%RotationAcc MeshMapData%u_SD_TPMesh%TranslationAcc = u_SD%TPMesh%TranslationAcc - CALL Transfer_Point_to_Point( y_ED%PlatformPtMesh, u_SD%TPMesh, MeshMapData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) + CALL Transfer_Point_to_Point( PlatformMotionMesh, u_SD%TPMesh, MeshMapData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -2512,7 +2592,7 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & MeshMapData%u_ExtPtfm_PtfmMesh%RotationAcc = u_ExtPtfm%PtfmMesh%RotationAcc MeshMapData%u_ExtPtfm_PtfmMesh%TranslationAcc = u_ExtPtfm%PtfmMesh%TranslationAcc - CALL Transfer_Point_to_Point( y_ED%PlatformPtMesh, u_ExtPtfm%PtfmMesh, MeshMapData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) + CALL Transfer_Point_to_Point( PlatformMotionMesh, u_ExtPtfm%PtfmMesh, MeshMapData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) u_ExtPtfm%PtfmMesh%RotationAcc = MeshMapData%u_ExtPtfm_PtfmMesh%RotationAcc @@ -2529,7 +2609,7 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & MeshMapData%u_Orca_PtfmMesh%RotationAcc = u_Orca%PtfmMesh%RotationAcc MeshMapData%u_Orca_PtfmMesh%TranslationAcc = u_Orca%PtfmMesh%TranslationAcc - CALL Transfer_Point_to_Point( y_ED%PlatformPtMesh, u_Orca%PtfmMesh, MeshMapData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) + CALL Transfer_Point_to_Point( PlatformMotionMesh, u_Orca%PtfmMesh, MeshMapData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) u_Orca%PtfmMesh%RotationAcc = MeshMapData%u_Orca_PtfmMesh%RotationAcc @@ -2547,7 +2627,7 @@ SUBROUTINE U_FullOpt1_Residual( y_ED2, y_SD2, y_HD2, y_BD2, y_Orca2, y_ExtPtfm2, ! transfer outputs of ED, HD, SD, BD, and OrcaFlex (and any additional loads that get summed with them) into inputs for ED, HD, SD, BD, and OrcaFlex !............................................................................................................................... - TYPE(ED_OutputType) , INTENT(IN ) :: y_ED2 ! System outputs + TYPE(ED_OutputType), TARGET , INTENT(IN ) :: y_ED2 ! System outputs TYPE(SD_OutputType) , INTENT(IN ) :: y_SD2 ! System outputs TYPE(HydroDyn_OutputType) , INTENT(IN ) :: y_HD2 ! System outputs TYPE(BD_OutputType) , INTENT(IN ) :: y_BD2(:) ! System outputs @@ -2557,6 +2637,9 @@ SUBROUTINE U_FullOpt1_Residual( y_ED2, y_SD2, y_HD2, y_BD2, y_Orca2, y_ExtPtfm2, REAL(ReKi) , INTENT( OUT) :: U_Resid(:) INTEGER(IntKi) :: i ! counter for ice leg and beamdyn loops + TYPE(MeshType), POINTER :: PlatformMotions + + PlatformMotions => y_ED2%PlatformPtMesh !.................. ! Set mooring line and ice inputs (which don't have acceleration fields and aren't used elsewhere in this routine, thus we're using the actual inputs (not a copy) @@ -2585,7 +2668,7 @@ SUBROUTINE U_FullOpt1_Residual( y_ED2, y_SD2, y_HD2, y_BD2, y_Orca2, y_ExtPtfm2, ! Map ED motion output to Orca inputs: ! note: must be called before setting ED loads inputs (so that Orca motions are known for loads [moment] mapping) - CALL Transfer_Point_to_Point( y_ED2%PlatformPtMesh, MeshMapData%u_Orca_PtfmMesh, MeshMapData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) + CALL Transfer_Point_to_Point( PlatformMotions, MeshMapData%u_Orca_PtfmMesh, MeshMapData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) END IF @@ -2646,7 +2729,7 @@ SUBROUTINE U_FullOpt1_Residual( y_ED2, y_SD2, y_HD2, y_BD2, y_Orca2, y_ExtPtfm2, ! Map ED motion output to HD inputs: - CALL Transfer_Point_to_Point( y_ED2%PlatformPtMesh, MeshMapData%u_HD_Mesh, MeshMapData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2 ) + CALL Transfer_Point_to_Point( PlatformMotions, MeshMapData%u_HD_Mesh, MeshMapData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) !.................. @@ -2714,7 +2797,7 @@ SUBROUTINE U_FullOpt1_Residual( y_ED2, y_SD2, y_HD2, y_BD2, y_Orca2, y_ExtPtfm2, !.................. ! Motions (outputs) at ED platform ref point transfered to SD transition piece (input): - CALL Transfer_Point_to_Point( y_ED2%PlatformPtMesh, MeshMapData%u_SD_TPMesh, MeshMapData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) + CALL Transfer_Point_to_Point( PlatformMotions, MeshMapData%u_SD_TPMesh, MeshMapData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) !.................. @@ -2723,14 +2806,14 @@ SUBROUTINE U_FullOpt1_Residual( y_ED2, y_SD2, y_HD2, y_BD2, y_Orca2, y_ExtPtfm2, ! Loads (outputs) on the SD transition piece transfered to ED input location/mesh: ! we're mapping loads, so we also need the sibling meshes' displacements: - CALL Transfer_Point_to_Point( y_SD2%Y1Mesh, MeshMapData%u_ED_PlatformPtMesh, MeshMapData%SD_TP_2_ED_P, ErrStat2, ErrMsg2, MeshMapData%u_SD_TPMesh, y_ED2%PlatformPtMesh ) !MeshMapData%u_SD_TPMesh contains the orientations needed for moment calculations + CALL Transfer_Point_to_Point( y_SD2%Y1Mesh, MeshMapData%u_ED_PlatformPtMesh, MeshMapData%SD_TP_2_ED_P, ErrStat2, ErrMsg2, MeshMapData%u_SD_TPMesh, PlatformMotions ) !MeshMapData%u_SD_TPMesh contains the orientations needed for moment calculations CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) ! WAMIT loads from HD get added to this load: IF ( y_HD2%Mesh%Committed ) THEN ! we're mapping loads, so we also need the sibling meshes' displacements: - CALL Transfer_Point_to_Point( y_HD2%Mesh, MeshMapData%u_ED_PlatformPtMesh_2, MeshMapData%HD_W_P_2_ED_P, ErrStat2, ErrMsg2, MeshMapData%u_HD_Mesh, y_ED2%PlatformPtMesh ) !u_SD contains the orientations needed for moment calculations + CALL Transfer_Point_to_Point( y_HD2%Mesh, MeshMapData%u_ED_PlatformPtMesh_2, MeshMapData%HD_W_P_2_ED_P, ErrStat2, ErrMsg2, MeshMapData%u_HD_Mesh, PlatformMotions ) !u_SD contains the orientations needed for moment calculations CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) MeshMapData%u_ED_PlatformPtMesh%Force = MeshMapData%u_ED_PlatformPtMesh%Force + MeshMapData%u_ED_PlatformPtMesh_2%Force @@ -2745,7 +2828,7 @@ SUBROUTINE U_FullOpt1_Residual( y_ED2, y_SD2, y_HD2, y_BD2, y_Orca2, y_ExtPtfm2, !.................. ! Motions (outputs) at ED platform ref point transfered to ExtPtfm PtfmMesh (input): - CALL Transfer_Point_to_Point( y_ED2%PlatformPtMesh, MeshMapData%u_ExtPtfm_PtfmMesh, MeshMapData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) + CALL Transfer_Point_to_Point( PlatformMotions, MeshMapData%u_ExtPtfm_PtfmMesh, MeshMapData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) !.................. @@ -2754,8 +2837,8 @@ SUBROUTINE U_FullOpt1_Residual( y_ED2, y_SD2, y_HD2, y_BD2, y_Orca2, y_ExtPtfm2, ! Loads (outputs) on the ExtPtfm platform mesh transfered to ED input location/mesh: ! we're mapping loads, so we also need the sibling meshes' displacements: - CALL Transfer_Point_to_Point( y_ExtPtfm2%PtfmMesh, MeshMapData%u_ED_PlatformPtMesh, MeshMapData%SD_TP_2_ED_P, ErrStat2, ErrMsg2, MeshMapData%u_ExtPtfm_PtfmMesh, y_ED2%PlatformPtMesh ) - CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL Transfer_Point_to_Point( y_ExtPtfm2%PtfmMesh, MeshMapData%u_ED_PlatformPtMesh, MeshMapData%SD_TP_2_ED_P, ErrStat2, ErrMsg2, MeshMapData%u_ExtPtfm_PtfmMesh, PlatformMotions ) + CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) ELSE IF ( p_FAST%CompHydro == Module_HD ) THEN @@ -2764,24 +2847,24 @@ SUBROUTINE U_FullOpt1_Residual( y_ED2, y_SD2, y_HD2, y_BD2, y_Orca2, y_ExtPtfm2, !.................. ! Map ED motion outputs to HD inputs: - ! basically, we want to call Transfer_ED_to_HD, except we have the meshes in a different data structure (not a copy of u_HD) - ! CALL Transfer_ED_to_HD( y_ED2, u_HD, MeshMapData, ErrStat2, ErrMsg2 ) + ! basically, we want to call Transfer_PlatformMotion_to_HD, except we have the meshes in a different data structure (not a copy of u_HD) + ! CALL Transfer_PlatformMotion_to_HD( y_ED2%PlatformPtMesh, u_HD, MeshMapData, ErrStat2, ErrMsg2 ) ! so, here are the transfers, again. ! These are the motions for the lumped point loads associated the WAMIT body: - CALL Transfer_Point_to_Point( y_ED2%PlatformPtMesh, MeshMapData%u_HD_Mesh, MeshMapData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2 ) + CALL Transfer_Point_to_Point( PlatformMotions, MeshMapData%u_HD_Mesh, MeshMapData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) ! 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 (MeshMapData%u_HD_M_LumpedMesh%Committed) then - CALL Transfer_Point_to_Point( y_ED2%PlatformPtMesh, MeshMapData%u_HD_M_LumpedMesh, MeshMapData%ED_P_2_HD_M_P, ErrStat2, ErrMsg2 ) + CALL Transfer_Point_to_Point( PlatformMotions, MeshMapData%u_HD_M_LumpedMesh, MeshMapData%ED_P_2_HD_M_P, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) endif ! These are the motions for the line2 (distributed) loads associated viscous drag on the WAMIT body and/or filled/flooded distributed forces of the WAMIT body if (MeshMapData%u_HD_M_DistribMesh%Committed) then - CALL Transfer_Point_to_Line2( y_ED2%PlatformPtMesh, MeshMapData%u_HD_M_DistribMesh, MeshMapData%ED_P_2_HD_M_L, ErrStat2, ErrMsg2 ) + CALL Transfer_Point_to_Line2( PlatformMotions, MeshMapData%u_HD_M_DistribMesh, MeshMapData%ED_P_2_HD_M_L, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) endif @@ -2790,7 +2873,7 @@ SUBROUTINE U_FullOpt1_Residual( y_ED2, y_SD2, y_HD2, y_BD2, y_Orca2, y_ExtPtfm2, !.................. ! we're mapping loads, so we also need the sibling meshes' displacements: - CALL Transfer_Point_to_Point( y_HD2%AllHdroOrigin, MeshMapData%u_ED_PlatformPtMesh, MeshMapData%HD_W_P_2_ED_P, ErrStat2, ErrMsg2, MeshMapData%u_HD_Mesh, y_ED2%PlatformPtMesh) !u_HD and u_mapped_positions contain the displaced positions for load calculations + CALL Transfer_Point_to_Point( y_HD2%AllHdroOrigin, MeshMapData%u_ED_PlatformPtMesh, MeshMapData%HD_W_P_2_ED_P, ErrStat2, ErrMsg2, MeshMapData%u_HD_Mesh, PlatformMotions) !u_HD and u_mapped_positions contain the displaced positions for load calculations CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) ELSE @@ -2809,28 +2892,28 @@ SUBROUTINE U_FullOpt1_Residual( y_ED2, y_SD2, y_HD2, y_BD2, y_Orca2, y_ExtPtfm2, ! Get the loads for ED from a mooring module and add them: IF ( p_FAST%CompMooring == Module_MAP ) THEN - CALL Transfer_Point_to_Point( y_MAP%PtFairleadLoad, MeshMapData%u_ED_PlatformPtMesh_2, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, u_MAP%PtFairDisplacement, y_ED2%PlatformPtMesh ) !u_MAP and y_ED contain the displacements needed for moment calculations + CALL Transfer_Point_to_Point( y_MAP%PtFairleadLoad, MeshMapData%u_ED_PlatformPtMesh_2, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, u_MAP%PtFairDisplacement, PlatformMotions ) !u_MAP and y_ED contain the displacements needed for moment calculations CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) MeshMapData%u_ED_PlatformPtMesh%Force = MeshMapData%u_ED_PlatformPtMesh%Force + MeshMapData%u_ED_PlatformPtMesh_2%Force MeshMapData%u_ED_PlatformPtMesh%Moment = MeshMapData%u_ED_PlatformPtMesh%Moment + MeshMapData%u_ED_PlatformPtMesh_2%Moment ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN - CALL Transfer_Point_to_Point( y_MD%PtFairleadLoad, MeshMapData%u_ED_PlatformPtMesh_2, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, u_MD%PtFairleadDisplacement, y_ED2%PlatformPtMesh ) !u_MD and y_ED contain the displacements needed for moment calculations + CALL Transfer_Point_to_Point( y_MD%PtFairleadLoad, MeshMapData%u_ED_PlatformPtMesh_2, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, u_MD%PtFairleadDisplacement, PlatformMotions ) !u_MD and y_ED contain the displacements needed for moment calculations CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) MeshMapData%u_ED_PlatformPtMesh%Force = MeshMapData%u_ED_PlatformPtMesh%Force + MeshMapData%u_ED_PlatformPtMesh_2%Force MeshMapData%u_ED_PlatformPtMesh%Moment = MeshMapData%u_ED_PlatformPtMesh%Moment + MeshMapData%u_ED_PlatformPtMesh_2%Moment ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN - CALL Transfer_Point_to_Point( y_FEAM%PtFairleadLoad, MeshMapData%u_ED_PlatformPtMesh_2, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, u_FEAM%PtFairleadDisplacement, y_ED2%PlatformPtMesh ) !u_FEAM and y_ED contain the displacements needed for moment calculations + CALL Transfer_Point_to_Point( y_FEAM%PtFairleadLoad, MeshMapData%u_ED_PlatformPtMesh_2, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, u_FEAM%PtFairleadDisplacement, PlatformMotions ) !u_FEAM and y_ED contain the displacements needed for moment calculations CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) MeshMapData%u_ED_PlatformPtMesh%Force = MeshMapData%u_ED_PlatformPtMesh%Force + MeshMapData%u_ED_PlatformPtMesh_2%Force MeshMapData%u_ED_PlatformPtMesh%Moment = MeshMapData%u_ED_PlatformPtMesh%Moment + MeshMapData%u_ED_PlatformPtMesh_2%Moment ELSEIF ( p_FAST%CompMooring == Module_Orca ) THEN - CALL Transfer_Point_to_Point( y_Orca2%PtfmMesh, MeshMapData%u_ED_PlatformPtMesh_2, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, MeshMapData%u_Orca_PtfmMesh, y_ED2%PlatformPtMesh ) !u_Orca_PtfmMesh and y_ED contain the displacements needed for moment calculations + CALL Transfer_Point_to_Point( y_Orca2%PtfmMesh, MeshMapData%u_ED_PlatformPtMesh_2, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, MeshMapData%u_Orca_PtfmMesh, PlatformMotions ) !u_Orca_PtfmMesh and y_ED contain the displacements needed for moment calculations CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) MeshMapData%u_ED_PlatformPtMesh%Force = MeshMapData%u_ED_PlatformPtMesh%Force + MeshMapData%u_ED_PlatformPtMesh_2%Force @@ -2848,6 +2931,7 @@ SUBROUTINE U_FullOpt1_Residual( y_ED2, y_SD2, y_HD2, y_BD2, y_Orca2, y_ExtPtfm2, U_Resid = u_in - U_Resid + PlatformMotions => NULL() END SUBROUTINE U_FullOpt1_Residual !............................................................................................................................... @@ -2930,6 +3014,7 @@ SUBROUTINE Init_FullOpt1_Jacobian( p_FAST, MeshMapData, ED_PlatformPtMesh, SD_TP ErrMsg = "" ! determine how many inputs there are between the 6 modules (ED, SD, HD, BD, Orca, ExtPtfm) + p_FAST%SizeJac_Opt1 = 0 ! initialize whole array if (p_FAST%CompHydro == Module_HD .or. p_FAST%CompSub /= Module_None .or. p_FAST%CompMooring == Module_Orca) then p_FAST%SizeJac_Opt1(2) = ED_PlatformPtMesh%NNodes*6 ! ED inputs: 3 forces and 3 moments per node (only 1 node) @@ -2938,10 +3023,10 @@ SUBROUTINE Init_FullOpt1_Jacobian( p_FAST, MeshMapData, ED_PlatformPtMesh, SD_TP end if - p_FAST%SizeJac_Opt1(3) = SD_TPMesh%NNodes*6 ! SD inputs: 6 accelerations per node (size of SD input from ED) + p_FAST%SizeJac_Opt1(3) = SD_TPMesh%NNodes*6 ! SD inputs: 6 accelerations per node (size of SD input from ED) IF ( p_FAST%CompHydro == Module_HD ) THEN p_FAST%SizeJac_Opt1(3) = p_FAST%SizeJac_Opt1(3) & - + SD_LMesh%NNodes *6 ! SD inputs: 6 loads per node (size of SD input from HD) + + SD_LMesh%NNodes *6 ! SD inputs: 6 loads per node (size of SD input from HD) END IF p_FAST%SizeJac_Opt1(4) = HD_M_LumpedMesh%NNodes *6 & ! HD inputs: 6 accelerations per node (on each Morison mesh) @@ -2954,7 +3039,7 @@ SUBROUTINE Init_FullOpt1_Jacobian( p_FAST, MeshMapData, ED_PlatformPtMesh, SD_TP p_FAST%SizeJac_Opt1(5:7) = 0 ! assumes a max of 3 blades do k=1,size(u_BD) - p_FAST%SizeJac_Opt1(4+k) = u_BD(k)%RootMotion%NNodes *6 ! BD inputs: 6 accelerations per node (size of BD input from ED) + p_FAST%SizeJac_Opt1(4+k) = u_BD(k)%RootMotion%NNodes *6 ! BD inputs: 6 accelerations per node (size of BD input from ED) end do END IF @@ -3510,7 +3595,7 @@ SUBROUTINE Perturb_u_FullOpt1( p_FAST, Jac_u_indx, n, u_perturb, u_ED_perturb, u INTEGER( IntKi ) , INTENT(IN ) :: Jac_u_indx(:,:) !< Index to map Jacobian u-vector into mesh fields INTEGER( IntKi ) , INTENT(IN ) :: n !< number of array element to use REAL( ReKi ) , INTENT(INOUT) :: u_perturb(:) !< array to be perturbed - TYPE(ED_InputType), OPTIONAL , INTENT(INOUT) :: u_ED_perturb !< ED System inputs (needed only when 1 <= n <= NumEDNodes) + TYPE(ED_InputType), OPTIONAL , INTENT(INOUT) :: u_ED_perturb !< ED System inputs (needed only when 1 <= n <= NumEDNodes=max(NumEDNodes,NumMBDNodes)) TYPE(SD_InputType), OPTIONAL , INTENT(INOUT) :: u_SD_perturb !< SD System inputs (needed only when NumEDNodes +1 <= n <= NumEDNodes+NumSDNodes) [if SD is used] TYPE(HydroDyn_InputType), OPTIONAL , INTENT(INOUT) :: u_HD_perturb !< HD System inputs (needed only when NumEDNodes+NumSDNodes +1 <= n <= NumEDNodes+NumSDNodes+NumHDNodes) [if HD is used and SD is used. if SD not used, TYPE(BD_InputType), OPTIONAL , INTENT(INOUT) :: u_BD_perturb !< BD System inputs (needed only when NumEDNodes+NumSDNodes+NumHDNodes+1 <= n <= inf) [if BD is used] @@ -3646,23 +3731,23 @@ SUBROUTINE ResetRemapFlags(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, MAPp ! ElastoDyn meshes ED%Input( 1)%PlatformPtMesh%RemapFlag = .FALSE. - ED%Output(1)%PlatformPtMesh%RemapFlag = .FALSE. + ED%y%PlatformPtMesh%RemapFlag = .FALSE. ED%Input( 1)%TowerPtLoads%RemapFlag = .FALSE. - ED%Output(1)%TowerLn2Mesh%RemapFlag = .FALSE. - DO K=1,SIZE(ED%Output(1)%BladeRootMotion) - ED%Output(1)%BladeRootMotion(K)%RemapFlag = .FALSE. + ED%y%TowerLn2Mesh%RemapFlag = .FALSE. + DO K=1,SIZE(ED%y%BladeRootMotion) + ED%y%BladeRootMotion(K)%RemapFlag = .FALSE. END DO if (allocated(ED%Input(1)%BladePtLoads)) then DO K=1,SIZE(ED%Input(1)%BladePtLoads) ED%Input( 1)%BladePtLoads(K)%RemapFlag = .FALSE. - ED%Output(1)%BladeLn2Mesh(K)%RemapFlag = .FALSE. + ED%y%BladeLn2Mesh(K)%RemapFlag = .FALSE. END DO end if - ED%Input( 1)%NacelleLoads%RemapFlag = .FALSE. - ED%Output(1)%NacelleMotion%RemapFlag = .FALSE. - ED%Input( 1)%HubPtLoad%RemapFlag = .FALSE. - ED%Output(1)%HubPtMotion%RemapFlag = .FALSE. + ED%Input( 1)%NacelleLoads%RemapFlag = .FALSE. + ED%y%NacelleMotion%RemapFlag = .FALSE. + ED%Input( 1)%HubPtLoad%RemapFlag = .FALSE. + ED%y%HubPtMotion%RemapFlag = .FALSE. ! BeamDyn meshes IF ( p_FAST%CompElast == Module_BD ) THEN @@ -3796,40 +3881,46 @@ END SUBROUTINE ResetRemapFlags SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg) !............................................................................................................................... - TYPE(FAST_ParameterType), INTENT(INOUT) :: p_FAST !< Parameters for the glue code + TYPE(FAST_ParameterType), INTENT(INOUT) :: p_FAST !< Parameters for the glue code - TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data - TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data - TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data - TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data - TYPE(AeroDyn14_Data), INTENT(INOUT) :: AD14 !< AeroDyn14 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 !< 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 + TYPE(ElastoDyn_Data),TARGET,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(AeroDyn14_Data), INTENT(INOUT) :: AD14 !< AeroDyn14 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 !< 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 - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + 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), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - INTEGER :: K, i ! loop counters - INTEGER :: NumBl ! number of blades - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMSg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InitModuleMappings' + INTEGER :: K, i ! loop counters + INTEGER :: NumBl ! number of blades + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMSg2 + CHARACTER(*), PARAMETER :: RoutineName = 'InitModuleMappings' + + TYPE(MeshType), POINTER :: PlatformMotion + TYPE(MeshType), POINTER :: PlatformLoads !............................................................................................................................ ErrStat = ErrID_None ErrMsg = "" - NumBl = SIZE(ED%Output(1)%BladeRootMotion,1) + + NumBl = SIZE(ED%y%BladeRootMotion,1) + PlatformMotion => ED%y%PlatformPtMesh + PlatformLoads => ED%Input(1)%PlatformPtMesh !............................................................................................................................ ! Create the data structures and mappings in MeshMapType @@ -3849,7 +3940,7 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M END IF DO K=1,NumBl - CALL MeshMapCreate( ED%Output(1)%BladeRootMotion(K), BD%Input(1,k)%RootMotion, MeshMapData%ED_P_2_BD_P(K), ErrStat2, ErrMsg2 ) + CALL MeshMapCreate( ED%y%BladeRootMotion(K), BD%Input(1,k)%RootMotion, MeshMapData%ED_P_2_BD_P(K), ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_2_BD_BladeRootMotion('//TRIM(Num2LStr(K))//')' ) CALL MeshMapCreate( BD%y(k)%ReactionForce, ED%Input(1)%HubPtLoad, MeshMapData%BD_P_2_ED_P(K), ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':BD_2_ED_ReactionLoad('//TRIM(Num2LStr(K))//')' ) @@ -3863,20 +3954,20 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M END IF DO K=1,NumBl - CALL MeshMapCreate( ED%Output(1)%HubPtMotion, BD%Input(1,k)%HubMotion, MeshMapData%ED_P_2_BD_P_Hub(K), ErrStat2, ErrMsg2 ) + CALL MeshMapCreate( ED%y%HubPtMotion, BD%Input(1,k)%HubMotion, MeshMapData%ED_P_2_BD_P_Hub(K), ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_2_BD_HubMotion('//TRIM(Num2LStr(K))//')' ) END DO - + END IF - !------------------------- ! ElastoDyn <-> ServoDyn !------------------------- + IF ( SrvD%Input(1)%NTMD%Mesh%Committed ) THEN ! ED-SrvD - CALL MeshMapCreate( ED%Output(1)%NacelleMotion, SrvD%Input(1)%NTMD%Mesh, MeshMapData%ED_P_2_SrvD_P_N, ErrStat2, ErrMsg2 ) + CALL MeshMapCreate( ED%y%NacelleMotion, SrvD%Input(1)%NTMD%Mesh, MeshMapData%ED_P_2_SrvD_P_N, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_2_SrvD_NacelleMotion' ) CALL MeshMapCreate( SrvD%y%NTMD%Mesh, ED%Input(1)%NacelleLoads, MeshMapData%SrvD_P_2_ED_P_N, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':SrvD_2_ED_NacelleLoads' ) @@ -3885,13 +3976,12 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M IF ( SrvD%Input(1)%TTMD%Mesh%Committed ) THEN ! ED-SrvD - CALL MeshMapCreate( ED%Output(1)%TowerLn2Mesh, SrvD%Input(1)%TTMD%Mesh, MeshMapData%ED_L_2_SrvD_P_T, ErrStat2, ErrMsg2 ) + CALL MeshMapCreate( ED%y%TowerLn2Mesh, SrvD%Input(1)%TTMD%Mesh, MeshMapData%ED_L_2_SrvD_P_T, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_2_SrvD_TowerMotion' ) CALL MeshMapCreate( SrvD%y%TTMD%Mesh, ED%Input(1)%TowerPtLoads, MeshMapData%SrvD_P_2_ED_P_T, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':SrvD_2_ED_TowerLoad' ) - END IF - + END IF !------------------------- ! ElastoDyn <-> AeroDyn14 @@ -3915,7 +4005,7 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M ! Tower mesh: IF ( AD14%Input(1)%Twr_InputMarkers%Committed ) THEN - CALL MeshMapCreate( ED%Output(1)%TowerLn2Mesh, AD14%Input(1)%Twr_InputMarkers, MeshMapData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2 ) + CALL MeshMapCreate( ED%y%TowerLn2Mesh, AD14%Input(1)%Twr_InputMarkers, MeshMapData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_2_AD_TowerMotion' ) CALL MeshMapCreate( AD14%y%Twr_OutputLoads, ED%Input(1)%TowerPtLoads, MeshMapData%AD_L_2_ED_P_T, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':AD_2_ED_TowerLoad' ) @@ -3925,8 +4015,6 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M ELSEIF ( p_FAST%CompAero == Module_AD ) THEN ! ED-AD and/or BD-AD - NumBl = SIZE(AD%Input(1)%BladeRootMotion) - ! allocate per-blade space for mapping to structural module ! Blade root meshes @@ -3945,25 +4033,26 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M END IF + !------------------------- ! ElastoDyn <-> AeroDyn !------------------------- ! blade root meshes DO K=1,NumBl - CALL MeshMapCreate( ED%Output(1)%BladeRootMotion(K), AD%Input(1)%BladeRootMotion(K), MeshMapData%ED_P_2_AD_P_R(K), ErrStat2, ErrMsg2 ) + CALL MeshMapCreate( ED%y%BladeRootMotion(K), AD%Input(1)%BladeRootMotion(K), MeshMapData%ED_P_2_AD_P_R(K), ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_2_AD_RootMotion('//TRIM(Num2LStr(K))//')' ) END DO ! Hub point mesh - CALL MeshMapCreate( ED%Output(1)%HubPtMotion, AD%Input(1)%HubMotion, MeshMapData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2 ) + CALL MeshMapCreate( ED%y%HubPtMotion, AD%Input(1)%HubMotion, MeshMapData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_2_AD_HubMotion' ) ! Tower mesh: IF ( AD%Input(1)%TowerMotion%Committed ) THEN - CALL MeshMapCreate( ED%Output(1)%TowerLn2Mesh, AD%Input(1)%TowerMotion, MeshMapData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2 ) + CALL MeshMapCreate( ED%y%TowerLn2Mesh, AD%Input(1)%TowerMotion, MeshMapData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_2_AD_TowerMotion' ) IF ( AD%y%TowerLoad%Committed ) THEN @@ -3977,7 +4066,7 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M ! Blade meshes: DO K=1,NumBl - CALL MeshMapCreate( ED%Output(1)%BladeLn2Mesh(K), AD%Input(1)%BladeMotion(K), MeshMapData%BDED_L_2_AD_L_B(K), ErrStat2, ErrMsg2 ) + CALL MeshMapCreate( ED%y%BladeLn2Mesh(K), AD%Input(1)%BladeMotion(K), MeshMapData%BDED_L_2_AD_L_B(K), ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_2_AD_BladeMotion('//TRIM(Num2LStr(K))//')' ) CALL MeshMapCreate( AD%y%BladeLoad(K), ED%Input(1)%BladePtLoads(K), MeshMapData%AD_L_2_BDED_B(K), ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':AD_2_ED_BladeLoad('//TRIM(Num2LStr(K))//')' ) @@ -4000,8 +4089,8 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M !------------------------- ! BeamDyn <-> BeamDyn !------------------------- - if (.not. p_FAST%BD_OutputSibling) then - + if (.not. p_FAST%BD_OutputSibling) then + ! Blade meshes for load transfer: (allocate meshes at BD input locations for motions transferred from BD output locations) ALLOCATE( MeshMapData%BD_L_2_BD_L(NumBl), MeshMapData%y_BD_BldMotion_4Loads(NumBl), STAT=ErrStat2 ) IF ( ErrStat2 /= 0 ) THEN @@ -4045,42 +4134,41 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M !------------------------- ! HydroDyn <-> ElastoDyn -!------------------------- - IF ( p_FAST%CompSub /= Module_SD ) THEN ! all of these get mapped to ElastoDyn - - ! we're just going to assume ED%Input(1)%PlatformPtMesh is committed +!------------------------- + IF ( p_FAST%CompSub /= Module_SD ) THEN ! all of these get mapped to ElastoDyn ! (offshore floating) + + ! we're just going to assume PlatformLoads and PlatformMotion are committed IF ( HD%y%AllHdroOrigin%Committed ) THEN ! meshes for floating ! HydroDyn WAMIT point mesh to/from ElastoDyn point mesh - CALL MeshMapCreate( HD%y%AllHdroOrigin, ED%Input(1)%PlatformPtMesh, MeshMapData%HD_W_P_2_ED_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':HD_W_P_2_ED_P' ) - CALL MeshMapCreate( ED%Output(1)%PlatformPtMesh, HD%Input(1)%Mesh, MeshMapData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_P_2_HD_W_P' ) - END IF + CALL MeshMapCreate( HD%y%AllHdroOrigin, PlatformLoads, MeshMapData%HD_W_P_2_ED_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':HD_W_P_2_Ptfm' ) + CALL MeshMapCreate( PlatformMotion, HD%Input(1)%Mesh, MeshMapData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Ptfm_2_HD_W_P' ) + END IF ! ElastoDyn point mesh HydroDyn Morison point mesh (ED sets inputs, but gets outputs from HD%y%AllHdroOrigin in floating case) - IF ( HD%Input(1)%Morison%LumpedMesh%Committed ) THEN - CALL MeshMapCreate( ED%Output(1)%PlatformPtMesh, HD%Input(1)%Morison%LumpedMesh, MeshMapData%ED_P_2_HD_M_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_P_2_HD_M_P' ) + IF ( HD%Input(1)%Morison%LumpedMesh%Committed ) THEN + CALL MeshMapCreate( PlatformMotion, HD%Input(1)%Morison%LumpedMesh, MeshMapData%ED_P_2_HD_M_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Ptfm_2_HD_M_P' ) END IF - ! ElastoDyn point mesh to HydroDyn Morison line mesh (ED sets inputs, but gets outputs from HD%y%AllHdroOrigin in floating case) + ! ElastoDyn point mesh to HydroDyn Morison line mesh (ED sets inputs, but gets outputs from HD%y%AllHdroOrigin in floating case) IF ( HD%Input(1)%Morison%DistribMesh%Committed ) THEN - CALL MeshMapCreate( ED%Output(1)%PlatformPtMesh, HD%Input(1)%Morison%DistribMesh, MeshMapData%ED_P_2_HD_M_L, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_P_2_HD_M_L' ) + CALL MeshMapCreate( PlatformMotion, HD%Input(1)%Morison%DistribMesh, MeshMapData%ED_P_2_HD_M_L, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Ptfm_2_HD_M_L' ) END IF ELSE ! these get mapped to ElastoDyn AND SubDyn (in ED_SD_HD coupling) ! offshore fixed - ! HydroDyn WAMIT mesh to ElastoDyn point mesh + ! HydroDyn WAMIT mesh to ElastoDyn point mesh IF ( HD%y%Mesh%Committed ) THEN - ! HydroDyn WAMIT point mesh to ElastoDyn point mesh ! meshes for fixed-bottom - CALL MeshMapCreate( HD%y%Mesh, ED%Input(1)%PlatformPtMesh, MeshMapData%HD_W_P_2_ED_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':HD_W_P_2_ED_P' ) - CALL MeshMapCreate( ED%Output(1)%PlatformPtMesh, HD%Input(1)%Mesh, MeshMapData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_P_2_HD_W_P' ) + CALL MeshMapCreate( HD%y%Mesh, PlatformLoads, MeshMapData%HD_W_P_2_ED_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':HD_W_P_2_Ptfm' ) + CALL MeshMapCreate( PlatformMotion, HD%Input(1)%Mesh, MeshMapData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Ptfm_2_HD_W_P' ) END IF !------------------------- @@ -4123,10 +4211,10 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M ! NOTE: the MeshMapCreate routine returns fatal errors if either mesh is not committed ! SubDyn transition piece point mesh to/from ElastoDyn point mesh - CALL MeshMapCreate( SD%y%Y1mesh, ED%Input(1)%PlatformPtMesh, MeshMapData%SD_TP_2_ED_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':SD_TP_2_ED_P' ) - CALL MeshMapCreate( ED%Output(1)%PlatformPtMesh, SD%Input(1)%TPMesh, MeshMapData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_P_2_SD_TP' ) + CALL MeshMapCreate( SD%y%Y1mesh, PlatformLoads, MeshMapData%SD_TP_2_ED_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':SD_TP_2_Ptfm' ) + CALL MeshMapCreate( PlatformMotion, SD%Input(1)%TPMesh, MeshMapData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Ptfm_2_SD_TP' ) !------------------------- ! ElastoDyn <-> ExtPtfm @@ -4136,10 +4224,10 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M ! NOTE: the MeshMapCreate routine returns fatal errors if either mesh is not committed ! ExtPtfm PtfmMesh point mesh to/from ElastoDyn point mesh - CALL MeshMapCreate( ExtPtfm%y%PtfmMesh, ED%Input(1)%PlatformPtMesh, MeshMapData%SD_TP_2_ED_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':SD_TP_2_ED_P' ) - CALL MeshMapCreate( ED%Output(1)%PlatformPtMesh, ExtPtfm%Input(1)%PtfmMesh, MeshMapData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_P_2_SD_TP' ) + CALL MeshMapCreate( ExtPtfm%y%PtfmMesh, PlatformLoads, MeshMapData%SD_TP_2_ED_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':SD_TP_2_Ptfm' ) + CALL MeshMapCreate( PlatformMotion, ExtPtfm%Input(1)%PtfmMesh, MeshMapData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Ptfm_2_SD_TP' ) END IF ! SubDyn-ElastoDyn @@ -4150,10 +4238,10 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M !------------------------- ! MAP point mesh to/from ElastoDyn point mesh - CALL MeshMapCreate( MAPp%y%PtFairleadLoad, ED%Input(1)%PlatformPtMesh, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Mooring_P_2_ED_P' ) - CALL MeshMapCreate( ED%Output(1)%PlatformPtMesh, MAPp%Input(1)%PtFairDisplacement, MeshMapData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_P_2_Mooring_P' ) + CALL MeshMapCreate( MAPp%y%PtFairleadLoad, PlatformLoads, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Mooring_P_2_Ptfm' ) + CALL MeshMapCreate( PlatformMotion, MAPp%Input(1)%PtFairDisplacement, MeshMapData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Ptfm_2_Mooring_P' ) ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN !------------------------- @@ -4161,10 +4249,10 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M !------------------------- ! MoorDyn point mesh to/from ElastoDyn point mesh - CALL MeshMapCreate( MD%y%PtFairleadLoad, ED%Input(1)%PlatformPtMesh, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Mooring_P_2_ED_P' ) - CALL MeshMapCreate( ED%Output(1)%PlatformPtMesh, MD%Input(1)%PtFairleadDisplacement, MeshMapData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_P_2_Mooring_P' ) + CALL MeshMapCreate( MD%y%PtFairleadLoad, PlatformLoads, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Mooring_P_2_Ptfm' ) + CALL MeshMapCreate( PlatformMotion, MD%Input(1)%PtFairleadDisplacement, MeshMapData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Ptfm_2_Mooring_P' ) ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN !------------------------- @@ -4172,10 +4260,10 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M !------------------------- ! FEAMooring point mesh to/from ElastoDyn point mesh - CALL MeshMapCreate( FEAM%y%PtFairleadLoad, ED%Input(1)%PlatformPtMesh, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Mooring_P_2_ED_P' ) - CALL MeshMapCreate( ED%Output(1)%PlatformPtMesh, FEAM%Input(1)%PtFairleadDisplacement, MeshMapData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_P_2_Mooring_P' ) + CALL MeshMapCreate( FEAM%y%PtFairleadLoad, PlatformLoads, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Mooring_P_2_Ptfm' ) + CALL MeshMapCreate( PlatformMotion, FEAM%Input(1)%PtFairleadDisplacement, MeshMapData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Ptfm_2_Mooring_P' ) ELSEIF ( p_FAST%CompMooring == Module_Orca ) THEN !------------------------- @@ -4183,10 +4271,10 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M !------------------------- ! OrcaFlex point mesh to/from ElastoDyn point mesh - CALL MeshMapCreate( Orca%y%PtfmMesh, ED%Input(1)%PlatformPtMesh, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Mooring_P_2_ED_P' ) - CALL MeshMapCreate( ED%Output(1)%PlatformPtMesh, Orca%Input(1)%PtfmMesh, MeshMapData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_P_2_Mooring_P' ) + CALL MeshMapCreate( Orca%y%PtfmMesh, PlatformLoads, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Mooring_P_2_Ptfm' ) + CALL MeshMapCreate( PlatformMotion, Orca%Input(1)%PtfmMesh, MeshMapData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Ptfm_2_Mooring_P' ) END IF ! MAP-ElastoDyn ; FEAM-ElastoDyn; Orca-ElastoDyn @@ -4242,7 +4330,7 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M ED%Input(1)%HubPtLoad, BD%Input(1,:), Orca%Input(1)%PtfmMesh, ExtPtfm%Input(1)%PtfmMesh, ErrStat2, ErrMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSEIF ( p_FAST%CompHydro == Module_HD ) THEN - CALL AllocAry( MeshMapData%Jacobian_Opt1, SizeJac_ED_HD, SizeJac_ED_HD, 'Jacobian for ED-HD coupling', ErrStat2, ErrMsg2 ) + CALL AllocAry( MeshMapData%Jacobian_Opt1, SizeJac_ED_HD, SizeJac_ED_HD, 'Jacobian for Ptfm-HD coupling', ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF @@ -4259,7 +4347,7 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M CALL ResetRemapFlags(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD ) !............................................................................................................................ - ! initialize the temporary input meshes (for input-output solves): + ! initialize the temporary input meshes (for input-output solves in Solve Option 1): ! (note that we do this after ResetRemapFlags() so that the copies have remap=false) !............................................................................................................................ IF ( p_FAST%CompHydro == Module_HD .OR. p_FAST%CompSub /= Module_None .OR. (p_FAST%CompElast == Module_BD .and. BD_Solve_Option1) & @@ -4351,8 +4439,9 @@ END SUBROUTINE InitModuleMappings !> This subroutine solves the input-output relations for all of the modules. It is a subroutine because it gets done twice-- !! once at the start of the n_t_global loop and once in the j_pc loop, using different states. !! *** Note that modules that do not have direct feedthrough should be called first. *** -SUBROUTINE CalcOutputs_And_SolveForInputs( n_t_global, this_time, this_state, calcJacobian, NextJacCalcTime, p_FAST, m_FAST, & - ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) +SUBROUTINE CalcOutputs_And_SolveForInputs( n_t_global, this_time, this_state, calcJacobian, NextJacCalcTime, & + p_FAST, m_FAST, WriteThisStep, ED, BD, & + SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) REAL(DbKi) , intent(in ) :: this_time !< The current simulation time (actual or time of prediction) INTEGER(IntKi) , intent(in ) :: this_state !< Index into the state array (current or predicted states) INTEGER(IntKi) , intent(in ) :: n_t_global !< current time step (used only for SrvD hack) @@ -4361,6 +4450,7 @@ SUBROUTINE CalcOutputs_And_SolveForInputs( n_t_global, this_time, this_state, ca TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code TYPE(FAST_MiscVarType), INTENT(IN ) :: m_FAST !< Misc variables (including external inputs) for the glue code + LOGICAL , INTENT(IN ) :: WriteThisStep !< Will we print the WriteOutput values this step? TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data @@ -4426,30 +4516,31 @@ SUBROUTINE CalcOutputs_And_SolveForInputs( n_t_global, this_time, this_state, ca !! !! ## Algorithm: + !> Solve option 2 (modules without direct feedthrough): - CALL SolveOption2(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat2, ErrMsg2, n_t_global < 0) + CALL SolveOption2(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat2, ErrMsg2, n_t_global < 0, WriteThisStep) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - -#ifdef OUTPUT_MASS_MATRIX -if (n_t_global == 0) then - UnMM = -1 - CALL GetNewUnit( UnMM, ErrStat2, ErrMsg2 ) - CALL OpenFOutFile( UnMM, TRIM(p_FAST%OutFileRoot)//'.EDMassMatrix', ErrStat2, ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) RETURN - CALL WrMatrix(ED%m%AugMat,UnMM, p_FAST%OutFmt) - CLOSE( UnMM ) -end if + +#ifdef OUTPUT_MASS_MATRIX + if (n_t_global == 0) then + UnMM = -1 + CALL GetNewUnit( UnMM, ErrStat2, ErrMsg2 ) + CALL OpenFOutFile( UnMM, TRIM(p_FAST%OutFileRoot)//'.EDMassMatrix', ErrStat2, ErrMsg2) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF ( ErrStat >= AbortErrLev ) RETURN + CALL WrMatrix(ED%m%AugMat,UnMM, p_FAST%OutFmt) + CLOSE( UnMM ) + end if #endif - + !> transfer ED outputs to other modules used in option 1: - CALL Transfer_ED_to_HD_SD_BD_Mooring( p_FAST, ED%Output(1), HD%Input(1), SD%Input(1), ExtPtfm%Input(1), & + CALL Transfer_ED_to_HD_SD_BD_Mooring( p_FAST, ED%y, HD%Input(1), SD%Input(1), ExtPtfm%Input(1), & MAPp%Input(1), FEAM%Input(1), MD%Input(1), & Orca%Input(1), BD%Input(1,:), MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) !> Solve option 1 (rigorous solve on loads/accelerations) - CALL SolveOption1(this_time, this_state, calcJacobian, p_FAST, ED, BD, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2) + CALL SolveOption1(this_time, this_state, calcJacobian, p_FAST, ED, BD, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2, WriteThisStep) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -4457,7 +4548,7 @@ SUBROUTINE CalcOutputs_And_SolveForInputs( n_t_global, this_time, this_state, ca IF ( p_FAST%CompAero == Module_AD14 ) THEN - CALL AD14_InputSolve_NoIfW( p_FAST, AD14%Input(1), ED%Output(1), MeshMapData, ErrStat2, ErrMsg2 ) + CALL AD14_InputSolve_NoIfW( p_FAST, AD14%Input(1), ED%y, MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! because we're not calling InflowWind_CalcOutput or getting new values from OpenFOAM, @@ -4467,7 +4558,7 @@ SUBROUTINE CalcOutputs_And_SolveForInputs( n_t_global, this_time, this_state, ca ELSEIF ( p_FAST%CompAero == Module_AD ) THEN - CALL AD_InputSolve_NoIfW( p_FAST, AD%Input(1), ED%Output(1), BD, MeshMapData, ErrStat2, ErrMsg2 ) + CALL AD_InputSolve_NoIfW( p_FAST, AD%Input(1), ED%y, BD, MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! because we're not calling InflowWind_CalcOutput or getting new values from OpenFOAM, @@ -4479,29 +4570,28 @@ SUBROUTINE CalcOutputs_And_SolveForInputs( n_t_global, this_time, this_state, ca END IF IF ( p_FAST%CompInflow == Module_IfW ) THEN - CALL IfW_InputSolve( p_FAST, m_FAST, IfW%Input(1), IfW%p, AD14%Input(1), AD%Input(1), ED%Output(1), ErrStat2, ErrMsg2 ) + CALL IfW_InputSolve( p_FAST, m_FAST, IfW%Input(1), IfW%p, AD14%Input(1), AD%Input(1), ED%y, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSE IF ( p_FAST%CompInflow == Module_OpFM ) THEN ! OpenFOAM is the driver and it sets these inputs outside of this solve; the OpenFOAM inputs and outputs thus don't change ! in this scenario until OpenFOAM takes another step **this is a source of error, but it is the way the OpenFOAM-FAST7 coupling ! works, so I'm not going to spend time that I don't have now to fix it** - CALL OpFM_SetInputs( p_FAST, AD14%p, AD14%Input(1), AD14%y, AD%Input(1), AD%y, ED%Output(1), SrvD%y, OpFM, ErrStat2, ErrMsg2 ) + CALL OpFM_SetInputs( p_FAST, AD14%p, AD14%Input(1), AD14%y, AD%Input(1), AD%y, ED%y, SrvD%y, OpFM, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF IF ( p_FAST%CompServo == Module_SrvD ) THEN - CALL SrvD_InputSolve( p_FAST, m_FAST, SrvD%Input(1), ED%Output(1), IfW%y, OpFM%y, BD%y, MeshmapData, ErrStat2, ErrMsg2 ) + CALL SrvD_InputSolve( p_FAST, m_FAST, SrvD%Input(1), ED%y, IfW%y, OpFM%y, BD%y, MeshmapData, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF IF (p_FAST%CompElast == Module_BD .and. .NOT. BD_Solve_Option1) THEN ! map ED root and hub motion outputs to BeamDyn: - CALL Transfer_ED_to_BD(ED%Output(1), BD%Input(1,:), MeshMapData, ErrStat2, ErrMsg2 ) + CALL Transfer_ED_to_BD(ED%y, BD%Input(1,:), MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg,RoutineName ) END IF - - + !..................................................................... ! Reset each mesh's RemapFlag (after calling all InputSolve routines): !..................................................................... @@ -4513,7 +4603,7 @@ END SUBROUTINE CalcOutputs_And_SolveForInputs !---------------------------------------------------------------------------------------------------------------------------------- !> This routine implements the "option 1" solve for all inputs with direct links to HD, SD, ExtPtfm, MAP, OrcaFlex interface, and the ED !! platform reference point. Also in solve option 1 are the BD-ED blade root coupling. -SUBROUTINE SolveOption1(this_time, this_state, calcJacobian, p_FAST, ED, BD, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) +SUBROUTINE SolveOption1(this_time, this_state, calcJacobian, p_FAST, ED, BD, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg, WriteThisStep ) !............................................................................................................................... REAL(DbKi) , intent(in ) :: this_time !< The current simulation time (actual or time of prediction) INTEGER(IntKi) , intent(in ) :: this_state !< Index into the state array (current or predicted states) @@ -4540,6 +4630,7 @@ SUBROUTINE SolveOption1(this_time, this_state, calcJacobian, p_FAST, ED, BD, HD, INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + LOGICAL , INTENT(IN ) :: WriteThisStep !< Will we print the WriteOutput values this step? INTEGER :: i ! loop counter @@ -4599,7 +4690,7 @@ SUBROUTINE SolveOption1(this_time, this_state, calcJacobian, p_FAST, ED, BD, HD, IF ( p_FAST%CompSub /= Module_None .OR. (p_FAST%CompElast == Module_BD .and. BD_Solve_Option1) .OR. p_FAST%CompMooring == Module_Orca ) THEN !.OR. p_FAST%CompHydro == Module_HD ) THEN CALL FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & - , ED%Input(1), ED%p, ED%x( this_state), ED%xd( this_state), ED%z( this_state), ED%OtherSt( this_state), ED%Output(1), ED%m & + , ED%Input(1), ED%p, ED%x( this_state), ED%xd( this_state), ED%z( this_state), ED%OtherSt( this_state), ED%y, ED%m & , SD%Input(1), SD%p, SD%x( this_state), SD%xd( this_state), SD%z( this_state), SD%OtherSt( this_state), SD%y , SD%m & , ExtPtfm%Input(1),ExtPtfm%p,ExtPtfm%x( this_state),ExtPtfm%xd( this_state),ExtPtfm%z( this_state),ExtPtfm%OtherSt( this_state),ExtPtfm%y,ExtPtfm%m & , HD%Input(1), HD%p, HD%x( this_state), HD%xd( this_state), HD%z( this_state), HD%OtherSt( this_state), HD%y , HD%m & @@ -4610,17 +4701,17 @@ SUBROUTINE SolveOption1(this_time, this_state, calcJacobian, p_FAST, ED, BD, HD, , MD%Input(1), MD%y & , IceF%Input(1), IceF%y & , IceD%Input(1,:), IceD%y & ! bjj: I don't really want to make temp copies of input types. perhaps we should pass the whole Input() structure? (likewise for BD)... - , MeshMapData , ErrStat2, ErrMsg2 ) + , MeshMapData , ErrStat2, ErrMsg2, WriteThisStep ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSEIF ( p_FAST%CompHydro == Module_HD ) THEN CALL ED_HD_InputOutputSolve( this_time, p_FAST, calcJacobian & - , ED%Input(1), ED%p, ED%x(this_state), ED%xd(this_state), ED%z(this_state), ED%OtherSt(this_state), ED%Output(1), ED%m & - , HD%Input(1), HD%p, HD%x(this_state), HD%xd(this_state), HD%z(this_state), HD%OtherSt(this_state), HD%y, HD%m & + , ED%Input(1), ED%p, ED%x(this_state), ED%xd(this_state), ED%z(this_state), ED%OtherSt(this_state), ED%y, ED%m & + , HD%Input(1), HD%p, HD%x(this_state), HD%xd(this_state), HD%z(this_state), HD%OtherSt(this_state), HD%y, HD%m & , MAPp%Input(1), MAPp%y, FEAM%Input(1), FEAM%y, MD%Input(1), MD%y & - , MeshMapData , ErrStat2, ErrMsg2 ) + , MeshMapData , ErrStat2, ErrMsg2, WriteThisStep ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF ! HD, BD, and/or SD coupled to ElastoDyn @@ -4632,19 +4723,19 @@ SUBROUTINE SolveOption1(this_time, this_state, calcJacobian, p_FAST, ED, BD, HD, IF ( p_FAST%CompMooring == Module_MAP ) THEN ! note: MAP_InputSolve must be called before setting ED loads inputs (so that motions are known for loads [moment] mapping) - CALL MAP_InputSolve( MAPp%Input(1), ED%Output(1), MeshMapData, ErrStat2, ErrMsg2 ) + CALL MAP_InputSolve( MAPp%Input(1), ED%y, MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN ! note: MD_InputSolve must be called before setting ED loads inputs (so that motions are known for loads [moment] mapping) - CALL MD_InputSolve( MD%Input(1), ED%Output(1), MeshMapData, ErrStat2, ErrMsg2 ) + CALL MD_InputSolve( MD%Input(1), ED%y, MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN ! note: FEAM_InputSolve must be called before setting ED loads inputs (so that motions are known for loads [moment] mapping) - CALL FEAM_InputSolve( FEAM%Input(1), ED%Output(1), MeshMapData, ErrStat2, ErrMsg2 ) + CALL FEAM_InputSolve( FEAM%Input(1), ED%y, MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF @@ -4690,7 +4781,7 @@ SUBROUTINE SolveOption1(this_time, this_state, calcJacobian, p_FAST, ED, BD, HD, END SUBROUTINE SolveOption1 !---------------------------------------------------------------------------------------------------------------------------------- !> This routine implements the first part of the "option 2" solve for inputs that apply to BeamDyn and AeroDyn -SUBROUTINE SolveOption2a_Inp2BD(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat, ErrMsg) +SUBROUTINE SolveOption2a_Inp2BD(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat, ErrMsg, WriteThisStep) REAL(DbKi) , intent(in ) :: this_time !< The current simulation time (actual or time of prediction) INTEGER(IntKi) , intent(in ) :: this_state !< Index into the state array (current or predicted states) @@ -4710,6 +4801,7 @@ SUBROUTINE SolveOption2a_Inp2BD(this_time, this_state, p_FAST, m_FAST, ED, BD, A INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + LOGICAL , INTENT(IN ) :: WriteThisStep !< Will we print the WriteOutput values this step? INTEGER(IntKi) :: k INTEGER(IntKi) :: ErrStat2 @@ -4725,12 +4817,12 @@ SUBROUTINE SolveOption2a_Inp2BD(this_time, this_state, p_FAST, m_FAST, ED, BD, A ErrStat = ErrID_None ErrMsg = "" - CALL ED_CalcOutput( this_time, ED%Input(1), ED%p, ED%x(this_state), ED%xd(this_state), ED%z(this_state), ED%OtherSt(this_state), ED%Output(1), ED%m, ErrStat2, ErrMsg2 ) + CALL ED_CalcOutput( this_time, ED%Input(1), ED%p, ED%x(this_state), ED%xd(this_state), ED%z(this_state), ED%OtherSt(this_state), ED%y, ED%m, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF ( p_FAST%CompElast == Module_BD ) THEN ! map ED root and hub motion outputs to BeamDyn: - CALL Transfer_ED_to_BD(ED%Output(1), BD%Input(1,:), MeshMapData, ErrStat2, ErrMsg2 ) + CALL Transfer_ED_to_BD(ED%y, BD%Input(1,:), MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg,RoutineName ) END IF @@ -4738,7 +4830,7 @@ SUBROUTINE SolveOption2a_Inp2BD(this_time, this_state, p_FAST, m_FAST, ED, BD, A END SUBROUTINE SolveOption2a_Inp2BD !---------------------------------------------------------------------------------------------------------------------------------- !> This routine implements the first part of the "option 2" solve for inputs that apply to AeroDyn & InflowWind -SUBROUTINE SolveOption2b_Inp2IfW(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat, ErrMsg) +SUBROUTINE SolveOption2b_Inp2IfW(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat, ErrMsg, WriteThisStep) REAL(DbKi) , intent(in ) :: this_time !< The current simulation time (actual or time of prediction) INTEGER(IntKi) , intent(in ) :: this_state !< Index into the state array (current or predicted states) @@ -4758,6 +4850,7 @@ SUBROUTINE SolveOption2b_Inp2IfW(this_time, this_state, p_FAST, m_FAST, ED, BD, INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + LOGICAL , INTENT(IN ) :: WriteThisStep !< Will we print the WriteOutput values this step? INTEGER(IntKi) :: k INTEGER(IntKi) :: ErrStat2 @@ -4772,40 +4865,39 @@ SUBROUTINE SolveOption2b_Inp2IfW(this_time, this_state, p_FAST, m_FAST, ED, BD, ErrStat = ErrID_None ErrMsg = "" - + IF ( p_FAST%CompElast == Module_BD .AND. .NOT. BD_Solve_Option1 ) THEN DO k=1,p_FAST%nBeams CALL BD_CalcOutput( this_time, BD%Input(1,k), BD%p(k), BD%x(k,this_state), BD%xd(k,this_state),& - BD%z(k,this_state), BD%OtherSt(k,this_state), BD%y(k), BD%m(k), ErrStat2, ErrMsg2 ) + BD%z(k,this_state), BD%OtherSt(k,this_state), BD%y(k), BD%m(k), ErrStat2, ErrMsg2, .false. ) ! this WriteOutput will get overwritten in solve option 1 CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO END IF - ! find the positions where we want inflow wind in AeroDyn (i.e., set all the motion inputs to AeroDyn) IF ( p_FAST%CompAero == Module_AD14 ) THEN - CALL AD14_InputSolve_NoIfW( p_FAST, AD14%Input(1), ED%Output(1), MeshMapData, ErrStat2, ErrMsg2 ) + CALL AD14_InputSolve_NoIfW( p_FAST, AD14%Input(1), ED%y, MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSE IF ( p_FAST%CompAero == Module_AD ) THEN ! note that this uses BD outputs, which are from the previous step (and need to be initialized) - CALL AD_InputSolve_NoIfW( p_FAST, AD%Input(1), ED%Output(1), BD, MeshMapData, ErrStat2, ErrMsg2 ) + CALL AD_InputSolve_NoIfW( p_FAST, AD%Input(1), ED%y, BD, MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF IF (p_FAST%CompInflow == Module_IfW) THEN ! must be done after ED_CalcOutput and before AD_CalcOutput and SrvD - CALL IfW_InputSolve( p_FAST, m_FAST, IfW%Input(1), IfW%p, AD14%Input(1), AD%Input(1), ED%Output(1), ErrStat2, ErrMsg2 ) + CALL IfW_InputSolve( p_FAST, m_FAST, IfW%Input(1), IfW%p, AD14%Input(1), AD%Input(1), ED%y, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) !ELSE IF ( p_FAST%CompInflow == Module_OpFM ) THEN ! ! OpenFOAM is the driver and it computes outputs outside of this solve; the OpenFOAM inputs and outputs thus don't change ! ! in this scenario until OpenFOAM takes another step **this is a source of error, but it is the way the OpenFOAM-FAST7 coupling ! ! works, so I'm not going to spend time that I don't have now to fix it** - ! CALL OpFM_SetInputs( p_FAST, AD14%p, AD14%Input(1), AD14%y, AD%Input(1), AD%y, ED%Output(1), SrvD%y, OpFM, ErrStat2, ErrMsg2 ) + ! CALL OpFM_SetInputs( p_FAST, AD14%p, AD14%Input(1), AD14%y, AD%Input(1), AD%y, ED%y, SrvD%y, OpFM, ErrStat2, ErrMsg2 ) ! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF @@ -4813,8 +4905,7 @@ SUBROUTINE SolveOption2b_Inp2IfW(this_time, this_state, p_FAST, m_FAST, ED, BD, END SUBROUTINE SolveOption2b_Inp2IfW !---------------------------------------------------------------------------------------------------------------------------------- !> This routine implements the first part of the "option 2" solve for inputs that apply to AeroDyn and ServoDyn. -SUBROUTINE SolveOption2c_Inp2AD_SrvD(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat, ErrMsg, firstCall) - LOGICAL , intent(in ) :: firstCall !< flag to determine how to call ServoDyn (a hack) +SUBROUTINE SolveOption2c_Inp2AD_SrvD(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat, ErrMsg, WriteThisStep) REAL(DbKi) , intent(in ) :: this_time !< The current simulation time (actual or time of prediction) INTEGER(IntKi) , intent(in ) :: this_state !< Index into the state array (current or predicted states) @@ -4834,6 +4925,7 @@ SUBROUTINE SolveOption2c_Inp2AD_SrvD(this_time, this_state, p_FAST, m_FAST, ED, INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + LOGICAL , INTENT(IN ) :: WriteThisStep !< Will we print the WriteOutput values this step? INTEGER(IntKi) :: k INTEGER(IntKi) :: ErrStat2 @@ -4859,6 +4951,8 @@ SUBROUTINE SolveOption2c_Inp2AD_SrvD(this_time, this_state, p_FAST, m_FAST, ED, ! ! OpenFOAM is the driver and it computes outputs outside of this solve; the OpenFOAM inputs and outputs thus don't change ! ! in this scenario until OpenFOAM takes another step **this is a source of error, but it is the way the OpenFOAM-FAST7 coupling ! ! works, so I'm not going to spend time that I don't have now to fix it** + ! CALL OpFM_SetInputs( p_FAST, AD14%p, AD14%Input(1), AD14%y, AD%Input(1), AD%y, ED%y, SrvD%y, OpFM, ErrStat2, ErrMsg2 ) + ! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! CALL OpFM_SetWriteOutput(OpFM) END IF @@ -4878,10 +4972,7 @@ SUBROUTINE SolveOption2c_Inp2AD_SrvD(this_time, this_state, p_FAST, m_FAST, ED, IF ( p_FAST%CompServo == Module_SrvD ) THEN - !!!CALL SrvD_InputSolve( p_FAST, m_FAST, SrvD%Input(1), ED%Output(1), IfW%y, OpFM%y, BD%y, MeshMapData, ErrStat2, ErrMsg2 ) - !!! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! note that the inputs at step(n) for ServoDyn include the outputs from step(n-1) - CALL SrvD_InputSolve( p_FAST, m_FAST, SrvD%Input(1), ED%Output(1), IfW%y, OpFM%y, BD%y, MeshMapData, ErrStat2, ErrMsg2 ) ! At initialization, we don't have a previous value, so we'll use the guess inputs instead. note that this violates the framework.... (done for the Bladed DLL) + CALL SrvD_InputSolve( p_FAST, m_FAST, SrvD%Input(1), ED%y, IfW%y, OpFM%y, BD%y, MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF @@ -4890,7 +4981,7 @@ END SUBROUTINE SolveOption2c_Inp2AD_SrvD !---------------------------------------------------------------------------------------------------------------------------------- !> This routine implements the "option 2" solve for all inputs without direct links to HD, SD, MAP, or the ED platform reference !! point. -SUBROUTINE SolveOption2(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat, ErrMsg, firstCall) +SUBROUTINE SolveOption2(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat, ErrMsg, firstCall, WriteThisStep) !............................................................................................................................... LOGICAL , intent(in ) :: firstCall !< flag to determine how to call ServoDyn (a hack) REAL(DbKi) , intent(in ) :: this_time !< The current simulation time (actual or time of prediction) @@ -4912,13 +5003,13 @@ SUBROUTINE SolveOption2(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - + LOGICAL , INTENT(IN ) :: WriteThisStep !< Will we print the WriteOutput values this step? INTEGER(IntKi) :: k INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMSg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SolveOption2' + CHARACTER(*), PARAMETER :: RoutineName = 'SolveOption2' !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !> ++ Option 2: Solve for inputs based only on the current outputs. @@ -4932,18 +5023,17 @@ SUBROUTINE SolveOption2(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, ! SolveOption2* routines are being called in FAST_AdvanceStates, but the first time we call CalcOutputs_And_SolveForInputs, we haven't called the AdvanceStates routine IF (firstCall) THEN ! call ElastoDyn's CalcOutput & compute BD inputs from ED: - CALL SolveOption2a_Inp2BD(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat2, ErrMsg2) + CALL SolveOption2a_Inp2BD(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat2, ErrMsg2, WriteThisStep) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! compute AD position inputs; compute all of IfW inputs from ED/BD outputs: - CALL SolveOption2b_Inp2IfW(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat2, ErrMsg2) + CALL SolveOption2b_Inp2IfW(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat2, ErrMsg2, WriteThisStep) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! call IfW's CalcOutput; transfer wind-inflow inputs to AD; compute all of SrvD inputs: - CALL SolveOption2c_Inp2AD_SrvD(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat2, ErrMsg2, firstCall) + CALL SolveOption2c_Inp2AD_SrvD(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat2, ErrMsg2, WriteThisStep) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! ELSE ! these subroutines are called in the AdvanceStates routine before BD, IfW, AD, and SrvD states are updated. This gives a more accurate solution that would otherwise require a correction step. END IF - - + IF ( p_FAST%CompAero == Module_AD14 ) THEN CALL AD14_CalcOutput( this_time, AD14%Input(1), AD14%p, AD14%x(this_state), AD14%xd(this_state), AD14%z(this_state), & @@ -4953,13 +5043,13 @@ SUBROUTINE SolveOption2(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, ELSE IF ( p_FAST%CompAero == Module_AD ) THEN CALL AD_CalcOutput( this_time, AD%Input(1), AD%p, AD%x(this_state), AD%xd(this_state), AD%z(this_state), & - AD%OtherSt(this_state), AD%y, AD%m, ErrStat2, ErrMsg2 ) + AD%OtherSt(this_state), AD%y, AD%m, ErrStat2, ErrMsg2, WriteThisStep ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF - + IF ( p_FAST%CompServo == Module_SrvD ) THEN - + CALL SrvD_CalcOutput( this_time, SrvD%Input(1), SrvD%p, SrvD%x(this_state), SrvD%xd(this_state), SrvD%z(this_state), & SrvD%OtherSt(this_state), SrvD%y, SrvD%m, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -4971,7 +5061,7 @@ SUBROUTINE SolveOption2(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, ! in this scenario until OpenFOAM takes another step **this is a source of error, but it is the way the OpenFOAM-FAST7 coupling ! works, so I'm not going to spend time that I don't have now to fix it** ! note that I'm setting these inputs AFTER the call to ServoDyn so OpenFOAM gets all the inputs updated at the same step - CALL OpFM_SetInputs( p_FAST, AD14%p, AD14%Input(1), AD14%y, AD%Input(1), AD%y, ED%Output(1), SrvD%y, OpFM, ErrStat2, ErrMsg2 ) + CALL OpFM_SetInputs( p_FAST, AD14%p, AD14%Input(1), AD14%y, AD%Input(1), AD%y, ED%y, SrvD%y, OpFM, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL OpFM_SetWriteOutput(OpFM) @@ -4979,18 +5069,17 @@ SUBROUTINE SolveOption2(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, !bjj: note ED%Input(1) may be a sibling mesh of output, but ED%u is not (routine may update something that needs to be shared between siblings) - CALL ED_InputSolve( p_FAST, ED%Input(1), ED%Output(1), AD14%p, AD14%y, AD%y, SrvD%y, AD%Input(1), SrvD%Input(1), MeshMapData, ErrStat2, ErrMsg2 ) + CALL ED_InputSolve( p_FAST, ED%Input(1), ED%y, AD14%p, AD14%y, AD%y, SrvD%y, AD%Input(1), SrvD%Input(1), MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_InputSolve( p_FAST, BD, AD%y, AD%Input(1), MeshMapData, ErrStat2, ErrMsg2 ) + CALL BD_InputSolve( p_FAST, BD, AD%y, AD%Input(1), ED%y, MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END SUBROUTINE SolveOption2 !---------------------------------------------------------------------------------------------------------------------------------- !> This routines advances the states of each module SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, & - MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) + MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg, WriteThisStep ) REAL(DbKi), INTENT(IN ) :: t_initial !< initial simulation time (almost always 0) INTEGER(IntKi), INTENT(IN ) :: n_t_global !< integer time step @@ -5019,6 +5108,7 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + LOGICAL , INTENT(IN ) :: WriteThisStep !< Will we print the WriteOutput values this step (for optimizations with SolveOption2)? ! local variables INTEGER(IntKi) :: i, k ! loop counters @@ -5026,7 +5116,7 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED REAL(DbKi) :: t_module ! Current simulation time for module REAL(DbKi) :: t_global_next ! Simulation time for computing outputs INTEGER(IntKi) :: j_ss ! substep loop counter - INTEGER(IntKi) :: n_t_module ! simulation time step, loop counter for individual modules + INTEGER(IntKi) :: n_t_module ! simulation time step, loop counter for individual modules INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FAST_AdvanceStates' @@ -5060,12 +5150,13 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED CALL ED_UpdateStates( t_module, n_t_module, ED%Input, 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 END DO !j_ss + - ! BeamDyn doesn't like extrapolated rotations, so we will calculate them from ED and transfer instead of doing a correction step. - ! AD15/DBEMT also doesn't like extrapolated motions, so we will calculate them from ED/BD instead of doing a correction step. - CALL SolveOption2a_Inp2BD(t_global_next, STATE_PRED, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat2, ErrMsg2) + ! BeamDyn doesn't like extrapolated rotations, so we will calculate them from ED and transfer instead of doing a correction step. + ! (Also calls ED_CalcOutput here so that we can use it for AeroDyn optimization, too): + CALL SolveOption2a_Inp2BD(t_global_next, STATE_PRED, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat2, ErrMsg2, WriteThisStep) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF ( p_FAST%CompElast == Module_BD ) THEN @@ -5091,12 +5182,13 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED END DO !j_ss END DO !nBeams + IF (ErrStat >= AbortErrLev) RETURN END IF !CompElast - + ! because AeroDyn DBEMT states depend heavily on getting inputs correct, we are overwriting its inputs with updated structural outputs here - CALL SolveOption2b_Inp2IfW(t_global_next, STATE_PRED, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat2, ErrMsg2) + CALL SolveOption2b_Inp2IfW(t_global_next, STATE_PRED, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat2, ErrMsg2, WriteThisStep) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -5123,7 +5215,7 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED ! because AeroDyn DBEMT states depend heavily on getting inputs correct, we are overwriting its inputs with updated inflow outputs here - CALL SolveOption2c_Inp2AD_SrvD(t_global_next, STATE_PRED, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat2, ErrMsg2, .false.) + CALL SolveOption2c_Inp2AD_SrvD(t_global_next, STATE_PRED, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat2, ErrMsg2, WriteThisStep) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! AeroDyn: get predicted states @@ -5165,7 +5257,7 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED END DO !j_ss END IF - + ! ServoDyn: get predicted states IF ( p_FAST%CompServo == Module_SrvD ) THEN CALL SrvD_CopyContState (SrvD%x( STATE_CURR), SrvD%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) @@ -5184,6 +5276,7 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED CALL SrvD_UpdateStates( t_module, n_t_module, SrvD%Input, 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 END DO !j_ss END IF @@ -5380,12 +5473,11 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED END SUBROUTINE FAST_AdvanceStates !---------------------------------------------------------------------------------------------------------------------------------- !> This routine extrapolates inputs to modules to give predicted values at t+dt. -SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & +SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & IceF, IceD, ErrStat, ErrMsg ) REAL(DbKi), INTENT(IN ) :: t_global_next !< next global time step (t + dt), at which we're extrapolating inputs (and ED outputs) 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 @@ -5419,9 +5511,9 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, y_FAST, m_FAST, ED, BD, !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ! Step 1.a: Extrapolate Inputs (gives predicted values at t+dt) ! - ! a) Extrapolate inputs (and outputs -- bjj: output extrapolation not necessary, yet) + ! a) Extrapolate inputs ! to t + dt (i.e., t_global_next); will only be used by modules with an implicit dependence on input data. - ! b) Shift "window" of the ModName_Input and ModName_Output + ! b) Shift "window" of the ModName%Input !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ErrStat = ErrID_None @@ -5431,23 +5523,15 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, y_FAST, m_FAST, ED, BD, CALL ED_Input_ExtrapInterp(ED%Input, ED%InputTimes, ED%u, t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - CALL ED_Output_ExtrapInterp(ED%Output, ED%InputTimes, ED%y, t_global_next, ErrStat2, ErrMsg2) !this extrapolated value is used in the ED-HD coupling - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - - DO j = p_FAST%InterpOrder, 1, -1 CALL ED_CopyInput (ED%Input(j), ED%Input(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - CALL ED_CopyOutput(ED%Output(j), ED%Output(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) ED%InputTimes(j+1) = ED%InputTimes(j) !ED_OutputTimes(j+1) = ED_OutputTimes(j) END DO CALL ED_CopyInput (ED%u, ED%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - CALL ED_CopyOutput (ED%y, ED%Output(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) ED%InputTimes(1) = t_global_next !ED_OutputTimes(1) = t_global_next @@ -5474,8 +5558,7 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, y_FAST, m_FAST, ED, BD, END DO ! k=p_FAST%nBeams - END IF ! BeamDyn - + END IF ! BeamDyn ! AeroDyn v14 IF ( p_FAST%CompAero == Module_AD14 ) THEN @@ -5483,11 +5566,7 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, y_FAST, m_FAST, ED, BD, CALL AD14_Input_ExtrapInterp(AD14%Input, AD14%InputTimes, AD14%u, t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL AD14_Output_ExtrapInterp(AD14_Output, AD14_OutputTimes, AD14%y, t_global_next, ErrStat2, ErrMsg2) - ! CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - - - ! Shift "window" of AD14%Input and AD14_Output + ! Shift "window" of AD14%Input DO j = p_FAST%InterpOrder, 1, -1 CALL AD14_CopyInput (AD14%Input(j), AD14%Input(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) @@ -5525,25 +5604,17 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, y_FAST, m_FAST, ED, BD, CALL InflowWind_Input_ExtrapInterp(IfW%Input, IfW%InputTimes, IfW%u, t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL InflowWind_Output_ExtrapInterp(IfW_Output, IfW_OutputTimes, IfW%y, t_global_next, ErrStat2, ErrMsg2) - ! CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - - - ! Shift "window" of IfW%Input and IfW_Output + ! Shift "window" of IfW%Input DO j = p_FAST%InterpOrder, 1, -1 CALL InflowWind_CopyInput (IfW%Input(j), IfW%Input(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL InflowWind_CopyOutput(IfW_Output(j), IfW_Output(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) IfW%InputTimes(j+1) = IfW%InputTimes(j) - !IfW_OutputTimes(j+1) = IfW_OutputTimes(j) END DO CALL InflowWind_CopyInput (IfW%u, IfW%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL InflowWind_CopyOutput(IfW%y, IfW_Output(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) IfW%InputTimes(1) = t_global_next - !IfW_OutputTimes(1) = t_global_next END IF ! CompInflow @@ -5553,26 +5624,18 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, y_FAST, m_FAST, ED, BD, CALL SrvD_Input_ExtrapInterp(SrvD%Input, SrvD%InputTimes, SrvD%u, t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - - !CALL SrvD_Output_ExtrapInterp(SrvD_Output, SrvD_OutputTimes, SrvD%y, t_global_next, ErrStat2, ErrMsg2) - ! CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - - ! Shift "window" of SrvD%Input and SrvD_Output + ! Shift "window" of SrvD%Input DO j = p_FAST%InterpOrder, 1, -1 CALL SrvD_CopyInput (SrvD%Input(j), SrvD%Input(j+1), MESH_UPDATECOPY, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL SrvD_CopyOutput(SrvD_Output(j), SrvD_Output(j+1), MESH_UPDATECOPY, ErrStat2, ErrMsg2) SrvD%InputTimes(j+1) = SrvD%InputTimes(j) - !SrvD_OutputTimes(j+1) = SrvD_OutputTimes(j) END DO CALL SrvD_CopyInput (SrvD%u, SrvD%Input(1), MESH_UPDATECOPY, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL SrvD_CopyOutput(SrvD%y, SrvD_Output(1), MESH_UPDATECOPY, ErrStat2, ErrMsg2) SrvD%InputTimes(1) = t_global_next - !SrvD_OutputTimes(1) = t_global_next END IF ! ServoDyn @@ -5582,25 +5645,18 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, y_FAST, m_FAST, ED, BD, CALL HydroDyn_Input_ExtrapInterp(HD%Input, HD%InputTimes, HD%u, t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL HydroDyn_Output_ExtrapInterp(HD_Output, HD_OutputTimes, HD%y, t_global_next, ErrStat2, ErrMsg2) - ! CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - - ! Shift "window" of HD%Input and HD_Output + ! Shift "window" of HD%Input DO j = p_FAST%InterpOrder, 1, -1 CALL HydroDyn_CopyInput (HD%Input(j), HD%Input(j+1), MESH_UPDATECOPY, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL HydroDyn_CopyOutput(HD_Output(j), HD_Output(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) HD%InputTimes(j+1) = HD%InputTimes(j) - !HD_OutputTimes(j+1)= HD_OutputTimes(j) END DO CALL HydroDyn_CopyInput (HD%u, HD%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL HydroDyn_CopyOutput(HD%y, HD_Output(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) HD%InputTimes(1) = t_global_next - !HD_OutputTimes(1) = t_global_next END IF ! HydroDyn @@ -5610,55 +5666,38 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, y_FAST, m_FAST, ED, BD, CALL SD_Input_ExtrapInterp(SD%Input, SD%InputTimes, SD%u, t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - - !CALL SD_Output_ExtrapInterp(SD_Output, SD_OutputTimes, SD%y, t_global_next, ErrStat2, ErrMsg2) - ! CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - - ! Shift "window" of SD%Input and SD_Output + ! Shift "window" of SD%Input DO j = p_FAST%InterpOrder, 1, -1 CALL SD_CopyInput (SD%Input(j), SD%Input(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL SD_CopyOutput(SD_Output(j), SD_Output(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) SD%InputTimes(j+1) = SD%InputTimes(j) - !SD_OutputTimes(j+1) = SD_OutputTimes(j) END DO CALL SD_CopyInput (SD%u, SD%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL SD_CopyOutput(SD%y, SD_Output(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) SD%InputTimes(1) = t_global_next - !SD_OutputTimes(1) = t_global_next ELSE IF ( p_FAST%CompSub == Module_ExtPtfm ) THEN CALL ExtPtfm_Input_ExtrapInterp(ExtPtfm%Input, ExtPtfm%InputTimes, ExtPtfm%u, t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL ExtPtfm_Output_ExtrapInterp(ExtPtfm_Output, ExtPtfm_OutputTimes, ExtPtfm%y, t_global_next, ErrStat2, ErrMsg2) - ! CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - - - ! Shift "window" of ExtPtfm%Input and ExtPtfm_Output + ! Shift "window" of ExtPtfm%Input DO j = p_FAST%InterpOrder, 1, -1 CALL ExtPtfm_CopyInput (ExtPtfm%Input(j), ExtPtfm%Input(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL ExtPtfm_CopyOutput(ExtPtfm_Output(j), ExtPtfm_Output(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) ExtPtfm%InputTimes(j+1) = ExtPtfm%InputTimes(j) - !ExtPtfm_OutputTimes(j+1) = ExtPtfm_OutputTimes(j) END DO CALL ExtPtfm_CopyInput (ExtPtfm%u, ExtPtfm%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL ExtPtfm_CopyOutput(ExtPtfm%y, ExtPtfm_Output(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) ExtPtfm%InputTimes(1) = t_global_next - !ExtPtfm_OutputTimes(1) = t_global_next END IF ! SubDyn/ExtPtfm_MCKF - ! Mooring (MAP , FEAM , MoorDyn) ! MAP IF ( p_FAST%CompMooring == Module_MAP ) THEN @@ -5666,25 +5705,17 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, y_FAST, m_FAST, ED, BD, CALL MAP_Input_ExtrapInterp(MAPp%Input, MAPp%InputTimes, MAPp%u, t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL MAP_Output_ExtrapInterp(MAP_Output, MAP_OutputTimes, MAPp%y, t_global_next, ErrStat2, ErrMsg2) - ! CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - - - ! Shift "window" of MAPp%Input and MAP_Output + ! Shift "window" of MAPp%Input DO j = p_FAST%InterpOrder, 1, -1 CALL MAP_CopyInput (MAPp%Input(j), MAPp%Input(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL MAP_CopyOutput(MAP_Output(j), MAP_Output(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) MAPp%InputTimes(j+1) = MAPp%InputTimes(j) - !MAP_OutputTimes(j+1) = MAP_OutputTimes(j) END DO CALL MAP_CopyInput (MAPp%u, MAPp%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL MAP_CopyOutput(MAPp%y, MAP_Output(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) MAPp%InputTimes(1) = t_global_next - !MAP_OutputTimes(1) = t_global_next ! MoorDyn ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN @@ -5692,25 +5723,17 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, y_FAST, m_FAST, ED, BD, CALL MD_Input_ExtrapInterp(MD%Input, MD%InputTimes, MD%u, t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL MD_Output_ExtrapInterp(MD_Output, MD_OutputTimes, MD%y, t_global_next, ErrStat2, ErrMsg2) - ! CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - - - ! Shift "window" of MD%Input and MD_Output + ! Shift "window" of MD%Input DO j = p_FAST%InterpOrder, 1, -1 CALL MD_CopyInput (MD%Input(j), MD%Input(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL MD_CopyOutput(MD_Output(j), MD_Output(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) MD%InputTimes( j+1) = MD%InputTimes( j) - !MD_OutputTimes(j+1) = MD_OutputTimes(j) END DO CALL MD_CopyInput (MD%u, MD%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL MD_CopyOutput(MD%y, MD_Output(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) MD%InputTimes(1) = t_global_next - !MD_OutputTimes(1) = t_global_next ! FEAM ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN @@ -5718,25 +5741,17 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, y_FAST, m_FAST, ED, BD, CALL FEAM_Input_ExtrapInterp(FEAM%Input, FEAM%InputTimes, FEAM%u, t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL FEAM_Output_ExtrapInterp(FEAM_Output, FEAM_OutputTimes, FEAM%y, t_global_next, ErrStat2, ErrMsg2) - ! CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - - - ! Shift "window" of FEAM%Input and FEAM_Output + ! Shift "window" of FEAM%Input DO j = p_FAST%InterpOrder, 1, -1 CALL FEAM_CopyInput (FEAM%Input(j), FEAM%Input(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL FEAM_CopyOutput(FEAM_Output(j), FEAM_Output(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) FEAM%InputTimes( j+1) = FEAM%InputTimes( j) - !FEAM_OutputTimes(j+1) = FEAM_OutputTimes(j) END DO CALL FEAM_CopyInput (FEAM%u, FEAM%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL FEAM_CopyOutput(FEAM%y, FEAM_Output(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) FEAM%InputTimes(1) = t_global_next - !FEAM_OutputTimes(1) = t_global_next ! OrcaFlex ELSEIF ( p_FAST%CompMooring == Module_Orca ) THEN @@ -5766,26 +5781,18 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, y_FAST, m_FAST, ED, BD, CALL IceFloe_Input_ExtrapInterp(IceF%Input, IceF%InputTimes, IceF%u, t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - - !CALL IceFloe_Output_ExtrapInterp(IceF_Output, IceF_OutputTimes, IceF%y, t_global_next, ErrStat2, ErrMsg2) - ! CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - - ! Shift "window" of IceF%Input and IceF_Output + ! Shift "window" of IceF%Input DO j = p_FAST%InterpOrder, 1, -1 CALL IceFloe_CopyInput (IceF%Input(j), IceF%Input(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL IceFloe_CopyOutput(IceF_Output(j), IceF_Output(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) IceF%InputTimes(j+1) = IceF%InputTimes(j) - !IceF_OutputTimes(j+1) = IceF_OutputTimes(j) END DO CALL IceFloe_CopyInput (IceF%u, IceF%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL IceFloe_CopyOutput(IceF%y, IceF_Output(1), MESH_UPDATECOPY, Errstat, ErrMsg) IceF%InputTimes(1) = t_global_next - !IceF_OutputTimes(1) = t_global_next ! IceDyn ELSEIF ( p_FAST%CompIce == Module_IceD ) THEN @@ -5794,26 +5801,18 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, y_FAST, m_FAST, ED, BD, CALL IceD_Input_ExtrapInterp(IceD%Input(:,i), IceD%InputTimes(:,i), IceD%u(i), t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - - !CALL IceD_Output_ExtrapInterp(IceD%Output(:,i), IceD%OutputTimes(:,i), IceD%y(i), t_global_next, ErrStat2, ErrMsg2) - ! CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - - ! Shift "window" of IceD%Input and IceD%Output + ! Shift "window" of IceD%Input DO j = p_FAST%InterpOrder, 1, -1 CALL IceD_CopyInput (IceD%Input(j,i), IceD%Input(j+1,i), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL IceD_CopyOutput(IceD%Output(j,i), IceD%Output(j+1,i), MESH_UPDATECOPY, Errstat2, ErrMsg2) IceD%InputTimes(j+1,i) = IceD%InputTimes(j,i) - !IceD%OutputTimes(j+1,i) = IceD%OutputTimes(j,i) END DO CALL IceD_CopyInput (IceD%u(i), IceD%Input(1,i), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL IceD_CopyOutput(IceD%y(i), IceD%Output(1,i), MESH_UPDATECOPY, Errstat2, ErrMsg2) IceD%InputTimes(1,i) = t_global_next - !IceD%OutputTimes(1,i) = t_global_next END DO ! numIceLegs diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 00ccec81a2..4607336f47 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -182,6 +182,8 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, y_FAST%UnGra = -1 ! set the binary graphics output file unit to -1 to indicate it's not open p_FAST%WrVTK = VTK_Unknown ! set this so that we can potentially output VTK information on initialization error + p_FAST%VTK_tWidth = 1 ! initialize in case of error before reading the full file + p_FAST%n_VTKTime = 1 ! initialize in case of error before reading the full file y_FAST%VTK_LastWaveIndx = 1 ! Start looking for wave data at the first index y_FAST%VTK_count = 0 ! first VTK file has 0 as output y_FAST%n_Out = 0 ! set the number of ouptut channels to 0 to indicate there's nothing to write to the binary file @@ -197,7 +199,10 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, m_FAST%calcJacobian = .TRUE. ! we need to calculate the Jacobian m_FAST%NextJacCalcTime = m_FAST%t_global ! We want to calculate the Jacobian on the first step p_FAST%TDesc = '' +! p_FAST%CheckHSSBrTrqC = .false. + y_FAST%Lin%WindSpeed = 0.0_ReKi + if (present(ExternInitData)) then CallStart = .not. ExternInitData%FarmIntegration ! .and. ExternInitData%TurbineID == 1 if (ExternInitData%TurbineID > 0) p_FAST%TDesc = 'T'//trim(num2lstr(ExternInitData%TurbineID)) @@ -235,14 +240,14 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, p_FAST%TurbinePos = ExternInitData%TurbinePos if (ExternInitData%FarmIntegration) then ! we're integrating with FAST.Farm - CALL FAST_Init( p_FAST, y_FAST, t_initial, InputFile, ErrStat2, ErrMsg2, ExternInitData%TMax, OverrideAbortLev=.false., RootName=ExternInitData%RootName ) + CALL FAST_Init( p_FAST, m_FAST, y_FAST, t_initial, InputFile, ErrStat2, ErrMsg2, ExternInitData%TMax, OverrideAbortLev=.false., RootName=ExternInitData%RootName ) else - CALL FAST_Init( p_FAST, y_FAST, t_initial, InputFile, ErrStat2, ErrMsg2, ExternInitData%TMax, ExternInitData%TurbineID ) ! We have the name of the input file and the simulation length from somewhere else (e.g. Simulink) + CALL FAST_Init( p_FAST, m_FAST, y_FAST, t_initial, InputFile, ErrStat2, ErrMsg2, ExternInitData%TMax, ExternInitData%TurbineID ) ! We have the name of the input file and the simulation length from somewhere else (e.g. Simulink) end if else p_FAST%TurbinePos = 0.0_ReKi - CALL FAST_Init( p_FAST, y_FAST, t_initial, InputFile, ErrStat2, ErrMsg2 ) ! We have the name of the input file from somewhere else (e.g. Simulink) + CALL FAST_Init( p_FAST, m_FAST, y_FAST, t_initial, InputFile, ErrStat2, ErrMsg2 ) ! We have the name of the input file from somewhere else (e.g. Simulink) end if CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -260,7 +265,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! initialize ElastoDyn (must be done first) ! ........................ - ALLOCATE( ED%Input( p_FAST%InterpOrder+1 ), ED%InputTimes( p_FAST%InterpOrder+1 ), ED%Output( p_FAST%InterpOrder+1 ),STAT = ErrStat2 ) + 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, ED%Output, and ED%InputTimes.",ErrStat,ErrMsg,RoutineName) CALL Cleanup() @@ -279,7 +284,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, InitInData_ED%CompElast = p_FAST%CompElast == Module_ED CALL ED_Init( InitInData_ED, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), & - ED%Output(1), ED%m, p_FAST%dt_module( MODULE_ED ), InitOutData_ED, ErrStat2, ErrMsg2 ) + ED%y, ED%m, p_FAST%dt_module( MODULE_ED ), InitOutData_ED, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) p_FAST%ModuleInitialized(Module_ED) = .TRUE. @@ -315,6 +320,17 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, RETURN END IF + if (p_FAST%CalcSteady) then + if ( EqualRealNos(InitOutData_ED%RotSpeed, 0.0_ReKi) ) then + p_FAST%TrimCase = TrimCase_none + p_FAST%NLinTimes = 1 + p_FAST%LinInterpOrder = 0 ! constant values + elseif ( InitOutData_ED%isFixed_GenDOF ) then + p_FAST%TrimCase = TrimCase_none + end if + end if + + ! ........................ ! initialize BeamDyn ! ........................ @@ -357,8 +373,8 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! now initialize BeamDyn for all beams dt_BD = p_FAST%dt_module( MODULE_BD ) - InitInData_BD%HubPos = ED%Output(1)%HubPtMotion%Position(:,1) - InitInData_BD%HubRot = ED%Output(1)%HubPtMotion%RefOrientation(:,:,1) + InitInData_BD%HubPos = ED%y%HubPtMotion%Position(:,1) + InitInData_BD%HubRot = ED%y%HubPtMotion%RefOrientation(:,:,1) p_FAST%BD_OutputSibling = .true. @@ -375,13 +391,13 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, InitInData_BD%InputFile = p_FAST%BDBldFile(k) - InitInData_BD%GlbPos = ED%Output(1)%BladeRootMotion(k)%Position(:,1) ! {:} - - "Initial Position Vector of the local blade coordinate system" - InitInData_BD%GlbRot = ED%Output(1)%BladeRootMotion(k)%RefOrientation(:,:,1) ! {:}{:} - - "Initial direction cosine matrix of the local blade coordinate system" + InitInData_BD%GlbPos = ED%y%BladeRootMotion(k)%Position(:,1) ! {:} - - "Initial Position Vector of the local blade coordinate system" + InitInData_BD%GlbRot = ED%y%BladeRootMotion(k)%RefOrientation(:,:,1) ! {:}{:} - - "Initial direction cosine matrix of the local blade coordinate system" - InitInData_BD%RootDisp = ED%Output(1)%BladeRootMotion(k)%TranslationDisp(:,1) ! {:} - - "Initial root displacement" - InitInData_BD%RootOri = ED%Output(1)%BladeRootMotion(k)%Orientation(:,:,1) ! {:}{:} - - "Initial root orientation" - InitInData_BD%RootVel(1:3) = ED%Output(1)%BladeRootMotion(k)%TranslationVel(:,1) ! {:} - - "Initial root velocities and angular veolcities" - InitInData_BD%RootVel(4:6) = ED%Output(1)%BladeRootMotion(k)%RotationVel(:,1) ! {:} - - "Initial root velocities and angular veolcities" + InitInData_BD%RootDisp = ED%y%BladeRootMotion(k)%TranslationDisp(:,1) ! {:} - - "Initial root displacement" + InitInData_BD%RootOri = ED%y%BladeRootMotion(k)%Orientation(:,:,1) ! {:}{:} - - "Initial root orientation" + InitInData_BD%RootVel(1:3) = ED%y%BladeRootMotion(k)%TranslationVel(:,1) ! {:} - - "Initial root velocities and angular veolcities" + InitInData_BD%RootVel(4:6) = ED%y%BladeRootMotion(k)%RotationVel(:,1) ! {:} - - "Initial root velocities and angular veolcities" CALL BD_Init( InitInData_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, InitOutData_BD(k), ErrStat2, ErrMsg2 ) @@ -397,11 +413,6 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ELSEIF ( .NOT. EqualRealNos( p_FAST%dt_module( MODULE_BD ),dt_BD )) THEN CALL SetErrStat(ErrID_Fatal,"All instances of BeamDyn (one per blade) must have the same time step.",ErrStat,ErrMsg,RoutineName) END IF - - ! BeamDyn shouldn't be run in static mode when coupled with FAST - if (BD%p(k)%analysis_type == BD_STATIC_ANALYSIS) then ! static - CALL SetErrStat(ErrID_Fatal,"BeamDyn cannot perform static analysis when coupled with FAST.",ErrStat,ErrMsg,RoutineName) - end if ! We're going to do fewer computations if the BD input and output meshes that couple to AD are siblings: if (BD%p(k)%BldMotionNodeLoc /= BD_MESH_QP) p_FAST%BD_OutputSibling = .false. @@ -449,7 +460,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, IF ( p_FAST%CompAero == Module_AD14 ) THEN - CALL AD_SetInitInput(InitInData_AD14, InitOutData_ED, ED%Output(1), p_FAST, ErrStat2, ErrMsg2) ! set the values in InitInData_AD14 + CALL AD_SetInitInput(InitInData_AD14, InitOutData_ED, ED%y, p_FAST, ErrStat2, ErrMsg2) ! set the values in InitInData_AD14 CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) CALL AD14_Init( InitInData_AD14, AD14%Input(1), AD14%p, AD14%x(STATE_CURR), AD14%xd(STATE_CURR), AD14%z(STATE_CURR), & @@ -490,12 +501,12 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, InitInData_AD%InputFile = p_FAST%AeroFile InitInData_AD%NumBlades = InitOutData_ED%NumBl InitInData_AD%RootName = p_FAST%OutFileRoot - InitInData_AD%HubPosition = ED%Output(1)%HubPtMotion%Position(:,1) - InitInData_AD%HubOrientation = ED%Output(1)%HubPtMotion%RefOrientation(:,:,1) + InitInData_AD%HubPosition = ED%y%HubPtMotion%Position(:,1) + InitInData_AD%HubOrientation = ED%y%HubPtMotion%RefOrientation(:,:,1) do k=1,InitOutData_ED%NumBl - InitInData_AD%BladeRootPosition(:,k) = ED%Output(1)%BladeRootMotion(k)%Position(:,1) - InitInData_AD%BladeRootOrientation(:,:,k) = ED%Output(1)%BladeRootMotion(k)%RefOrientation(:,:,1) + InitInData_AD%BladeRootPosition(:,k) = ED%y%BladeRootMotion(k)%Position(:,1) + InitInData_AD%BladeRootOrientation(:,:,k) = ED%y%BladeRootMotion(k)%RefOrientation(:,:,1) end do @@ -564,7 +575,8 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! lidar InitInData_IfW%lidar%Tmax = p_FAST%TMax - InitInData_IfW%lidar%HubPosition = ED%Output(1)%HubPtMotion%Position(:,1) + InitInData_IfW%lidar%HubPosition = ED%y%HubPtMotion%Position(:,1) + IF ( PRESENT(ExternInitData) ) THEN InitInData_IfW%Use4Dext = ExternInitData%FarmIntegration @@ -603,6 +615,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, if (allocated(InitOutData_IfW%IsLoad_u )) call move_alloc(InitOutData_IfW%IsLoad_u ,y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%IsLoad_u ) if (allocated(InitOutData_IfW%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%NumOutputs = size(InitOutData_IfW%WriteOutputHdr) + y_FAST%Lin%WindSpeed = InitOutData_IfW%WindFileInfo%MWS end if IF (ErrStat >= AbortErrLev) THEN @@ -635,7 +648,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, RETURN END IF ! set up the data structures for integration with OpenFOAM - CALL Init_OpFM( InitInData_OpFM, p_FAST, AirDens, AD14%Input(1), AD%Input(1), InitOutData_AD, AD%y, ED%Output(1), OpFM, InitOutData_OpFM, ErrStat2, ErrMsg2 ) + CALL Init_OpFM( InitInData_OpFM, p_FAST, AirDens, AD14%Input(1), AD%Input(1), InitOutData_AD, AD%y, ED%y, OpFM, InitOutData_OpFM, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF (ErrStat >= AbortErrLev) THEN @@ -707,10 +720,13 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, InitInData_SrvD%AirDens = AirDens InitInData_SrvD%AvgWindSpeed = InitOutData_IfW%WindFileInfo%MWS InitInData_SrvD%Linearize = p_FAST%Linearize + InitInData_SrvD%TrimCase = p_FAST%TrimCase + InitInData_SrvD%TrimGain = p_FAST%TrimGain + InitInData_SrvD%RotSpeedRef = InitOutData_ED%RotSpeed IF ( PRESENT(ExternInitData) ) THEN InitInData_SrvD%NumSC2Ctrl = ExternInitData%NumSC2Ctrl - InitInData_SrvD%NumCtrl2SC = ExternInitData%NumCtrl2SC + InitInData_SrvD%NumCtrl2SC = ExternInitData%NumCtrl2SC ELSE InitInData_SrvD%NumSC2Ctrl = 0 InitInData_SrvD%NumCtrl2SC = 0 @@ -719,6 +735,11 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, CALL AllocAry(InitInData_SrvD%BlPitchInit, InitOutData_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 + InitInData_SrvD%BlPitchInit = InitOutData_ED%BlPitch CALL SrvD_Init( InitInData_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 ), InitOutData_SrvD, ErrStat2, ErrMsg2 ) @@ -805,7 +826,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, InitInData_HD%OutRootName = p_FAST%OutFileRoot InitInData_HD%TMax = p_FAST%TMax InitInData_HD%hasIce = p_FAST%CompIce /= Module_None - InitInData_HD%Linearize = p_FAST%Linearize + InitInData_HD%Linearize = p_FAST%Linearize ! if wave field needs an offset, modify these values (added at request of SOWFA developers): InitInData_HD%PtfmLocationX = p_FAST%TurbinePos(1) @@ -870,8 +891,8 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, !InitInData_SD%UseInputFile = .TRUE. InitInData_SD%SDInputFile = p_FAST%SubFile InitInData_SD%RootName = p_FAST%OutFileRoot - InitInData_SD%TP_RefPoint = ED%Output(1)%PlatformPtMesh%Position(:,1) ! bjj: not sure what this is supposed to be - InitInData_SD%SubRotateZ = 0.0 ! bjj: not sure what this is supposed to be + InitInData_SD%TP_RefPoint = ED%y%PlatformPtMesh%Position(:,1) ! bjj: not sure what this is supposed to be + InitInData_SD%SubRotateZ = 0.0 ! bjj: not sure what this is supposed to be CALL SD_Init( InitInData_SD, SD%Input(1), SD%p, SD%x(STATE_CURR), SD%xd(STATE_CURR), SD%z(STATE_CURR), & @@ -1203,7 +1224,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! Initialize for linearization: ! ------------------------------------------------------------------------- if ( p_FAST%Linearize ) then - call Init_Lin(p_FAST, y_FAST, m_FAST, AD, InitOutData_ED%NumBl, ErrStat2, ErrMsg2) + call Init_Lin(p_FAST, y_FAST, m_FAST, AD, ED, InitOutData_ED%NumBl, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if (ErrStat >= AbortErrLev) then @@ -1235,7 +1256,6 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! ------------------------------------------------------------------------- m_FAST%t_global = t_initial - m_FAST%NextLinTimeIndx = 1 ! Initialize external inputs for first step if ( p_FAST%CompServo == MODULE_SrvD ) then @@ -1497,13 +1517,14 @@ END SUBROUTINE GetInputFileName !---------------------------------------------------------------------------------------------------------------------------------- !> This subroutine checks for command-line arguments, gets the root name of the input files !! (including full path name), and creates the names of the output files. -SUBROUTINE FAST_Init( p, y_FAST, t_initial, InputFile, ErrStat, ErrMsg, TMax, TurbID, OverrideAbortLev, RootName ) +SUBROUTINE FAST_Init( p, m_FAST, y_FAST, t_initial, InputFile, ErrStat, ErrMsg, TMax, TurbID, OverrideAbortLev, RootName ) IMPLICIT NONE ! Passed variables TYPE(FAST_ParameterType), INTENT(INOUT) :: p !< The parameter data for the FAST (glue-code) simulation + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< The output data for the FAST (glue-code) simulation REAL(DbKi), INTENT(IN) :: t_initial !< the beginning time of the simulation INTEGER(IntKi), INTENT(OUT) :: ErrStat !< Error status @@ -1554,6 +1575,7 @@ SUBROUTINE FAST_Init( p, y_FAST, t_initial, InputFile, ErrStat, ErrMsg, TMax, Tu END IF end if + p%VTK_OutFileRoot = p%OutFileRoot !initialize this here in case of error before it is set later !............................................................................................................................... @@ -1604,9 +1626,15 @@ SUBROUTINE FAST_Init( p, y_FAST, t_initial, InputFile, ErrStat, ErrMsg, TMax, Tu !............................................................................................................................... ! Read the primary file for the glue code: !............................................................................................................................... - CALL FAST_ReadPrimaryFile( InputFile, p, OverrideAbortErrLev, ErrStat2, ErrMsg2 ) + CALL FAST_ReadPrimaryFile( InputFile, p, m_FAST, OverrideAbortErrLev, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - + + ! make sure some linearization variables are consistant + if (.not. p%Linearize) p%CalcSteady = .false. + if (.not. p%CalcSteady) p%TrimCase = TrimCase_none + m_FAST%Lin%FoundSteady = .false. + p%LinInterpOrder = p%InterpOrder ! 1 ! always use linear (or constant) interpolation on rotor? + ! overwrite TMax if necessary) IF (PRESENT(TMax)) THEN p%TMax = TMax @@ -1642,16 +1670,16 @@ SUBROUTINE FAST_Init( p, y_FAST, t_initial, InputFile, ErrStat, ErrMsg, TMax, Tu p%n_TMax_m1 = CEILING( ( (p%TMax - t_initial) / p%DT ) ) - 1 ! We're going to go from step 0 to n_TMax (thus the -1 here) if (p%TMax < 1.0_DbKi) then ! log10(0) gives floating point divide-by-zero error - p%TChanLen = 10 + p%TChanLen = ChanLen else - p%TChanLen = max( 10, int(log10(p%TMax))+7 ) + p%TChanLen = max( ChanLen, int(log10(p%TMax))+7 ) end if p%OutFmt_t = 'F'//trim(num2lstr( p%TChanLen ))//'.4' ! 'F10.4' !............................................................................................................................... ! Do some error checking on the inputs (validation): !............................................................................................................................... - call ValidateInputData(p, ErrStat2, ErrMsg2) + call ValidateInputData(p, m_FAST, ErrStat2, ErrMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -1663,9 +1691,10 @@ SUBROUTINE FAST_Init( p, y_FAST, t_initial, InputFile, ErrStat, ErrMsg, TMax, Tu END SUBROUTINE FAST_Init !---------------------------------------------------------------------------------------------------------------------------------- !> This routine validates FAST data. -SUBROUTINE ValidateInputData(p, ErrStat, ErrMsg) +SUBROUTINE ValidateInputData(p, m_FAST, ErrStat, ErrMsg) TYPE(FAST_ParameterType), INTENT(INOUT) :: p !< The parameter data for the FAST (glue-code) simulation + TYPE(FAST_MiscVarType), INTENT(IN ) :: m_FAST !< The misc data for the FAST (glue-code) simulation INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message @@ -1705,11 +1734,11 @@ SUBROUTINE ValidateInputData(p, ErrStat, ErrMsg) CALL ChkRealFmtStr( p%OutFmt, 'OutFmt', p%FmtWidth, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF ( p%FmtWidth /= ChanLen ) CALL SetErrStat( ErrID_Warn, 'OutFmt produces a column width of '// & + IF ( p%WrTxtOutFile .and. p%FmtWidth /= ChanLen ) CALL SetErrStat( ErrID_Warn, 'OutFmt produces a column width of '// & TRIM(Num2LStr(p%FmtWidth))//' instead of '//TRIM(Num2LStr(ChanLen))//' characters.', ErrStat, ErrMsg, RoutineName ) IF ( p%WrTxtOutFile .AND. p%TChanLen > ChanLen ) THEN ! ( p%TMax > 9999.999_DbKi ) - CALL SetErrStat( ErrID_Warn, 'TMax is too large for a 10-character time column in text tabular (time-marching) output files.'// & + CALL SetErrStat( ErrID_Warn, 'TMax is too large for a '//trim(num2lstr(ChanLen))//'-character time column in text tabular (time-marching) output files.'// & ' Postprocessors with this limitation may not work.', ErrStat, ErrMsg, RoutineName ) END IF @@ -1759,31 +1788,47 @@ SUBROUTINE ValidateInputData(p, ErrStat, ErrMsg) END IF - if ( p%WrVTK == VTK_Unknown ) then - call SetErrStat(ErrID_Fatal, 'WrVTK must be 0 (none), 1 (initialization only), 2 (animation), or 3 (mode shapes).', ErrStat, ErrMsg, RoutineName) - else - if ( p%VTK_type == VTK_Unknown ) then - call SetErrStat(ErrID_Fatal, 'VTK_type must be 1 (surfaces), 2 (basic meshes:lines/points), or 3 (all meshes).', ErrStat, ErrMsg, RoutineName) - ! note I'm not going to write that 4 (old) is an option - end if - - if (p%WrVTK == VTK_ModeShapes .and. .not. p%Linearize) then - call SetErrStat(ErrID_Fatal, 'WrVTK cannot be 3 (mode shapes) when Linearize is false. (Mode shapes require linearization analysis.)', ErrStat, ErrMsg, RoutineName) - end if - end if - + if ( p%WrVTK == VTK_Unknown ) then + call SetErrStat(ErrID_Fatal, 'WrVTK must be 0 (none), 1 (initialization only), 2 (animation), or 3 (mode shapes).', ErrStat, ErrMsg, RoutineName) + else + if ( p%VTK_type == VTK_Unknown ) then + call SetErrStat(ErrID_Fatal, 'VTK_type must be 1 (surfaces), 2 (basic meshes:lines/points), or 3 (all meshes).', ErrStat, ErrMsg, RoutineName) + ! note I'm not going to write that 4 (old) is an option + end if + + if (p%WrVTK == VTK_ModeShapes .and. .not. p%Linearize) then + call SetErrStat(ErrID_Fatal, 'WrVTK cannot be 3 (mode shapes) when Linearize is false. (Mode shapes require linearization analysis.)', ErrStat, ErrMsg, RoutineName) + end if + end if + if (p%Linearize) then - if (.not. allocated(p%LinTimes)) then - call SetErrStat(ErrID_Fatal, 'NLinTimes must be at least 1 for linearization analysis.',ErrStat, ErrMsg, RoutineName) - else - do i=1,size(p%LinTimes) - if (p%LinTimes(i) < 0) call SetErrStat(ErrID_Fatal,'LinTimes must be positive values.',ErrStat, ErrMsg, RoutineName) - end do - do i=2,size(p%LinTimes) - if (p%LinTimes(i) <= p%LinTimes(i-1)) call SetErrStat(ErrID_Fatal,'LinTimes must be unique values entered in increasing order.',ErrStat, ErrMsg, RoutineName) - end do - end if - + + if (p%CalcSteady) then + if (p%NLinTimes < 1) call SetErrStat(ErrID_Fatal,'NLinTimes must be at least 1 for linearization analysis.',ErrStat, ErrMsg, RoutineName) + if (p%TrimCase /= TrimCase_yaw .and. p%TrimCase /= TrimCase_torque .and. p%TrimCase /= TrimCase_pitch) then + call SetErrStat(ErrID_Fatal,'TrimCase must be either 1, 2, or 3.',ErrStat, ErrMsg, RoutineName) + end if + + if (p%TrimTol <= epsilon(p%TrimTol)) call SetErrStat(ErrID_Fatal,'TrimTol must be larger than '//trim(num2lstr(epsilon(p%TrimTol)))//'.',ErrStat, ErrMsg, RoutineName) + if (p%Twr_Kdmp < 0.0_ReKi) call SetErrStat(ErrID_Fatal,'Twr_Kdmp must not be negative.',ErrStat, ErrMsg, RoutineName) + if (p%Bld_Kdmp < 0.0_ReKi) call SetErrStat(ErrID_Fatal,'Bld_Kdmp must not be negative.',ErrStat, ErrMsg, RoutineName) + else + + if (.not. allocated(m_FAST%Lin%LinTimes)) then + call SetErrStat(ErrID_Fatal, 'NLinTimes must be at least 1 for linearization analysis.',ErrStat, ErrMsg, RoutineName) + else + do i=1,p%NLinTimes + if (m_FAST%Lin%LinTimes(i) < 0) call SetErrStat(ErrID_Fatal,'LinTimes must be positive values.',ErrStat, ErrMsg, RoutineName) + end do + do i=2,p%NLinTimes + if (m_FAST%Lin%LinTimes(i) <= m_FAST%Lin%LinTimes(i-1)) call SetErrStat(ErrID_Fatal,'LinTimes must be unique values entered in increasing order.',ErrStat, ErrMsg, RoutineName) + end do + + if (m_FAST%Lin%LinTimes(p%NLinTimes) > p%TMax) call SetErrStat(ErrID_Info, 'Tmax is less than the last linearization time. Linearization analysis will not be performed after TMax.',ErrStat, ErrMsg, RoutineName) + end if + + end if + if (p%LinInputs < LIN_NONE .or. p%LinInputs > LIN_ALL) call SetErrStat(ErrID_Fatal,'LinInputs must be 0, 1, or 2.',ErrStat, ErrMsg, RoutineName) if (p%LinOutputs < LIN_NONE .or. p%LinOutputs > LIN_ALL) call SetErrStat(ErrID_Fatal,'LinOutputs must be 0, 1, or 2.',ErrStat, ErrMsg, RoutineName) @@ -1798,7 +1843,7 @@ SUBROUTINE ValidateInputData(p, ErrStat, ErrMsg) if (p%CompInflow == MODULE_OpFM) call SetErrStat(ErrID_Fatal,'Linearization is not implemented for the OpenFOAM coupling.',ErrStat, ErrMsg, RoutineName) if (p%CompAero == MODULE_AD14) call SetErrStat(ErrID_Fatal,'Linearization is not implemented for the AeroDyn v14 module.',ErrStat, ErrMsg, RoutineName) if (p%CompSub /= MODULE_None) call SetErrStat(ErrID_Fatal,'Linearization is not implemented for any of the substructure modules.',ErrStat, ErrMsg, RoutineName) - !if (p%CompMooring /= MODULE_None) call SetErrStat(ErrID_Fatal,'Linearization is not implemented for any of the mooring modules.',ErrStat, ErrMsg, RoutineName) + if (p%CompMooring /= MODULE_None .and. p%CompMooring /= MODULE_MAP) call SetErrStat(ErrID_Fatal,'Linearization is not implemented for the FEAMooring or MoorDyn mooring modules.',ErrStat, ErrMsg, RoutineName) if (p%CompIce /= MODULE_None) call SetErrStat(ErrID_Fatal,'Linearization is not implemented for any of the ice loading modules.',ErrStat, ErrMsg, RoutineName) end if @@ -1815,7 +1860,7 @@ SUBROUTINE ValidateInputData(p, ErrStat, ErrMsg) IF ( .NOT. EqualRealNos( p%DT_out, p%DT ) ) THEN IF ( p%DT_out < p%DT ) THEN CALL SetErrStat( ErrID_Fatal, 'DT_out must be at least DT ('//TRIM(Num2LStr(p%DT))//' s).', ErrStat, ErrMsg, RoutineName ) - ELSEIF ( .NOT. EqualRealNos( p%DT_out, p%DT * NINT(p%DT_out / p%DT ) ) ) THEN + ELSEIF ( .NOT. EqualRealNos( p%DT_out, p%DT * p%n_DT_Out ) ) THEN CALL SetErrStat( ErrID_Fatal, 'DT_out must be an integer multiple of DT.', ErrStat, ErrMsg, RoutineName ) END IF END IF @@ -1825,7 +1870,8 @@ SUBROUTINE ValidateInputData(p, ErrStat, ErrMsg) END SUBROUTINE ValidateInputData !---------------------------------------------------------------------------------------------------------------------------------- !> This routine initializes the output for the glue code, including writing the header for the primary output file. -SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, InitOutData_ED, InitOutData_BD, InitOutData_SrvD, InitOutData_AD14, InitOutData_AD, & +SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, InitOutData_ED, InitOutData_BD, InitOutData_SrvD, & + InitOutData_AD14, InitOutData_AD, & InitOutData_IfW, InitOutData_OpFM, InitOutData_HD, InitOutData_SD, InitOutData_ExtPtfm, InitOutData_MAP, & InitOutData_FEAM, InitOutData_MD, InitOutData_Orca, InitOutData_IceF, InitOutData_IceD, ErrStat, ErrMsg ) @@ -1859,7 +1905,6 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, InitOutData_ED, InitOutData_BD, Init ! Local variables. INTEGER(IntKi) :: I, J ! Generic index for DO loops. - INTEGER(IntKi) :: indxLast ! The index of the last value to be written to an array INTEGER(IntKi) :: indxNext ! The index of the next value to be written to an array INTEGER(IntKi) :: NumOuts ! number of channels to be written to the output file(s) @@ -1877,8 +1922,8 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, InitOutData_ED, InitOutData_BD, Init ! and save the module version info for later use, too: !...................................................... - y_FAST%Module_Ver( Module_ED ) = InitOutData_ED%Ver - y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_ED ) )) + y_FAST%Module_Ver( Module_ED ) = InitOutData_ED%Ver + y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_ED ) )) IF ( p_FAST%CompElast == Module_BD ) THEN y_FAST%Module_Ver( Module_BD ) = InitOutData_BD(1)%Ver ! call copy routine for this type if it every uses dynamic memory @@ -1956,6 +2001,7 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, InitOutData_ED, InitOutData_BD, Init do i=1,p_FAST%nBeams IF ( ALLOCATED( InitOutData_BD(i)%WriteOutputHdr) ) y_FAST%numOuts(Module_BD) = y_FAST%numOuts(Module_BD) + SIZE(InitOutData_BD(i)%WriteOutputHdr) end do +!ad14 doesn't have outputs: y_FAST%numOuts(Module_AD14) = 0 IF ( ALLOCATED( InitOutData_AD%WriteOutputHdr ) ) y_FAST%numOuts(Module_AD) = SIZE(InitOutData_AD%WriteOutputHdr) @@ -1983,28 +2029,24 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, InitOutData_ED, InitOutData_BD, Init y_FAST%ChannelNames(1) = 'Time' y_FAST%ChannelUnits(1) = '(s)' - indxLast = 1 indxNext = 2 + DO i=1,y_FAST%numOuts(Module_IfW) !InflowWind + y_FAST%ChannelNames(indxNext) = InitOutData_IfW%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = InitOutData_IfW%WriteOutputUnt(i) + indxNext = indxNext + 1 + END DO - IF ( y_FAST%numOuts(Module_IfW) > 0_IntKi ) THEN - indxLast = indxNext + y_FAST%numOuts(Module_IfW) - 1 - y_FAST%ChannelNames(indxNext:indxLast) = InitOutData_IfW%WriteOutputHdr - y_FAST%ChannelUnits(indxNext:indxLast) = InitOutData_IfW%WriteOutputUnt - indxNext = indxLast + 1 - ELSEIF ( y_FAST%numOuts(Module_OpFM) > 0_IntKi ) THEN - indxLast = indxNext + y_FAST%numOuts(Module_OpFM) - 1 - y_FAST%ChannelNames(indxNext:indxLast) = InitOutData_OpFM%WriteOutputHdr - y_FAST%ChannelUnits(indxNext:indxLast) = InitOutData_OpFM%WriteOutputUnt - indxNext = indxLast + 1 - END IF - + DO i=1,y_FAST%numOuts(Module_OpFM) !OpenFOAM + y_FAST%ChannelNames(indxNext) = InitOutData_OpFM%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = InitOutData_OpFM%WriteOutputUnt(i) + indxNext = indxNext + 1 + END DO - IF ( y_FAST%numOuts(Module_ED) > 0_IntKi ) THEN !ElastoDyn - indxLast = indxNext + y_FAST%numOuts(Module_ED) - 1 - y_FAST%ChannelNames(indxNext:indxLast) = InitOutData_ED%WriteOutputHdr - y_FAST%ChannelUnits(indxNext:indxLast) = InitOutData_ED%WriteOutputUnt - indxNext = indxLast + 1 - END IF + DO i=1,y_FAST%numOuts(Module_ED) !ElastoDyn + y_FAST%ChannelNames(indxNext) = InitOutData_ED%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = InitOutData_ED%WriteOutputUnt(i) + indxNext = indxNext + 1 + END DO IF ( y_FAST%numOuts(Module_BD) > 0_IntKi ) THEN !BeamDyn do i=1,p_FAST%nBeams @@ -2019,73 +2061,69 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, InitOutData_ED, InitOutData_BD, Init END IF - ! none for AeroDyn14 - - IF ( y_FAST%numOuts(Module_AD) > 0_IntKi ) THEN !AeroDyn - indxLast = indxNext + y_FAST%numOuts(Module_AD) - 1 - y_FAST%ChannelNames(indxNext:indxLast) = InitOutData_AD%WriteOutputHdr - y_FAST%ChannelUnits(indxNext:indxLast) = InitOutData_AD%WriteOutputUnt - indxNext = indxLast + 1 - END IF - - - IF ( y_FAST%numOuts(Module_SrvD) > 0_IntKi ) THEN !ServoDyn - indxLast = indxNext + y_FAST%numOuts(Module_SrvD) - 1 - y_FAST%ChannelNames(indxNext:indxLast) = InitOutData_SrvD%WriteOutputHdr - y_FAST%ChannelUnits(indxNext:indxLast) = InitOutData_SrvD%WriteOutputUnt - indxNext = indxLast + 1 - END IF - - IF ( y_FAST%numOuts(Module_HD) > 0_IntKi ) THEN !HydroDyn - indxLast = indxNext + y_FAST%numOuts(Module_HD) - 1 - y_FAST%ChannelNames(indxNext:indxLast) = InitOutData_HD%WriteOutputHdr - y_FAST%ChannelUnits(indxNext:indxLast) = InitOutData_HD%WriteOutputUnt - indxNext = indxLast + 1 - END IF - - - IF ( y_FAST%numOuts(Module_SD) > 0_IntKi ) THEN !SubDyn - indxLast = indxNext + y_FAST%numOuts(Module_SD) - 1 - y_FAST%ChannelNames(indxNext:indxLast) = InitOutData_SD%WriteOutputHdr - y_FAST%ChannelUnits(indxNext:indxLast) = InitOutData_SD%WriteOutputUnt - indxNext = indxLast + 1 - ELSEIF ( y_FAST%numOuts(Module_ExtPtfm) > 0_IntKi ) THEN !ExtPtfm_MCKF - indxLast = indxNext + y_FAST%numOuts(Module_ExtPtfm) - 1 - y_FAST%ChannelNames(indxNext:indxLast) = InitOutData_ExtPtfm%WriteOutputHdr - y_FAST%ChannelUnits(indxNext:indxLast) = InitOutData_ExtPtfm%WriteOutputUnt - indxNext = indxLast + 1 - END IF - - - IF ( y_FAST%numOuts(Module_MAP) > 0_IntKi ) THEN !MAP - indxLast = indxNext + y_FAST%numOuts(Module_MAP) - 1 - y_FAST%ChannelNames(indxNext:indxLast) = InitOutData_MAP%WriteOutputHdr - y_FAST%ChannelUnits(indxNext:indxLast) = InitOutData_MAP%WriteOutputUnt - indxNext = indxLast + 1 - ELSEIF ( y_FAST%numOuts(Module_MD) > 0_IntKi ) THEN !MoorDyn - indxLast = indxNext + y_FAST%numOuts(Module_MD) - 1 - y_FAST%ChannelNames(indxNext:indxLast) = InitOutData_MD%WriteOutputHdr - y_FAST%ChannelUnits(indxNext:indxLast) = InitOutData_MD%WriteOutputUnt - indxNext = indxLast + 1 - ELSEIF ( y_FAST%numOuts(Module_FEAM) > 0_IntKi ) THEN !FEAMooring - indxLast = indxNext + y_FAST%numOuts(Module_FEAM) - 1 - y_FAST%ChannelNames(indxNext:indxLast) = InitOutData_FEAM%WriteOutputHdr - y_FAST%ChannelUnits(indxNext:indxLast) = InitOutData_FEAM%WriteOutputUnt - indxNext = indxLast + 1 - ELSEIF ( y_FAST%numOuts(Module_Orca) > 0_IntKi ) THEN !OrcaFlex - indxLast = indxNext + y_FAST%numOuts(Module_Orca) - 1 - y_FAST%ChannelNames(indxNext:indxLast) = InitOutData_Orca%WriteOutputHdr - y_FAST%ChannelUnits(indxNext:indxLast) = InitOutData_Orca%WriteOutputUnt - indxNext = indxLast + 1 - END IF - - - IF ( y_FAST%numOuts(Module_IceF) > 0_IntKi ) THEN !IceFloe - indxLast = indxNext + y_FAST%numOuts(Module_IceF) - 1 - y_FAST%ChannelNames(indxNext:indxLast) = InitOutData_IceF%WriteOutputHdr - y_FAST%ChannelUnits(indxNext:indxLast) = InitOutData_IceF%WriteOutputUnt - indxNext = indxLast + 1 - ELSEIF ( y_FAST%numOuts(Module_IceD) > 0_IntKi ) THEN !IceDyn + ! none for AeroDyn14 + + DO i=1,y_FAST%numOuts(Module_AD) !AeroDyn + y_FAST%ChannelNames(indxNext) = InitOutData_AD%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = InitOutData_AD%WriteOutputUnt(i) + indxNext = indxNext + 1 + END DO + + DO i=1,y_FAST%numOuts(Module_SrvD) !ServoDyn + y_FAST%ChannelNames(indxNext) = InitOutData_SrvD%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = InitOutData_SrvD%WriteOutputUnt(i) + indxNext = indxNext + 1 + END DO + + DO i=1,y_FAST%numOuts(Module_HD) !HydroDyn + y_FAST%ChannelNames(indxNext) = InitOutData_HD%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = InitOutData_HD%WriteOutputUnt(i) + indxNext = indxNext + 1 + END DO + + DO i=1,y_FAST%numOuts(Module_SD) !SubDyn + y_FAST%ChannelNames(indxNext) = InitOutData_SD%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = InitOutData_SD%WriteOutputUnt(i) + indxNext = indxNext + 1 + END DO + + DO i=1,y_FAST%numOuts(Module_ExtPtfm) !ExtPtfm_MCKF + y_FAST%ChannelNames(indxNext) = InitOutData_ExtPtfm%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = InitOutData_ExtPtfm%WriteOutputUnt(i) + indxNext = indxNext + 1 + END DO + + DO i=1,y_FAST%numOuts(Module_MAP) !MAP + y_FAST%ChannelNames(indxNext) = InitOutData_MAP%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = InitOutData_MAP%WriteOutputUnt(i) + indxNext = indxNext + 1 + END DO + + DO i=1,y_FAST%numOuts(Module_MD) !MoorDyn + y_FAST%ChannelNames(indxNext) = InitOutData_MD%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = InitOutData_MD%WriteOutputUnt(i) + indxNext = indxNext + 1 + END DO + + DO i=1,y_FAST%numOuts(Module_FEAM) !FEAMooring + y_FAST%ChannelNames(indxNext) = InitOutData_FEAM%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = InitOutData_FEAM%WriteOutputUnt(i) + indxNext = indxNext + 1 + END DO + + DO i=1,y_FAST%numOuts(Module_Orca) !OrcaFlex + y_FAST%ChannelNames(indxNext) = InitOutData_Orca%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = InitOutData_Orca%WriteOutputUnt(i) + indxNext = indxNext + 1 + END DO + + DO i=1,y_FAST%numOuts(Module_IceF) !IceFloe + y_FAST%ChannelNames(indxNext) = InitOutData_IceF%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = InitOutData_IceF%WriteOutputUnt(i) + indxNext = indxNext + 1 + END DO + + IF ( y_FAST%numOuts(Module_IceD) > 0_IntKi ) THEN !IceDyn DO I=1,p_FAST%numIceLegs DO J=1,SIZE(InitOutData_IceD%WriteOutputHdr) y_FAST%ChannelNames(indxNext) =TRIM(InitOutData_IceD%WriteOutputHdr(J))//'L'//TRIM(Num2Lstr(I)) !bjj: do we want this "Lx" at the end? @@ -2102,6 +2140,17 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, InitOutData_ED, InitOutData_BD, Init IF (p_FAST%WrTxtOutFile) THEN + y_FAST%ActualChanLen = max( ChanLen, p_FAST%FmtWidth ) + DO I=1,NumOuts + y_FAST%ActualChanLen = max( y_FAST%ActualChanLen, LEN_TRIM(y_FAST%ChannelNames(I)) ) + y_FAST%ActualChanLen = max( y_FAST%ActualChanLen, LEN_TRIM(y_FAST%ChannelUnits(I)) ) + ENDDO ! I + + y_FAST%OutFmt_a = '"'//p_FAST%Delim//'"'//p_FAST%OutFmt ! format for array elements from individual modules + if (p_FAST%FmtWidth < y_FAST%ActualChanLen) then + y_FAST%OutFmt_a = trim(y_FAST%OutFmt_a)//','//trim(num2lstr(y_FAST%ActualChanLen - p_FAST%FmtWidth))//'x' + end if + CALL GetNewUnit( y_FAST%UnOu, ErrStat, ErrMsg ) IF ( ErrStat >= AbortErrLev ) RETURN @@ -2120,12 +2169,21 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, InitOutData_ED, InitOutData_BD, Init !...................................................... ! Write the names of the output parameters on one line: !...................................................... + if (p_FAST%Delim /= " ") then ! trim trailing spaces if not space delimited: - CALL WrFileNR ( y_FAST%UnOu, y_FAST%ChannelNames(1) ) + CALL WrFileNR ( y_FAST%UnOu, trim(y_FAST%ChannelNames(1)) ) ! first one is time, with a special format - DO I=2,NumOuts - CALL WrFileNR ( y_FAST%UnOu, p_FAST%Delim//y_FAST%ChannelNames(I) ) - ENDDO ! I + DO I=2,NumOuts + CALL WrFileNR ( y_FAST%UnOu, p_FAST%Delim//trim(y_FAST%ChannelNames(I)) ) + ENDDO ! I + else + + CALL WrFileNR ( y_FAST%UnOu, y_FAST%ChannelNames(1)(1:p_FAST%TChanLen) ) ! first one is time, with a special format + + DO I=2,NumOuts + CALL WrFileNR ( y_FAST%UnOu, p_FAST%Delim//y_FAST%ChannelNames(I)(1:y_FAST%ActualChanLen) ) + ENDDO ! I + end if WRITE (y_FAST%UnOu,'()') @@ -2133,11 +2191,21 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, InitOutData_ED, InitOutData_BD, Init ! Write the units of the output parameters on one line: !...................................................... - CALL WrFileNR ( y_FAST%UnOu, y_FAST%ChannelUnits(1) ) + if (p_FAST%Delim /= " ") then + + CALL WrFileNR ( y_FAST%UnOu, trim(y_FAST%ChannelUnits(1)) ) - DO I=2,NumOuts - CALL WrFileNR ( y_FAST%UnOu, p_FAST%Delim//y_FAST%ChannelUnits(I) ) - ENDDO ! I + DO I=2,NumOuts + CALL WrFileNR ( y_FAST%UnOu, p_FAST%Delim//trim(y_FAST%ChannelUnits(I)) ) + ENDDO ! I + else + + CALL WrFileNR ( y_FAST%UnOu, y_FAST%ChannelUnits(1)(1:p_FAST%TChanLen) ) + + DO I=2,NumOuts + CALL WrFileNR ( y_FAST%UnOu, p_FAST%Delim//y_FAST%ChannelUnits(I)(1:y_FAST%ActualChanLen) ) + ENDDO ! I + end if WRITE (y_FAST%UnOu,'()') @@ -2152,6 +2220,7 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, InitOutData_ED, InitOutData_BD, Init y_FAST%NOutSteps = CEILING ( (p_FAST%TMax - p_FAST%TStart) / p_FAST%DT_OUT ) + 1 CALL AllocAry( y_FAST%AllOutData, NumOuts-1, y_FAST%NOutSteps, 'AllOutData', ErrStat, ErrMsg ) + y_FAST%AllOutData = 0.0_ReKi IF ( ErrStat >= AbortErrLev ) RETURN IF ( p_FAST%WrBinMod == FileFmtID_WithTime ) THEN ! we store the entire time array @@ -2176,12 +2245,13 @@ END SUBROUTINE FAST_InitOutput !---------------------------------------------------------------------------------------------------------------------------------- !> This routine reads in the primary FAST input file, does some validation, and places the values it reads in the !! parameter structure (p). It prints to an echo file if requested. -SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, OverrideAbortErrLev, ErrStat, ErrMsg ) +SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, m_FAST, OverrideAbortErrLev, ErrStat, ErrMsg ) IMPLICIT NONE ! Passed variables TYPE(FAST_ParameterType), INTENT(INOUT) :: p !< The parameter data for the FAST (glue-code) simulation + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables CHARACTER(*), INTENT(IN) :: InputFile !< Name of the file containing the primary input data LOGICAL, INTENT(IN) :: OverrideAbortErrLev !< Determines if we should override AbortErrLev INTEGER(IntKi), INTENT(OUT) :: ErrStat !< Error status @@ -2197,7 +2267,6 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, OverrideAbortErrLev, ErrStat, Err INTEGER(IntKi) :: IOS ! Temporary Error status INTEGER(IntKi) :: ErrStat2 ! Temporary Error status INTEGER(IntKi) :: OutFileFmt ! An integer that indicates what kind of tabular output should be generated (1=text, 2=binary, 3=both) - INTEGER(IntKi) :: NLinTimes ! An integer that indicates how many times to linearize LOGICAL :: Echo ! Determines if an echo file should be written LOGICAL :: TabDelim ! Determines if text output should be delimited by tabs (true) or space (false) CHARACTER(ErrMsgLen) :: ErrMsg2 ! Temporary Error message @@ -2706,6 +2775,8 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, OverrideAbortErrLev, ErrStat, Err end if END IF + p%n_DT_Out = NINT( p%DT_Out / p%DT ) + ! TStart - Time to begin tabular output (s): CALL ReadVar( UnIn, InputFile, p%TStart, "TStart", "Time to begin tabular output (s)", ErrStat2, ErrMsg2, UnEc) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2714,44 +2785,55 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, OverrideAbortErrLev, ErrStat, Err RETURN end if + + !> OutFileFmt - Format for tabular (time-marching) output file (switch) {1: text file [.out], 2: binary file [.outb], 4: HDF5 [.h5], add for combinations} + !! + !! Combinations of output files are possible by adding the values corresponding to each file. The possible combination of options are therefore + !! + !! | `OutFileFmt` | Description | + !! |:------------:|:-------------------------| + !! | 1 | Text file only `.out` | + !! | 2 | Binary file only `.outb` | + !! | 3 | Text and binary files | + !! | 4 | uncompressed binary file `.outbu` | + !! | 5 | Text and uncompressed binary files | + !! | 6 | Binary and uncompressed binary files | + !! | 7 | Text, Binary, and uncompressed binary files | + !! + ! OutFileFmt - Format for tabular (time-marching) output file(s) (1: text file [.out], 2: binary file [.outb], 3: both) (-): - CALL ReadVar( UnIn, InputFile, OutFileFmt, "OutFileFmt", "Format for tabular (time-marching) output file(s) (0: uncompressed binary and text file, 1: text file [.out], 2: compressed binary file [.outb], 3: both text and compressed binary) (-)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InputFile, OutFileFmt, "OutFileFmt", "Format for tabular (time-marching) output file(s) {0: uncompressed binary and text file, 1: text file [.out], 2: compressed binary file [.outb], 3: both text and compressed binary, 4: uncompressed binary .outbu]; add for combinations) (-)", ErrStat2, ErrMsg2, UnEc) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if ( ErrStat >= AbortErrLev ) then call cleanup() - RETURN + RETURN end if + + if (OutFileFmt == 0) OutFileFmt = 5 + + ! convert integer to binary representation of which file formats to generate: + p%WrTxtOutFile = mod(OutFileFmt,2) == 1 -#if defined COMPILE_SIMULINK || defined COMPILE_LABVIEW - !bjj: 2015-03-03: not sure this is still necessary... - p%WrBinMod = FileFmtID_WithTime ! We cannot guarantee the output time step is constant in binary files -#else - p%WrBinMod = FileFmtID_WithoutTime ! A format specifier for the binary output file format (1=include time channel as packed 32-bit binary; 2=don't include time channel;3=don't include time channel and do not pack data) -#endif - - SELECT CASE (OutFileFmt) - CASE (0_IntKi) - ! This is an undocumented feature for the regression testing system. It writes both text and binary output, but the binary is stored as uncompressed double floating point data instead of compressed int16 data. - p%WrBinOutFile = .TRUE. - p%WrBinMod = FileFmtID_NoCompressWithoutTime ! A format specifier for the binary output file format (3=don't include time channel and do not pack data) - p%WrTxtOutFile = .TRUE. - CASE (1_IntKi) - p%WrBinOutFile = .FALSE. - p%WrTxtOutFile = .TRUE. - CASE (2_IntKi) - p%WrBinOutFile = .TRUE. - p%WrTxtOutFile = .FALSE. - CASE (3_IntKi) - p%WrBinOutFile = .TRUE. - p%WrTxtOutFile = .TRUE. - CASE DEFAULT - CALL SetErrStat( ErrID_Fatal, "FAST's OutFileFmt must be 0, 1, 2, or 3.",ErrStat,ErrMsg,RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - END SELECT + OutFileFmt = OutFileFmt / 2 ! integer division + p%WrBinOutFile = mod(OutFileFmt,2) == 1 + + OutFileFmt = OutFileFmt / 2 ! integer division + if (mod(OutFileFmt,2) == 1) then + ! This is a feature for the regression testing system. It writes binary output stored as uncompressed double floating point data instead of compressed int16 data. + p%WrBinOutFile = .true. + p%WrBinMod = FileFmtID_NoCompressWithoutTime ! A format specifier for the binary output file format (3=don't include time channel and do not pack data) + else + p%WrBinMod = FileFmtID_WithoutTime ! A format specifier for the binary output file format (1=include time channel as packed 32-bit binary; 2=don't include time channel;3=don't include time channel and do not pack data) + end if + OutFileFmt = OutFileFmt / 2 ! integer division + + if (OutFileFmt /= 0) then + call SetErrStat( ErrID_Fatal, "OutFileFmt must be 0, 1, 2, or 3.",ErrStat,ErrMsg,RoutineName) + call cleanup() + return + end if + ! TabDelim - Use tab delimiters in text tabular output file? (flag): CALL ReadVar( UnIn, InputFile, TabDelim, "TabDelim", "Use tab delimiters in text tabular output file? (flag)", ErrStat2, ErrMsg2, UnEc) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2792,28 +2874,66 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, OverrideAbortErrLev, ErrStat, Err RETURN end if - ! NLinTimes - Number of times to linearize (-) [>=1] - CALL ReadVar( UnIn, InputFile, NLinTimes, "NLinTimes", "Number of times to linearize (-) [>=1]", ErrStat2, ErrMsg2, UnEc) + + ! CalcSteady - Calculate a steady-state periodic operating point before linearization? [unused if Linearize=False] (flag) + CALL ReadVar( UnIn, InputFile, p%CalcSteady, "CalcSteady", "Calculate a steady-state periodic operating point before linearization? (flag)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! TrimCase - Controller parameter to be trimmed {1:yaw; 2:torque; 3:pitch} [used only if CalcSteady=True] (-) + CALL ReadVar( UnIn, InputFile, p%TrimCase, "TrimCase", "Controller parameter to be trimmed {1:yaw; 2:torque; 3:pitch} (-)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! TrimTol - Tolerance for the rotational speed convergence [used only if CalcSteady=True] (-) + CALL ReadVar( UnIn, InputFile, p%TrimTol, "TrimTol", "Tolerance for the rotational speed convergence (-)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! TrimGain - Proportional gain for the rotational speed error (>0) [used only if CalcSteady=True] (rad/(rad/s) for yaw or pitch; Nm/(rad/s) for torque) + CALL ReadVar( UnIn, InputFile, p%TrimGain, "TrimGain", "Proportional gain for the rotational speed error (>0) (rad/(rad/s) for yaw or pitch; Nm/(rad/s) for torque)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! Twr_Kdmp - Damping factor for the tower [used only if CalcSteady=True] (N/(m/s)) + CALL ReadVar( UnIn, InputFile, p%Twr_Kdmp, "Twr_Kdmp", "Damping factor for the tower (N/(m/s))", ErrStat2, ErrMsg2, UnEc) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! Bld_Kdmp - Damping factor for the blades [used only if CalcSteady=True] (N/(m/s)) + CALL ReadVar( UnIn, InputFile, p%Bld_Kdmp, "Bld_Kdmp", "Damping factor for the blades (N/(m/s))", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then call cleanup() - RETURN + RETURN end if - + + ! NLinTimes - Number of times to linearize (or number of equally spaced azimuth steps in periodic linearized model) (-) [>=1] + CALL ReadVar( UnIn, InputFile, p%NLinTimes, "NLinTimes", "Number of times to linearize (-) [>=1]", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + if (.not. p%Linearize) then + p%CalcSteady = .false. + p%NLinTimes = 0 + end if + ! LinTimes - Times to linearize (s) [1 to NLinTimes] - if (p%Linearize .and. NLinTimes >= 1) then - call AllocAry( p%LinTimes, NLinTimes, 'p%LinTimes', ErrStat2, ErrMsg2 ) + if (.not. p%CalcSteady .and. p%NLinTimes >= 1 ) then + call AllocAry( m_FAST%Lin%LinTimes, p%NLinTimes, 'LinTimes', ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat < AbortErrLev) then - CALL ReadAry( UnIn, InputFile, p%LinTimes, NLinTimes, "LinTimes", "Times to linearize (s) [1 to NLinTimes]", ErrStat2, ErrMsg2, UnEc) - end if + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + CALL ReadAry( UnIn, InputFile, m_FAST%Lin%LinTimes, p%NLinTimes, "LinTimes", "Times to linearize (s) [1 to NLinTimes]", ErrStat2, ErrMsg2, UnEc) else CALL ReadCom( UnIn, InputFile, 'Times to linearize (s) [1 to NLinTimes] ', ErrStat2, ErrMsg2, UnEc ) end if CALL SetErrStat( ErrStat2, ErrMsg2,ErrStat,ErrMsg,RoutineName) if ( ErrStat >= AbortErrLev ) then call cleanup() - RETURN + RETURN end if ! LinInputs - Include inputs in linearization (switch) {0=none; 1=standard; 2=all module inputs (debug)} @@ -2921,19 +3041,19 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, OverrideAbortErrLev, ErrStat, Err end if ! now save the number of time steps between VTK file output: - IF (p%WrVTK == VTK_ModeShapes) THEN + IF (p%WrVTK == VTK_ModeShapes) THEN p%n_VTKTime = 1 ELSE IF (TmpTime > p%TMax) THEN p%n_VTKTime = HUGE(p%n_VTKTime) - ELSE + ELSE p%n_VTKTime = NINT( TmpTime / p%DT ) ! I'll warn if p%n_VTKTime*p%DT is not TmpTime - IF (p%WrVTK == VTK_Animate) THEN + IF (p%WrVTK == VTK_Animate) THEN TmpRate = p%n_VTKTime*p%DT if (.not. EqualRealNos(TmpRate, TmpTime)) then call SetErrStat(ErrID_Info, '1/VTK_fps is not an integer multiple of DT. FAST will output VTK information at '//& trim(num2lstr(1.0_DbKi/TmpRate))//' fps, the closest rate possible.',ErrStat,ErrMsg,RoutineName) - end if + end if END IF END IF @@ -2950,38 +3070,6 @@ end subroutine cleanup !............................................................................................................................... END SUBROUTINE FAST_ReadPrimaryFile !---------------------------------------------------------------------------------------------------------------------------------- -!> This function builds the path for the vtk directory based on the output file root -FUNCTION get_vtkdir_path( out_file_root ) - CHARACTER(1024) :: get_vtkdir_path - CHARACTER(*), INTENT(IN) :: out_file_root - INTEGER(IntKi) :: last_separator_index - - ! get the directory of the primary input file (i.e. the case directory); Windows can have either forward or backward slashes (compare with GetPath()) - - last_separator_index = index(out_file_root, '/', back=.true.) - last_separator_index = max( index(out_file_root, '\', back=.true.), last_separator_index ) - - if (last_separator_index==0) then - get_vtkdir_path = '.'//PathSep//'vtk' - else - get_vtkdir_path = trim(out_file_root(1 : last_separator_index) // 'vtk') - end if -END FUNCTION -!---------------------------------------------------------------------------------------------------------------------------------- -!> This function builds the path for the vtk root file name based on the output file root -FUNCTION get_vtkroot_path( out_file_root ) - CHARACTER(1024) :: get_vtkroot_path - CHARACTER(*), INTENT(IN) :: out_file_root - INTEGER(IntKi) :: last_separator_index - INTEGER(IntKi) :: path_length - - last_separator_index = index(out_file_root, '/', back=.true.) - last_separator_index = max( index(out_file_root, '\', back=.true.), last_separator_index ) - - get_vtkroot_path = trim( get_vtkdir_path(out_file_root) ) // PathSep & - // out_file_root( last_separator_index + 1 :) -END FUNCTION -!---------------------------------------------------------------------------------------------------------------------------------- !> This subroutine sets up some of the information needed for plotting VTK surfaces. It initializes only the data needed before !! HD initialization. (HD needs some of this data so it can return the wave elevation data we want.) SUBROUTINE SetVTKParameters_B4HD(p_FAST, InitOutData_ED, InitInData_HD, BD, ErrStat, ErrMsg) @@ -3011,7 +3099,8 @@ SUBROUTINE SetVTKParameters_B4HD(p_FAST, InitOutData_ED, InitInData_HD, BD, ErrS else BladeLength = InitOutData_ED%BladeLength end if - p_FAST%VTK_Surface%GroundRad = BladeLength + InitOutData_ED%HubRad + p_FAST%VTK_Surface%HubRad = InitOutData_ED%HubRad + p_FAST%VTK_Surface%GroundRad = BladeLength + p_FAST%VTK_Surface%HubRad !........................................................................................................ ! We don't use the rest of this routine for stick-figure output @@ -3066,39 +3155,59 @@ SUBROUTINE SetVTKParameters(p_FAST, InitOutData_ED, InitOutData_AD, InitInData_H REAL(SiKi) :: x, y REAL(SiKi) :: TwrDiam_top, TwrDiam_base, TwrRatio, TwrLength INTEGER(IntKi) :: topNode, baseNode - INTEGER(IntKi) :: tipNode, rootNode, cylNode INTEGER(IntKi) :: NumBl, k - CHARACTER(1024) :: VTK_path + CHARACTER(1024) :: vtkroot INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SetVTKParameters' - + + ErrStat = ErrID_None ErrMsg = "" + ! get the name of the output directory for vtk files (in a subdirectory called "vtk" of the output directory), and ! create the VTK directory if it does not exist - call MKDIR( get_vtkdir_path(p_FAST%OutFileRoot) ) + + call GetPath ( p_FAST%OutFileRoot, p_FAST%VTK_OutFileRoot, vtkroot ) ! the returned p_FAST%VTK_OutFileRoot includes a file separator character at the end + p_FAST%VTK_OutFileRoot = trim(p_FAST%VTK_OutFileRoot) // 'vtk' + + call MKDIR( trim(p_FAST%VTK_OutFileRoot) ) + + p_FAST%VTK_OutFileRoot = trim( p_FAST%VTK_OutFileRoot ) // PathSep // trim(vtkroot) + + + ! calculate the number of digits in 'y_FAST%NOutSteps' (Maximum number of output steps to be written) + ! this will be used to pad the write-out step in the VTK filename with zeros in calls to MeshWrVTK() + if (p_FAST%WrVTK == VTK_ModeShapes .AND. p_FAST%VTK_modes%VTKLinTim==1) then + if (p_FAST%NLinTimes < 1) p_FAST%NLinTimes = 1 !in case we reached here with an error + p_FAST%VTK_tWidth = CEILING( log10( real( p_FAST%NLinTimes) ) ) + 1 + else + p_FAST%VTK_tWidth = CEILING( log10( real(p_FAST%n_TMax_m1+1, ReKi) / p_FAST%n_VTKTime ) ) + 1 + end if + + ! determine number of blades + NumBl = SIZE(ED%Output(1)%BladeRootMotion,1) ! initialize the vtk data - p_FAST%VTK_Surface%NumSectors = 18 - p_FAST%VTK_Surface%HubRad = InitOutData_ED%HubRad - ! NOTE: we set p_FAST%VTK_Surface%GroundRad in SetVTKParameters_B4HD + p_FAST%VTK_Surface%NumSectors = 25 + ! NOTE: we set p_FAST%VTK_Surface%GroundRad and p_FAST%VTK_Surface%HubRad in SetVTKParameters_B4HD + + ! write the ground or seabed reference polygon: - VTK_path = get_vtkroot_path( p_FAST%OutFileRoot ) RefPoint = p_FAST%TurbinePos if (p_FAST%CompHydro == MODULE_HD) then RefLengths = p_FAST%VTK_Surface%GroundRad*VTK_GroundFactor/2.0_SiKi ! note that p_FAST%TurbinePos(3) must be 0 for offshore turbines RefPoint(3) = p_FAST%TurbinePos(3) - InitOutData_HD%WtrDpth - call WrVTK_Ground ( RefPoint, RefLengths, trim(VTK_path) // '.SeabedSurface', ErrStat2, ErrMsg2 ) + call WrVTK_Ground ( RefPoint, RefLengths, trim(p_FAST%VTK_OutFileRoot) // '.SeabedSurface', ErrStat2, ErrMsg2 ) RefPoint(3) = p_FAST%TurbinePos(3) - InitOutData_HD%MSL2SWL - call WrVTK_Ground ( RefPoint, RefLengths, trim(VTK_path) // '.StillWaterSurface', ErrStat2, ErrMsg2 ) + call WrVTK_Ground ( RefPoint, RefLengths, trim(p_FAST%VTK_OutFileRoot) // '.StillWaterSurface', ErrStat2, ErrMsg2 ) else RefLengths = p_FAST%VTK_Surface%GroundRad !array = scalar - call WrVTK_Ground ( RefPoint, RefLengths, trim(VTK_path) // '.GroundSurface', ErrStat2, ErrMsg2 ) + call WrVTK_Ground ( RefPoint, RefLengths, trim(p_FAST%VTK_OutFileRoot) // '.GroundSurface', ErrStat2, ErrMsg2 ) end if @@ -3108,8 +3217,9 @@ SUBROUTINE SetVTKParameters(p_FAST, InitOutData_ED, InitOutData_AD, InitInData_H !........................................................................................................ ! we're going to create a box using these dimensions - y = ED%Output(1)%HubPtMotion%Position(3, 1) - ED%Output(1)%NacelleMotion%Position(3, 1) - x = TwoNorm( ED%Output(1)%HubPtMotion%Position(1:2,1) - ED%Output(1)%NacelleMotion%Position(1:2,1) ) - InitOutData_ED%HubRad + y = ED%y%HubPtMotion%Position(3, 1) - ED%y%NacelleMotion%Position(3, 1) + x = TwoNorm( ED%y%HubPtMotion%Position(1:2,1) - ED%y%NacelleMotion%Position(1:2,1) ) - p_FAST%VTK_Surface%HubRad + p_FAST%VTK_Surface%NacelleBox(:,1) = (/ -x, y, 0.0_SiKi /) p_FAST%VTK_Surface%NacelleBox(:,2) = (/ x, y, 0.0_SiKi /) @@ -3124,27 +3234,28 @@ SUBROUTINE SetVTKParameters(p_FAST, InitOutData_ED, InitOutData_AD, InitInData_H ! tapered tower !....................... - CALL AllocAry(p_FAST%VTK_Surface%TowerRad,ED%Output(1)%TowerLn2Mesh%NNodes,'VTK_Surface%TowerRad',ErrStat2,ErrMsg2) + CALL AllocAry(p_FAST%VTK_Surface%TowerRad,ED%y%TowerLn2Mesh%NNodes,'VTK_Surface%TowerRad',ErrStat2,ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF (ErrStat >= AbortErrLev) RETURN - - topNode = ED%Output(1)%TowerLn2Mesh%NNodes - 1 - baseNode = ED%Output(1)%TowerLn2Mesh%NNodes - TwrLength = TwoNorm( ED%Output(1)%TowerLn2Mesh%position(:,topNode) - ED%Output(1)%TowerLn2Mesh%position(:,baseNode) ) ! this is the assumed length of the tower + + topNode = ED%y%TowerLn2Mesh%NNodes - 1 + baseNode = ED%y%TowerLn2Mesh%refNode + TwrLength = TwoNorm( ED%y%TowerLn2Mesh%position(:,topNode) - ED%y%TowerLn2Mesh%position(:,baseNode) ) ! this is the assumed length of the tower TwrRatio = TwrLength / 87.6_SiKi ! use ratio of the tower length to the length of the 5MW tower TwrDiam_top = 3.87*TwrRatio TwrDiam_base = 6.0*TwrRatio TwrRatio = 0.5 * (TwrDiam_top - TwrDiam_base) / TwrLength - do k=1,ED%Output(1)%TowerLn2Mesh%NNodes - TwrLength = TwoNorm( ED%Output(1)%TowerLn2Mesh%position(:,k) - ED%Output(1)%TowerLn2Mesh%position(:,baseNode) ) + do k=1,ED%y%TowerLn2Mesh%NNodes + TwrLength = TwoNorm( ED%y%TowerLn2Mesh%position(:,k) - ED%y%TowerLn2Mesh%position(:,baseNode) ) p_FAST%VTK_Surface%TowerRad(k) = 0.5*TwrDiam_Base + TwrRatio*TwrLength end do + + !....................... ! blade surfaces !....................... - NumBl = SIZE(ED%Output(1)%BladeRootMotion,1) allocate(p_FAST%VTK_Surface%BladeShape(NumBl),stat=ErrStat2) if (errStat2/=0) then call setErrStat(ErrID_Fatal,'Error allocating VTK_Surface%BladeShape.',ErrStat,ErrMsg,RoutineName) @@ -3193,11 +3304,11 @@ SUBROUTINE SetVTKParameters(p_FAST, InitOutData_ED, InitOutData_AD, InitInData_H END DO ELSE DO K=1,NumBl - rootNode = ED%Output(1)%BladeLn2Mesh(K)%NNodes - tipNode = ED%Output(1)%BladeLn2Mesh(K)%NNodes-1 - cylNode = min(2,ED%Output(1)%BladeLn2Mesh(K)%NNodes) + rootNode = ED%y%BladeLn2Mesh(K)%NNodes + tipNode = ED%y%BladeLn2Mesh(K)%NNodes-1 + cylNode = min(2,ED%y%BladeLn2Mesh(K)%NNodes) - call SetVTKDefaultBladeParams(ED%Output(1)%BladeLn2Mesh(K), p_FAST%VTK_Surface%BladeShape(K), tipNode, rootNode, cylNode, ErrStat2, ErrMsg2) + call SetVTKDefaultBladeParams(ED%y%BladeLn2Mesh(K), p_FAST%VTK_Surface%BladeShape(K), tipNode, rootNode, cylNode, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF (ErrStat >= AbortErrLev) RETURN END DO @@ -3219,6 +3330,7 @@ SUBROUTINE SetVTKParameters(p_FAST, InitOutData_ED, InitOutData_AD, InitInData_H p_FAST%VTK_Surface%WaveElevXY(:,k) = p_FAST%VTK_Surface%WaveElevXY(:,k) + p_FAST%TurbinePos(1:2) end do + ! note that p_FAST%TurbinePos(3) must be 0 for offshore turbines !do k=1,size(p_FAST%VTK_Surface%WaveElev,2) ! p_FAST%VTK_Surface%WaveElev(:,k) = p_FAST%VTK_Surface%WaveElev(:,k) + p_FAST%TurbinePos(3) ! not sure this is really accurate if p_FAST%TurbinePos(3) is non-zero !end do @@ -3688,10 +3800,10 @@ SUBROUTINE FAST_WrSum( p_FAST, y_FAST, MeshMapData, ErrStat, ErrMsg ) WRITE (y_FAST%UnSum, Fmt ) y_FAST%Module_Ver(Module_Number)%Name, p_FAST%DT_module(Module_Number), p_FAST%n_substeps(Module_Number) END IF END DO - IF ( NINT( p_FAST%DT_out / p_FAST%DT ) == 1_IntKi ) THEN + IF ( p_FAST%n_DT_Out == 1_IntKi ) THEN WRITE (y_FAST%UnSum, Fmt ) "FAST output files", p_FAST%DT_out, 1_IntKi ! we'll write "1" instead of "1^-1" ELSE - WRITE (y_FAST%UnSum, Fmt ) "FAST output files", p_FAST%DT_out, NINT( p_FAST%DT_out / p_FAST%DT ),"^-1" + WRITE (y_FAST%UnSum, Fmt ) "FAST output files", p_FAST%DT_out, p_FAST%n_DT_Out,"^-1" END IF IF (p_FAST%WrVTK == VTK_Animate) THEN @@ -3703,16 +3815,17 @@ SUBROUTINE FAST_WrSum( p_FAST, y_FAST, MeshMapData, ErrStat, ErrMsg ) ELSE WRITE (y_FAST%UnSum, Fmt ) "VTK output files ", TmpRate, p_FAST%n_VTKTime,"^-1" END IF - + ELSE + TmpRate = p_FAST%VTK_fps + END IF + ! bjj: fix this; possibly add names of which files will be generated? - if (p_FAST%WrVTK == VTK_Animate) then - Fmt = '(2X,A17,2X,'//TRIM(p_FAST%OutFmt)//',:,T37,:,A)' + IF (p_FAST%WrVTK == VTK_Animate .or. p_FAST%WrVTK == VTK_ModeShapes) THEN + Fmt = '(2X,A17,2X,'//TRIM(p_FAST%OutFmt)//',:,T37,:,A)' - WRITE (y_FAST%UnSum,'(//,2X,A)') " Requested Visualization Output" - WRITE (y_FAST%UnSum, '(2X,A)') "-------------------------------------------------" - WRITE (y_FAST%UnSum, Fmt ) "Frame rate", 1.0_DbKi/TmpRate, " fps" - end if - + WRITE (y_FAST%UnSum,'(//,2X,A)') " Requested Visualization Output" + WRITE (y_FAST%UnSum, '(2X,A)') "-------------------------------------------------" + WRITE (y_FAST%UnSum, Fmt ) "Frame rate", 1.0_DbKi/TmpRate, " fps" END IF @@ -3803,6 +3916,8 @@ SUBROUTINE FAST_Solution0(p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, O ! 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 @@ -3814,8 +3929,11 @@ SUBROUTINE FAST_Solution0(p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, O ErrStat = ErrID_None ErrMsg = "" + t_initial = m_FAST%t_global ! which is used in place of t_global_next + y_FAST%WriteThisStep = NeedWriteOutput(n_t_global_next, t_initial, p_FAST) + IF (p_FAST%WrSttsTime) then - CALL SimStatus_FirstTime( m_FAST%TiLstPrn, m_FAST%PrevClockTime, m_FAST%SimStrtTime, m_FAST%UsrTime2, m_FAST%t_global, p_FAST%TMax, p_FAST%TDesc ) + 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 @@ -3824,10 +3942,10 @@ SUBROUTINE FAST_Solution0(p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, O ! the initial ServoDyn and IfW/Lidar inputs from Simulink: IF ( p_FAST%CompServo == Module_SrvD ) CALL SrvD_SetExternalInputs( p_FAST, m_FAST, SrvD%Input(1) ) - IF ( p_FAST%CompInflow == Module_IfW ) CALL IfW_SetExternalInputs( IfW%p, m_FAST, ED%Output(1), IfW%Input(1) ) + IF ( p_FAST%CompInflow == Module_IfW ) CALL IfW_SetExternalInputs( IfW%p, m_FAST, ED%y, IfW%Input(1) ) - CALL CalcOutputs_And_SolveForInputs( n_t_global, m_FAST%t_global, STATE_CURR, m_FAST%calcJacobian, m_FAST%NextJacCalcTime, & - p_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, & + CALL CalcOutputs_And_SolveForInputs( n_t_global, t_initial, STATE_CURR, m_FAST%calcJacobian, m_FAST%NextJacCalcTime, & + p_FAST, m_FAST, y_FAST%WriteThisStep, ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, & MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -3836,29 +3954,14 @@ SUBROUTINE FAST_Solution0(p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, O ! Check to see if we should output data this time step: !---------------------------------------------------------------------------------------- - CALL WriteOutputToFile(0, m_FAST%t_global, p_FAST, y_FAST, ED, BD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2) + CALL WriteOutputToFile(n_t_global_next, t_initial, p_FAST, y_FAST, ED, BD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! turn off VTK output when if (p_FAST%WrVTK == VTK_InitOnly) then ! Write visualization data for initialization (and also note that we're ignoring any errors that occur doing so) - IF ( p_FAST%VTK_Type == VTK_Surf ) THEN - CALL WrVTK_Surfaces(m_FAST%t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD14, AD, IfW, OpFM, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) - ELSE IF ( p_FAST%VTK_Type == VTK_Basic ) THEN - CALL WrVTK_BasicMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD14, AD, IfW, OpFM, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) - ELSE IF ( p_FAST%VTK_Type == VTK_All ) THEN - CALL WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) - ELSE IF (p_FAST%VTK_Type==VTK_Old) THEN - CALL WriteInputMeshesToFile( ED%Input(1), AD%Input(1), SD%Input(1), HD%Input(1), MAPp%Input(1), BD%Input(1,:), TRIM(p_FAST%OutFileRoot)//'.InputMeshes.bin', ErrStat2, ErrMsg2) - !unOut = -1 - !CALL MeshWrBin ( unOut, AD%y%BladeLoad(2), ErrStat2, ErrMsg2, 'AD_2_ED_loads.bin'); IF (ErrStat2 /= ErrID_None) CALL WrScr(TRIM(ErrMsg2)) - !CALL MeshWrBin ( unOut, ED%Input(1)%BladePtLoads(2),ErrStat2, ErrMsg2, 'AD_2_ED_loads.bin'); IF (ErrStat2 /= ErrID_None) CALL WrScr(TRIM(ErrMsg2)) - !CALL MeshMapWrBin( unOut, AD%y%BladeLoad(2), ED%Input(1)%BladePtLoads(2), MeshMapData%AD_L_2_BDED_B(2), ErrStat2, ErrMsg2, 'AD_2_ED_loads.bin' ); IF (ErrStat2 /= ErrID_None) CALL WrScr(TRIM(ErrMsg2)) - !close( unOut ) - END IF - - y_FAST%VTK_count = y_FAST%VTK_count + 1 + call WriteVTK(t_initial, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) end if @@ -3922,6 +4025,7 @@ SUBROUTINE FAST_InitIOarrays( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, A ! 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 !ED_OutputTimes(j) = t_initial - (j - 1) * dt @@ -3930,16 +4034,10 @@ SUBROUTINE FAST_InitIOarrays( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, A 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 ) - - CALL ED_CopyOutput (ED%Output(1), ED%Output(j), 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_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 ) - CALL ED_CopyOutput (ED%Output(1), ED%y, MESH_NEWCOPY, Errstat2, ErrMsg2) ! do this to initialize meshes/allocatable arrays for output of ExtrapInterp routine - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! Initialize predicted states for j_pc loop: CALL ED_CopyContState (ED%x( STATE_CURR), ED%x( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -4391,10 +4489,15 @@ SUBROUTINE FAST_Solution(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, ! local variables REAL(DbKi) :: t_global_next ! next simulation time (m_FAST%t_global + p_FAST%dt) + INTEGER(IntKi) :: n_t_global_next ! n_t_global + 1 INTEGER(IntKi) :: j_pc ! predictor-corrector loop counter INTEGER(IntKi) :: NumCorrections ! number of corrections for this time step + INTEGER(IntKi), parameter :: MaxCorrections = 20 ! maximum number of corrections allowed + LOGICAL :: WriteThisStep ! Whether WriteOutput values will be printed INTEGER(IntKi) :: I, k ! generic loop counters + + !REAL(ReKi) :: ControlInputGuess ! value of controller inputs INTEGER(IntKi) :: ErrStat2 @@ -4405,8 +4508,11 @@ SUBROUTINE FAST_Solution(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, 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 + t_global_next = t_initial + n_t_global_next*p_FAST%DT ! = m_FAST%t_global + p_FAST%dt + + y_FAST%WriteThisStep = NeedWriteOutput(n_t_global_next, t_global_next, p_FAST) + !! determine if the Jacobian should be calculated this time IF ( m_FAST%calcJacobian ) THEN ! this was true (possibly at initialization), so we'll advance the time for the next calculation of the Jacobian @@ -4440,13 +4546,16 @@ SUBROUTINE FAST_Solution(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, !! !! gives predicted values at t+dt !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - CALL FAST_ExtrapInterpMods( t_global_next, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, HD, SD, ExtPtfm, & + CALL FAST_ExtrapInterpMods( t_global_next, p_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, HD, SD, ExtPtfm, & MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) !! predictor-corrector loop: - DO j_pc = 0, NumCorrections + j_pc = 0 + do while (j_pc <= NumCorrections) + WriteThisStep = y_FAST%WriteThisStep .AND. j_pc==NumCorrections + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !! ## Step 1.b: Advance states (yield state and constraint values at t_global_next) !! @@ -4455,23 +4564,43 @@ SUBROUTINE FAST_Solution(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ CALL FAST_AdvanceStates( t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, & - MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) + MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2, WriteThisStep ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (ErrStat >= AbortErrLev) RETURN !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !! ## Step 1.c: Input-Output Solve !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - + ! save predicted inputs for comparison with corrected value later + !IF (p_FAST%CheckHSSBrTrqC) THEN + ! ControlInputGuess = ED%Input(1)%HSSBrTrqC + !END IF + CALL CalcOutputs_And_SolveForInputs( n_t_global, t_global_next, STATE_PRED, m_FAST%calcJacobian, m_FAST%NextJacCalcTime, & - p_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) + p_FAST, m_FAST, WriteThisStep, ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (ErrStat >= AbortErrLev) RETURN !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !! ## Step 2: Correct (continue in loop) !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - + j_pc = j_pc + 1 + + ! ! Check if the predicted inputs were significantly different than the corrected inputs + ! ! (values before and after CalcOutputs_And_SolveForInputs) + !if (j_pc > NumCorrections) then + ! + ! !if (p_FAST%CheckHSSBrTrqC) then + ! ! if ( abs(ControlInputGuess - ED%Input(1)%HSSBrTrqC) > 50.0_ReKi ) then ! I randomly picked 50 N-m + ! ! NumCorrections = min(p_FAST%NumCrctn + 1, MaxCorrections) + ! ! ! print *, 'correction:', t_global_next, NumCorrections + ! ! cycle + ! ! end if + ! !end if + ! + ! ! check pitch position input to structural code (not implemented, yet) + !end if + enddo ! j_pc !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ @@ -4667,7 +4796,7 @@ SUBROUTINE FAST_Solution(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, !! Check to see if we should output data this time step: !---------------------------------------------------------------------------------------- - CALL WriteOutputToFile(n_t_global+1, m_FAST%t_global, p_FAST, y_FAST, ED, BD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, & + CALL WriteOutputToFile(n_t_global_next, t_global_next, p_FAST, y_FAST, ED, BD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, & SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -4676,8 +4805,9 @@ SUBROUTINE FAST_Solution(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, !---------------------------------------------------------------------------------------- IF (p_FAST%WrSttsTime) then - IF ( MOD( n_t_global + 1, p_FAST%n_SttsTime ) == 0 ) THEN - CALL SimStatus( m_FAST%TiLstPrn, m_FAST%PrevClockTime, m_FAST%t_global, p_FAST%TMax, p_FAST%TDesc ) + IF ( MOD( n_t_global_next, p_FAST%n_SttsTime ) == 0 ) THEN + CALL SimStatus( m_FAST%TiLstPrn, m_FAST%PrevClockTime, m_FAST%t_global, p_FAST%TMax, p_FAST%TDesc ) + ENDIF ENDIF @@ -4685,8 +4815,24 @@ END SUBROUTINE FAST_Solution !---------------------------------------------------------------------------------------------------------------------------------- ! ROUTINES TO OUTPUT WRITE DATA TO FILE AT EACH REQUSTED TIME STEP !---------------------------------------------------------------------------------------------------------------------------------- -!> This routine determines if it's time to write to the output files, and calls the routine to write to the files -!! with the output data. It should be called after all the output solves for a given time have been completed. +FUNCTION NeedWriteOutput(n_t_global, t_global, p_FAST) + INTEGER(IntKi), INTENT(IN ) :: n_t_global !< Current global time step + REAL(DbKi), INTENT(IN ) :: t_global !< Current global time + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + + LOGICAL :: NeedWriteOutput !< Function result; if true, WriteOutput values are needed on this time step + + IF ( t_global >= p_FAST%TStart ) THEN ! note that if TStart isn't an multiple of DT_out, we will not necessarially start output to the file at TStart + NeedWriteOutput = MOD( n_t_global, p_FAST%n_DT_Out ) == 0 + ELSE + NeedWriteOutput = .FALSE. + END IF + +END FUNCTION NeedWriteOutput +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine determines if it's time to write to the output files--based on a previous call to fast_subs::needwriteoutput--, and +!! calls the routine to write to the files with the output data. It should be called after all the output solves for a given time +!! have been completed, and assumes y_FAST\%WriteThisStep has been set. SUBROUTINE WriteOutputToFile(n_t_global, t_global, p_FAST, y_FAST, ED, BD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, & SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg) !............................................................................................................................... @@ -4717,9 +4863,6 @@ SUBROUTINE WriteOutputToFile(n_t_global, t_global, p_FAST, y_FAST, ED, BD, AD14, CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(DbKi) :: OutTime ! Used to determine if output should be generated at this simulation time - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMSg2 CHARACTER(*), PARAMETER :: RoutineName = 'WriteOutputToFile' ErrStat = ErrID_None @@ -4727,43 +4870,26 @@ SUBROUTINE WriteOutputToFile(n_t_global, t_global, p_FAST, y_FAST, ED, BD, AD14, ! Write time-series channel data - IF ( t_global >= p_FAST%TStart ) THEN - - !bjj FIX THIS algorithm!!! this assumes dt_out is an integer multiple of dt; we will probably have to do some interpolation to get these outputs at the times we want them.... - !bjj: perhaps we should do this with integer math on n_t_global now... - OutTime = NINT( t_global / p_FAST%DT_out ) * p_FAST%DT_out - IF ( EqualRealNos( t_global, OutTime ) ) THEN + !y_FAST%WriteThisStep = NeedWriteOutput(n_t_global, t_global, p_FAST) + IF ( y_FAST%WriteThisStep ) THEN - ! Generate glue-code output file + ! Generate glue-code output file - CALL WrOutputLine( t_global, p_FAST, y_FAST, IfW%y%WriteOutput, OpFM%y%WriteOutput, ED%Output(1)%WriteOutput, & - AD%y%WriteOutput, SrvD%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 ) - - END IF + CALL WrOutputLine( t_global, p_FAST, y_FAST, IfW%y%WriteOutput, OpFM%y%WriteOutput, ED%y%WriteOutput, & + AD%y%WriteOutput, SrvD%y%WriteOutput, HD%y%WriteOutput, SD%y%WriteOutput, ExtPtfm%y%WriteOutput, MAPp%y%WriteOutput, & + FEAM%y%WriteOutput, MD%y%WriteOutput, Orca%y%WriteOutput, IceF%y%WriteOutput, IceD%y, BD%y, ErrStat, ErrMsg ) ENDIF ! Write visualization data (and also note that we're ignoring any errors that occur doing so) IF ( p_FAST%WrVTK == VTK_Animate ) THEN IF ( MOD( n_t_global, p_FAST%n_VTKTime ) == 0 ) THEN - - IF ( p_FAST%VTK_Type == VTK_Surf ) THEN - CALL WrVTK_Surfaces(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD14, AD, IfW, OpFM, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) - ELSE IF ( p_FAST%VTK_Type == VTK_Basic ) THEN - CALL WrVTK_BasicMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD14, AD, IfW, OpFM, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) - ELSE IF ( p_FAST%VTK_Type == VTK_All ) THEN - CALL WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) - ELSE IF (p_FAST%VTK_Type==VTK_Old) THEN - CALL WriteMotionMeshesToFile(t_global, ED%Output(1), 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') - END IF - - y_FAST%VTK_count = y_FAST%VTK_count + 1 + call WriteVTK(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) END IF END IF -END SUBROUTINE WriteOutputToFile +END SUBROUTINE WriteOutputToFile !---------------------------------------------------------------------------------------------------------------------------------- !> This routine writes the module output to the primary output file(s). SUBROUTINE WrOutputLine( t, p_FAST, y_FAST, IfWOutput, OpFMOutput, EDOutput, ADOutput, SrvDOutput, HDOutput, SDOutput, ExtPtfmOutput,& @@ -4866,7 +4992,7 @@ SUBROUTINE FillOutputAry_T(Turbine, Outputs) CALL FillOutputAry(Turbine%p_FAST, Turbine%y_FAST, Turbine%IfW%y%WriteOutput, Turbine%OpFM%y%WriteOutput, & - Turbine%ED%Output(1)%WriteOutput, Turbine%AD%y%WriteOutput, Turbine%SrvD%y%WriteOutput, & + Turbine%ED%y%WriteOutput, Turbine%AD%y%WriteOutput, Turbine%SrvD%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) @@ -4993,8 +5119,56 @@ SUBROUTINE FillOutputAry(p_FAST, y_FAST, IfWOutput, OpFMOutput, EDOutput, ADOutp END SUBROUTINE FillOutputAry !---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE WriteVTK(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) + REAL(DbKi), INTENT(IN ) :: t_global !< Current global time + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code (only because we're updating VTK_LastWaveIndx) + TYPE(FAST_ModuleMapType), INTENT(IN ) :: MeshMapData !< Data for mapping between modules + + TYPE(ElastoDyn_Data), INTENT(IN ) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(IN ) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(IN ) :: SrvD !< ServoDyn data + TYPE(AeroDyn_Data), INTENT(IN ) :: AD !< AeroDyn data + TYPE(InflowWind_Data), INTENT(IN ) :: IfW !< InflowWind data + TYPE(OpenFOAM_Data), INTENT(IN ) :: OpFM !< OpenFOAM data + TYPE(HydroDyn_Data), INTENT(IN ) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(IN ) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(IN ) :: ExtPtfm !< ExtPtfm_MCKF data + TYPE(MAP_Data), INTENT(IN ) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(IN ) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(IN ) :: MD !< MoorDyn data + TYPE(OrcaFlex_Data), INTENT(IN ) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(IN ) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(IN ) :: IceD !< All the IceDyn data used in time-step loop + + + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMSg2 + CHARACTER(*), PARAMETER :: RoutineName = 'WriteVTK' + + + IF ( p_FAST%VTK_Type == VTK_Surf ) THEN + CALL WrVTK_Surfaces(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) + ELSE IF ( p_FAST%VTK_Type == VTK_Basic ) THEN + CALL WrVTK_BasicMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) + ELSE IF ( p_FAST%VTK_Type == VTK_All ) THEN + CALL WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) + ELSE IF (p_FAST%VTK_Type==VTK_Old) THEN + CALL WriteInputMeshesToFile( ED%Input(1), AD%Input(1), SD%Input(1), HD%Input(1), MAPp%Input(1), BD%Input(1,:), TRIM(p_FAST%OutFileRoot)//'.InputMeshes.bin', ErrStat2, ErrMsg2) + CALL WriteMotionMeshesToFile(t_global, ED%y, SD%Input(1), SD%y, HD%Input(1), MAPp%Input(1), BD%y, BD%Input(1,:), y_FAST%UnGra, ErrStat2, ErrMsg2, TRIM(p_FAST%OutFileRoot)//'.gra') + !unOut = -1 + !CALL MeshWrBin ( unOut, AD%y%BladeLoad(2), ErrStat2, ErrMsg2, 'AD_2_ED_loads.bin'); IF (ErrStat2 /= ErrID_None) CALL WrScr(TRIM(ErrMsg2)) + !CALL MeshWrBin ( unOut, ED%Input(1)%BladePtLoads(2),ErrStat2, ErrMsg2, 'AD_2_ED_loads.bin'); IF (ErrStat2 /= ErrID_None) CALL WrScr(TRIM(ErrMsg2)) + !CALL MeshMapWrBin( unOut, AD%y%BladeLoad(2), ED%Input(1)%BladePtLoads(2), MeshMapData%AD_L_2_BDED_B(2), ErrStat2, ErrMsg2, 'AD_2_ED_loads.bin' ); IF (ErrStat2 /= ErrID_None) CALL WrScr(TRIM(ErrMsg2)) + !close( unOut ) + END IF + + y_FAST%VTK_count = y_FAST%VTK_count + 1 + +END SUBROUTINE WriteVTK +!---------------------------------------------------------------------------------------------------------------------------------- !> This routine writes all the committed meshes to VTK-formatted files. It doesn't bother with returning an error code. -SUBROUTINE WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) +SUBROUTINE WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code TYPE(FAST_OutputFileType),INTENT(IN ) :: y_FAST !< Output variables for the glue code @@ -5003,7 +5177,6 @@ SUBROUTINE WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD14, AD, IfW, O TYPE(ElastoDyn_Data), INTENT(IN ) :: ED !< ElastoDyn data TYPE(BeamDyn_Data), INTENT(IN ) :: BD !< BeamDyn data TYPE(ServoDyn_Data), INTENT(IN ) :: SrvD !< ServoDyn data - TYPE(AeroDyn14_Data), INTENT(IN ) :: AD14 !< AeroDyn14 data TYPE(AeroDyn_Data), INTENT(IN ) :: AD !< AeroDyn data TYPE(InflowWind_Data), INTENT(IN ) :: IfW !< InflowWind data TYPE(OpenFOAM_Data), INTENT(IN ) :: OpFM !< OpenFOAM data @@ -5019,54 +5192,45 @@ SUBROUTINE WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD14, AD, IfW, O logical :: outputFields ! flag to determine if we want to output the HD mesh fields - INTEGER(IntKi) :: NumBl, k, Twidth - CHARACTER(1024) :: VTK_path + INTEGER(IntKi) :: NumBl, k + INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMSg2 CHARACTER(*), PARAMETER :: RoutineName = 'WrVTK_AllMeshes' - ! Calculate the number of digits for the maximum number of output steps to be written. - ! This will be used to pad the write-out step in the VTK filename with zeros in calls to MeshWrVTK() - if ( (p_FAST%n_VTKTime>0) .and. (p_FAST%n_TMax_m1+1>0) ) then - Twidth = CEILING( log10( real(p_FAST%n_TMax_m1+1, ReKi) / p_FAST%n_VTKTime ) ) + 1 - else - Twidth = 1 - endif + NumBl = 0 - if (allocated(ED%Output)) then - if (allocated(ED%Output(1)%BladeRootMotion)) then - NumBl = SIZE(ED%Output(1)%BladeRootMotion) - end if + if (allocated(ED%y%BladeRootMotion)) then + NumBl = SIZE(ED%y%BladeRootMotion) end if - - VTK_path = get_vtkroot_path( p_FAST%OutFileRoot ) + ! I'm first going to just put all of the meshes that get mapped together, then decide if we're going to print/plot them all ! ElastoDyn - if (allocated(ED%Output) .and. allocated(ED%Input)) then + if (allocated(ED%Input)) then ! ElastoDyn outputs (motions) DO K=1,NumBl !%BladeLn2Mesh(K) used only when not BD (see below) - call MeshWrVTK(p_FAST%TurbinePos, ED%Output(1)%BladeRootMotion(K), trim(VTK_path)//'.ED_BladeRootMotion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth ) + call MeshWrVTK(p_FAST%TurbinePos, ED%y%BladeRootMotion(K), trim(p_FAST%VTK_OutFileRoot)//'.ED_BladeRootMotion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) END DO - call MeshWrVTK(p_FAST%TurbinePos, ED%Output(1)%TowerLn2Mesh, trim(VTK_path)//'.ED_TowerLn2Mesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth ) + call MeshWrVTK(p_FAST%TurbinePos, ED%y%TowerLn2Mesh, trim(p_FAST%VTK_OutFileRoot)//'.ED_TowerLn2Mesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) ! these will get output with their sibling input meshes - !call MeshWrVTK(p_FAST%TurbinePos, ED%Output(1)%HubPtMotion, trim(p_FAST%OutFileRoot)//'.ED_HubPtMotion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) - !call MeshWrVTK(p_FAST%TurbinePos, ED%Output(1)%NacelleMotion, trim(p_FAST%OutFileRoot)//'.ED_NacelleMotion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) - !call MeshWrVTK(p_FAST%TurbinePos, ED%Output(1)%PlatformPtMesh, trim(p_FAST%OutFileRoot)//'.ED_PlatformPtMesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) + !call MeshWrVTK(p_FAST%TurbinePos, ED%y%HubPtMotion, trim(p_FAST%VTK_OutFileRoot)//'.ED_HubPtMotion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + !call MeshWrVTK(p_FAST%TurbinePos, ED%y%NacelleMotion, trim(p_FAST%VTK_OutFileRoot)//'.ED_NacelleMotion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + !call MeshWrVTK(p_FAST%TurbinePos, ED%y%PlatformPtMesh, trim(p_FAST%VTK_OutFileRoot)//'.ED_PlatformPtMesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) ! ElastoDyn inputs (loads) ! %BladePtLoads used only when not BD (see below) - call MeshWrVTK(p_FAST%TurbinePos, ED%Input(1)%TowerPtLoads, trim(VTK_path)//'.ED_TowerPtLoads', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, ED%Output(1)%TowerLn2Mesh ) - call MeshWrVTK(p_FAST%TurbinePos, ED%Input(1)%HubPtLoad, trim(VTK_path)//'.ED_Hub', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, ED%Output(1)%HubPtMotion ) - call MeshWrVTK(p_FAST%TurbinePos, ED%Input(1)%NacelleLoads, trim(VTK_path)//'.ED_Nacelle' ,y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, ED%Output(1)%NacelleMotion ) - call MeshWrVTK(p_FAST%TurbinePos, ED%Input(1)%PlatformPtMesh, trim(VTK_path)//'.ED_PlatformPtMesh', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, ED%Output(1)%PlatformPtMesh ) + 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)%PlatformPtMesh, trim(p_FAST%VTK_OutFileRoot)//'.ED_PlatformPtMesh', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, ED%y%PlatformPtMesh ) end if @@ -5075,51 +5239,51 @@ SUBROUTINE WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD14, AD, IfW, O do K=1,NumBl ! BeamDyn inputs - !call MeshWrVTK(p_FAST%TurbinePos, BD%Input(1,k)%RootMotion, trim(p_FAST%OutFileRoot)//'.BD_RootMotion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) - call MeshWrVTK(p_FAST%TurbinePos, BD%Input(1,k)%HubMotion, trim(VTK_path)//'.BD_HubMotion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth ) + !call MeshWrVTK(p_FAST%TurbinePos, BD%Input(1,k)%RootMotion, trim(p_FAST%VTK_OutFileRoot)//'.BD_RootMotion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + call MeshWrVTK(p_FAST%TurbinePos, BD%Input(1,k)%HubMotion, trim(p_FAST%VTK_OutFileRoot)//'.BD_HubMotion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) end do if (allocated(MeshMapData%y_BD_BldMotion_4Loads)) then do K=1,NumBl - call MeshWrVTK(p_FAST%TurbinePos, BD%Input(1,k)%DistrLoad, trim(VTK_path)//'.BD_DistrLoad'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, MeshMapData%y_BD_BldMotion_4Loads(k) ) + call MeshWrVTK(p_FAST%TurbinePos, BD%Input(1,k)%DistrLoad, trim(p_FAST%VTK_OutFileRoot)//'.BD_DistrLoad'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, MeshMapData%y_BD_BldMotion_4Loads(k) ) ! skipping PointLoad end do elseif (p_FAST%BD_OutputSibling) then do K=1,NumBl - call MeshWrVTK(p_FAST%TurbinePos, BD%Input(1,k)%DistrLoad, trim(p_FAST%OutFileRoot)//'.BD_Blade'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, BD%y(k)%BldMotion ) + call MeshWrVTK(p_FAST%TurbinePos, BD%Input(1,k)%DistrLoad, trim(p_FAST%VTK_OutFileRoot)//'.BD_Blade'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, BD%y(k)%BldMotion ) ! skipping PointLoad end do end if do K=1,NumBl ! BeamDyn outputs - call MeshWrVTK(p_FAST%TurbinePos, BD%y(k)%ReactionForce, trim(p_FAST%OutFileRoot)//'.BD_ReactionForce_RootMotion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, BD%Input(1,k)%RootMotion ) + call MeshWrVTK(p_FAST%TurbinePos, BD%y(k)%ReactionForce, trim(p_FAST%VTK_OutFileRoot)//'.BD_ReactionForce_RootMotion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, BD%Input(1,k)%RootMotion ) end do if (.not. p_FAST%BD_OutputSibling) then !otherwise this mesh has been put with the DistrLoad mesh do K=1,NumBl ! BeamDyn outputs - call MeshWrVTK(p_FAST%TurbinePos, BD%y(k)%BldMotion, trim(p_FAST%OutFileRoot)//'.BD_BldMotion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth ) + call MeshWrVTK(p_FAST%TurbinePos, BD%y(k)%BldMotion, trim(p_FAST%VTK_OutFileRoot)//'.BD_BldMotion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) end do end if - ELSE if (allocated(ED%Input) .and. allocated(ED%Output)) then + ELSE if (p_FAST%CompElast == Module_ED .and. allocated(ED%Input)) then ! ElastoDyn DO K=1,NumBl - call MeshWrVTK(p_FAST%TurbinePos, ED%Output(1)%BladeLn2Mesh(K), trim(VTK_path)//'.ED_BladeLn2Mesh_motion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth ) - call MeshWrVTK(p_FAST%TurbinePos, ED%Input(1)%BladePtLoads(K), trim(VTK_path)//'.ED_BladePtLoads'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, ED%Output(1)%BladeLn2Mesh(K) ) + call MeshWrVTK(p_FAST%TurbinePos, ED%y%BladeLn2Mesh(K), trim(p_FAST%VTK_OutFileRoot)//'.ED_BladeLn2Mesh_motion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + call MeshWrVTK(p_FAST%TurbinePos, ED%Input(1)%BladePtLoads(K), trim(p_FAST%VTK_OutFileRoot)//'.ED_BladePtLoads'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, ED%y%BladeLn2Mesh(K) ) END DO END IF ! ServoDyn if (allocated(SrvD%Input)) then IF ( SrvD%Input(1)%NTMD%Mesh%Committed ) THEN - !call MeshWrVTK(p_FAST%TurbinePos, SrvD%Input(1)%NTMD%Mesh, trim(p_FAST%OutFileRoot)//'.SrvD_NTMD_Motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) - call MeshWrVTK(p_FAST%TurbinePos, SrvD%y%NTMD%Mesh, trim(VTK_path)//'.SrvD_NTMD', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, SrvD%Input(1)%TTMD%Mesh ) + !call MeshWrVTK(p_FAST%TurbinePos, SrvD%Input(1)%NTMD%Mesh, trim(p_FAST%VTK_OutFileRoot)//'.SrvD_NTMD_Motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + call MeshWrVTK(p_FAST%TurbinePos, SrvD%y%NTMD%Mesh, trim(p_FAST%VTK_OutFileRoot)//'.SrvD_NTMD', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, SrvD%Input(1)%TTMD%Mesh ) END IF IF ( SrvD%Input(1)%TTMD%Mesh%Committed ) THEN - !call MeshWrVTK(p_FAST%TurbinePos, SrvD%Input(1)%TTMD%Mesh, trim(p_FAST%OutFileRoot)//'.SrvD_TTMD_Motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) - call MeshWrVTK(p_FAST%TurbinePos, SrvD%y%TTMD%Mesh, trim(VTK_path)//'.SrvD_TTMD', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, SrvD%Input(1)%TTMD%Mesh ) + !call MeshWrVTK(p_FAST%TurbinePos, SrvD%Input(1)%TTMD%Mesh, trim(p_FAST%VTK_OutFileRoot)//'.SrvD_TTMD_Motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + call MeshWrVTK(p_FAST%TurbinePos, SrvD%y%TTMD%Mesh, trim(p_FAST%VTK_OutFileRoot)//'.SrvD_TTMD', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, SrvD%Input(1)%TTMD%Mesh ) END IF end if @@ -5130,16 +5294,16 @@ SUBROUTINE WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD14, AD, IfW, O if (allocated(AD%Input(1)%BladeRootMotion)) then DO K=1,NumBl - call MeshWrVTK(p_FAST%TurbinePos, AD%Input(1)%BladeRootMotion(K), trim(VTK_path)//'.AD_BladeRootMotion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth ) - !call MeshWrVTK(p_FAST%TurbinePos, AD%Input(1)%BladeMotion(K), trim(p_FAST%OutFileRoot)//'.AD_BladeMotion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) + call MeshWrVTK(p_FAST%TurbinePos, AD%Input(1)%BladeRootMotion(K), trim(p_FAST%VTK_OutFileRoot)//'.AD_BladeRootMotion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + !call MeshWrVTK(p_FAST%TurbinePos, AD%Input(1)%BladeMotion(K), trim(p_FAST%VTK_OutFileRoot)//'.AD_BladeMotion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) END DO - call MeshWrVTK(p_FAST%TurbinePos, AD%Input(1)%HubMotion, trim(VTK_path)//'.AD_HubMotion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth ) - !call MeshWrVTK(p_FAST%TurbinePos, AD%Input(1)%TowerMotion, trim(p_FAST%OutFileRoot)//'.AD_TowerMotion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) + call MeshWrVTK(p_FAST%TurbinePos, AD%Input(1)%HubMotion, trim(p_FAST%VTK_OutFileRoot)//'.AD_HubMotion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + !call MeshWrVTK(p_FAST%TurbinePos, AD%Input(1)%TowerMotion, trim(p_FAST%VTK_OutFileRoot)//'.AD_TowerMotion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) DO K=1,NumBl - call MeshWrVTK(p_FAST%TurbinePos, AD%y%BladeLoad(K), trim(VTK_path)//'.AD_Blade'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, AD%Input(1)%BladeMotion(k) ) + call MeshWrVTK(p_FAST%TurbinePos, AD%y%BladeLoad(K), trim(p_FAST%VTK_OutFileRoot)//'.AD_Blade'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, AD%Input(1)%BladeMotion(k) ) END DO - call MeshWrVTK(p_FAST%TurbinePos, AD%y%TowerLoad, trim(VTK_path)//'.AD_Tower', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, AD%Input(1)%TowerMotion ) + call MeshWrVTK(p_FAST%TurbinePos, AD%y%TowerLoad, trim(p_FAST%VTK_OutFileRoot)//'.AD_Tower', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, AD%Input(1)%TowerMotion ) end if @@ -5147,60 +5311,60 @@ SUBROUTINE WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD14, AD, IfW, O ! HydroDyn IF ( p_FAST%CompHydro == Module_HD .and. allocated(HD%Input)) THEN - !call MeshWrVTK(p_FAST%TurbinePos, HD%Input(1)%Mesh, trim(p_FAST%OutFileRoot)//'.HD_Mesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) - !call MeshWrVTK(p_FAST%TurbinePos, HD%Input(1)%Morison%LumpedMesh, trim(p_FAST%OutFileRoot)//'.HD_MorisonLumped_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) - !call MeshWrVTK(p_FAST%TurbinePos, HD%Input(1)%Morison%DistribMesh, trim(p_FAST%OutFileRoot)//'.HD_MorisonDistrib_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) + !call MeshWrVTK(p_FAST%TurbinePos, HD%Input(1)%Mesh, trim(p_FAST%VTK_OutFileRoot)//'.HD_Mesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) + !call MeshWrVTK(p_FAST%TurbinePos, HD%Input(1)%Morison%LumpedMesh, trim(p_FAST%VTK_OutFileRoot)//'.HD_MorisonLumped_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) + !call MeshWrVTK(p_FAST%TurbinePos, HD%Input(1)%Morison%DistribMesh, trim(p_FAST%VTK_OutFileRoot)//'.HD_MorisonDistrib_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) if (p_FAST%CompSub == Module_NONE) then - call MeshWrVTK(p_FAST%TurbinePos, HD%y%AllHdroOrigin, trim(VTK_path)//'.HD_AllHdroOrigin', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, HD%Input(1)%Mesh ) + call MeshWrVTK(p_FAST%TurbinePos, HD%y%AllHdroOrigin, trim(p_FAST%VTK_OutFileRoot)//'.HD_AllHdroOrigin', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, HD%Input(1)%Mesh ) outputFields = .false. else - call MeshWrVTK(p_FAST%TurbinePos, HD%y%Mesh, trim(VTK_path)//'.HD_Mesh', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, HD%Input(1)%Mesh ) + call MeshWrVTK(p_FAST%TurbinePos, HD%y%Mesh, trim(p_FAST%VTK_OutFileRoot)//'.HD_Mesh', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, HD%Input(1)%Mesh ) outputFields = p_FAST%VTK_fields end if - call MeshWrVTK(p_FAST%TurbinePos, HD%y%Morison%LumpedMesh, trim(VTK_path)//'.HD_MorisonLumped', y_FAST%VTK_count, outputFields, ErrStat2, ErrMsg2, Twidth, HD%Input(1)%Morison%LumpedMesh ) - call MeshWrVTK(p_FAST%TurbinePos, HD%y%Morison%DistribMesh, trim(VTK_path)//'.HD_MorisonDistrib', y_FAST%VTK_count, outputFields, ErrStat2, ErrMsg2, Twidth, HD%Input(1)%Morison%DistribMesh ) + call MeshWrVTK(p_FAST%TurbinePos, HD%y%Morison%LumpedMesh, trim(p_FAST%VTK_OutFileRoot)//'.HD_MorisonLumped', y_FAST%VTK_count, outputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, HD%Input(1)%Morison%LumpedMesh ) + call MeshWrVTK(p_FAST%TurbinePos, HD%y%Morison%DistribMesh, trim(p_FAST%VTK_OutFileRoot)//'.HD_MorisonDistrib', y_FAST%VTK_count, outputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, HD%Input(1)%Morison%DistribMesh ) END IF ! SubDyn IF ( p_FAST%CompSub == Module_SD .and. allocated(SD%Input)) THEN - !call MeshWrVTK(p_FAST%TurbinePos, SD%Input(1)%TPMesh, trim(p_FAST%OutFileRoot)//'.SD_TPMesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) - call MeshWrVTK(p_FAST%TurbinePos, SD%Input(1)%LMesh, trim(VTK_path)//'.SD_LMesh_y2Mesh', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, SD%y%y2Mesh ) + !call MeshWrVTK(p_FAST%TurbinePos, SD%Input(1)%TPMesh, trim(p_FAST%VTK_OutFileRoot)//'.SD_TPMesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + call MeshWrVTK(p_FAST%TurbinePos, SD%Input(1)%LMesh, trim(p_FAST%VTK_OutFileRoot)//'.SD_LMesh_y2Mesh', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, SD%y%y2Mesh ) - call MeshWrVTK(p_FAST%TurbinePos, SD%y%y1Mesh, trim(VTK_path)//'.SD_y1Mesh_TPMesh', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, SD%Input(1)%TPMesh ) - !call MeshWrVTK(p_FAST%TurbinePos, SD%y%y2Mesh, trim(p_FAST%OutFileRoot)//'.SD_y2Mesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) + call MeshWrVTK(p_FAST%TurbinePos, SD%y%y1Mesh, trim(p_FAST%VTK_OutFileRoot)//'.SD_y1Mesh_TPMesh', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, SD%Input(1)%TPMesh ) + !call MeshWrVTK(p_FAST%TurbinePos, SD%y%y2Mesh, trim(p_FAST%VTK_OutFileRoot)//'.SD_y2Mesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) ELSE IF ( p_FAST%CompSub == Module_ExtPtfm .and. allocated(ExtPtfm%Input)) THEN - call MeshWrVTK(p_FAST%TurbinePos, ExtPtfm%y%PtfmMesh, trim(VTK_path)//'.ExtPtfm', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, ExtPtfm%Input(1)%PtfmMesh ) + call MeshWrVTK(p_FAST%TurbinePos, ExtPtfm%y%PtfmMesh, trim(p_FAST%VTK_OutFileRoot)//'.ExtPtfm', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, ExtPtfm%Input(1)%PtfmMesh ) END IF ! MAP IF ( p_FAST%CompMooring == Module_MAP ) THEN if (allocated(MAPp%Input)) then - call MeshWrVTK(p_FAST%TurbinePos, MAPp%y%PtFairleadLoad, trim(VTK_path)//'.MAP_PtFairlead', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, MAPp%Input(1)%PtFairDisplacement ) - !call MeshWrVTK(p_FAST%TurbinePos, MAPp%Input(1)%PtFairDisplacement, trim(p_FAST%OutFileRoot)//'.MAP_PtFair_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) + call MeshWrVTK(p_FAST%TurbinePos, MAPp%y%PtFairleadLoad, trim(p_FAST%VTK_OutFileRoot)//'.MAP_PtFairlead', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, MAPp%Input(1)%PtFairDisplacement ) + !call MeshWrVTK(p_FAST%TurbinePos, MAPp%Input(1)%PtFairDisplacement, trim(p_FAST%VTK_OutFileRoot)//'.MAP_PtFair_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) end if ! MoorDyn ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN if (allocated(MD%Input)) then - call MeshWrVTK(p_FAST%TurbinePos, MD%y%PtFairleadLoad, trim(VTK_path)//'.MD_PtFairlead', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, MD%Input(1)%PtFairleadDisplacement ) - !call MeshWrVTK(p_FAST%TurbinePos, MD%Input(1)%PtFairleadDisplacement, trim(p_FAST%OutFileRoot)//'.MD_PtFair_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) + call MeshWrVTK(p_FAST%TurbinePos, MD%y%PtFairleadLoad, trim(p_FAST%VTK_OutFileRoot)//'.MD_PtFairlead', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, MD%Input(1)%PtFairleadDisplacement ) + !call MeshWrVTK(p_FAST%TurbinePos, MD%Input(1)%PtFairleadDisplacement, trim(p_FAST%VTK_OutFileRoot)//'.MD_PtFair_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) end if ! FEAMooring ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN if (allocated(FEAM%Input)) then - call MeshWrVTK(p_FAST%TurbinePos, FEAM%y%PtFairleadLoad, trim(VTK_path)//'.FEAM_PtFairlead', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, FEAM%Input(1)%PtFairleadDisplacement ) - !call MeshWrVTK(p_FAST%TurbinePos, FEAM%Input(1)%PtFairleadDisplacement, trim(p_FAST%OutFileRoot)//'.FEAM_PtFair_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) + call MeshWrVTK(p_FAST%TurbinePos, FEAM%y%PtFairleadLoad, trim(p_FAST%VTK_OutFileRoot)//'.FEAM_PtFairlead', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, FEAM%Input(1)%PtFairleadDisplacement ) + !call MeshWrVTK(p_FAST%TurbinePos, FEAM%Input(1)%PtFairleadDisplacement, trim(p_FAST%VTK_OutFileRoot)//'.FEAM_PtFair_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) end if ! Orca ELSEIF ( p_FAST%CompMooring == Module_Orca ) THEN if (allocated(Orca%Input)) then - call MeshWrVTK(p_FAST%TurbinePos, Orca%y%PtfmMesh, trim(VTK_path)//'.Orca_PtfmMesh', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, Orca%Input(1)%PtfmMesh ) - !call MeshWrVTK(p_FAST%TurbinePos, Orca%Input(1)%PtfmMesh, trim(p_FAST%OutFileRoot)//'.Orca_PtfmMesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) + call MeshWrVTK(p_FAST%TurbinePos, Orca%y%PtfmMesh, trim(p_FAST%VTK_OutFileRoot)//'.Orca_PtfmMesh', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, Orca%Input(1)%PtfmMesh ) + !call MeshWrVTK(p_FAST%TurbinePos, Orca%Input(1)%PtfmMesh, trim(p_FAST%VTK_OutFileRoot)//'.Orca_PtfmMesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) end if END IF @@ -5208,8 +5372,8 @@ SUBROUTINE WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD14, AD, IfW, O ! IceFloe IF ( p_FAST%CompIce == Module_IceF ) THEN if (allocated(IceF%Input)) then - call MeshWrVTK(p_FAST%TurbinePos, IceF%y%iceMesh, trim(VTK_path)//'.IceF_iceMesh', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, IceF%Input(1)%iceMesh ) - !call MeshWrVTK(p_FAST%TurbinePos, IceF%Input(1)%iceMesh, trim(p_FAST%OutFileRoot)//'.IceF_iceMesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) + call MeshWrVTK(p_FAST%TurbinePos, IceF%y%iceMesh, trim(p_FAST%VTK_OutFileRoot)//'.IceF_iceMesh', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, IceF%Input(1)%iceMesh ) + !call MeshWrVTK(p_FAST%TurbinePos, IceF%Input(1)%iceMesh, trim(p_FAST%VTK_OutFileRoot)//'.IceF_iceMesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) end if ! IceDyn @@ -5217,8 +5381,8 @@ SUBROUTINE WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD14, AD, IfW, O if (allocated(IceD%Input)) then DO k = 1,p_FAST%numIceLegs - call MeshWrVTK(p_FAST%TurbinePos, IceD%y(k)%PointMesh, trim(VTK_path)//'.IceD_PointMesh'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, IceD%Input(1,k)%PointMesh ) - !call MeshWrVTK(p_FAST%TurbinePos, IceD%Input(1,k)%PointMesh, trim(p_FAST%OutFileRoot)//'.IceD_PointMesh_motion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) + call MeshWrVTK(p_FAST%TurbinePos, IceD%y(k)%PointMesh, trim(p_FAST%VTK_OutFileRoot)//'.IceD_PointMesh'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, IceD%Input(1,k)%PointMesh ) + !call MeshWrVTK(p_FAST%TurbinePos, IceD%Input(1,k)%PointMesh, trim(p_FAST%VTK_OutFileRoot)//'.IceD_PointMesh_motion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) END DO end if @@ -5229,7 +5393,7 @@ END SUBROUTINE WrVTK_AllMeshes !---------------------------------------------------------------------------------------------------------------------------------- !> This routine writes a minimal subset of meshes (enough to visualize the turbine) to VTK-formatted files. It doesn't bother with !! returning an error code. -SUBROUTINE WrVTK_BasicMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD14, AD, IfW, OpFM, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) +SUBROUTINE WrVTK_BasicMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code TYPE(FAST_OutputFileType),INTENT(IN ) :: y_FAST !< Output variables for the glue code @@ -5238,7 +5402,6 @@ SUBROUTINE WrVTK_BasicMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD14, AD, IfW, TYPE(ElastoDyn_Data), INTENT(IN ) :: ED !< ElastoDyn data TYPE(BeamDyn_Data), INTENT(IN ) :: BD !< BeamDyn data TYPE(ServoDyn_Data), INTENT(IN ) :: SrvD !< ServoDyn data - TYPE(AeroDyn14_Data), INTENT(IN ) :: AD14 !< AeroDyn14 data TYPE(AeroDyn_Data), INTENT(IN ) :: AD !< AeroDyn data TYPE(InflowWind_Data), INTENT(IN ) :: IfW !< InflowWind data TYPE(OpenFOAM_Data), INTENT(IN ) :: OpFM !< OpenFOAM data @@ -5252,87 +5415,77 @@ SUBROUTINE WrVTK_BasicMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD14, AD, IfW, TYPE(IceDyn_Data), INTENT(IN ) :: IceD !< All the IceDyn data used in time-step loop logical :: OutputFields - INTEGER(IntKi) :: NumBl, k, Twidth - CHARACTER(1024) :: VTK_path + INTEGER(IntKi) :: NumBl, k INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMSg2 CHARACTER(*), PARAMETER :: RoutineName = 'WrVTK_BasicMeshes' - ! Calculate the number of digits for the maximum number of output steps to be written. - ! This will be used to pad the write-out step in the VTK filename with zeros in calls to MeshWrVTK() - if ( (p_FAST%n_VTKTime>0) .and. (p_FAST%n_TMax_m1+1>0) ) then - Twidth = CEILING( log10( real(p_FAST%n_TMax_m1+1, ReKi) / p_FAST%n_VTKTime ) ) + 1 - else - Twidth = 1 - endif - - + NumBl = 0 - if (allocated(ED%Output(1)%BladeRootMotion)) then - NumBl = SIZE(ED%Output(1)%BladeRootMotion) + if (allocated(ED%y%BladeRootMotion)) then + NumBl = SIZE(ED%y%BladeRootMotion) end if - VTK_path = get_vtkroot_path( p_FAST%OutFileRoot ) - -! Nacelle - call MeshWrVTK(p_FAST%TurbinePos, ED%Output(1)%NacelleMotion, trim(VTK_path)//'.ED_Nacelle', y_FAST%VTK_count, & - p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, Sib=ED%Input(1)%NacelleLoads ) - -! Hub - call MeshWrVTK(p_FAST%TurbinePos, ED%Output(1)%HubPtMotion, trim(VTK_path)//'.ED_Hub', y_FAST%VTK_count, & - p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, Sib=ED%Input(1)%HubPtLoad ) ! Blades IF ( p_FAST%CompAero == Module_AD ) THEN ! These meshes may have airfoil data associated with nodes... DO K=1,NumBl - call MeshWrVTK(p_FAST%TurbinePos, AD%Input(1)%BladeMotion(K), trim(VTK_path)//'.AD_Blade'//trim(num2lstr(k)), & - y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, Sib=AD%y%BladeLoad(K) ) + call MeshWrVTK(p_FAST%TurbinePos, AD%Input(1)%BladeMotion(K), trim(p_FAST%VTK_OutFileRoot)//'.AD_Blade'//trim(num2lstr(k)), & + y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, Sib=AD%y%BladeLoad(K) ) END DO ELSE IF ( p_FAST%CompElast == Module_BD ) THEN DO K=1,NumBl - call MeshWrVTK(p_FAST%TurbinePos, BD%y(k)%BldMotion, trim(VTK_path)//'.BD_BldMotion'//trim(num2lstr(k)), & - y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth ) + call MeshWrVTK(p_FAST%TurbinePos, BD%y(k)%BldMotion, trim(p_FAST%VTK_OutFileRoot)//'.BD_BldMotion'//trim(num2lstr(k)), & + y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) END DO - ELSE + ELSE IF ( p_FAST%CompElast == Module_ED ) THEN DO K=1,NumBl - call MeshWrVTK(p_FAST%TurbinePos, ED%Output(1)%BladeLn2Mesh(K), trim(VTK_path)//'.ED_BladeLn2Mesh_motion'//trim(num2lstr(k)), & - y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth ) + call MeshWrVTK(p_FAST%TurbinePos, ED%y%BladeLn2Mesh(K), trim(p_FAST%VTK_OutFileRoot)//'.ED_BladeLn2Mesh_motion'//trim(num2lstr(k)), & + y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) END DO END IF - + +! 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 ) + +! 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%Output(1)%TowerLn2Mesh, trim(VTK_path)//'.ED_TowerLn2Mesh_motion', & - y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth ) + 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 ) + ! Substructure -! call MeshWrVTK(p_FAST%TurbinePos, ED%Output(1)%PlatformPtMesh, trim(p_FAST%OutFileRoot)//'.ED_PlatformPtMesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) +! call MeshWrVTK(p_FAST%TurbinePos, ED%y%PlatformPtMesh, trim(p_FAST%VTK_OutFileRoot)//'.ED_PlatformPtMesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) ! IF ( p_FAST%CompSub == Module_SD ) THEN -! call MeshWrVTK(p_FAST%TurbinePos, SD%Input(1)%TPMesh, trim(p_FAST%OutFileRoot)//'.SD_TPMesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) -! call MeshWrVTK(p_FAST%TurbinePos, SD%y%y2Mesh, trim(p_FAST%OutFileRoot)//'.SD_y2Mesh_motion', y_FAST%VTK_count, ErrStat2, ErrMsg2 ) +! call MeshWrVTK(p_FAST%TurbinePos, SD%Input(1)%TPMesh, trim(p_FAST%VTK_OutFileRoot)//'.SD_TPMesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) +! call MeshWrVTK(p_FAST%TurbinePos, SD%y%y2Mesh, trim(p_FAST%VTK_OutFileRoot)//'.SD_y2Mesh_motion', y_FAST%VTK_count, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) ! END IF IF ( p_FAST%CompHydro == Module_HD ) THEN if (p_FAST%CompSub == Module_NONE) then - call MeshWrVTK(p_FAST%TurbinePos, HD%y%AllHdroOrigin, trim(VTK_path)//'.HD_AllHdroOrigin', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, HD%Input(1)%Mesh ) + call MeshWrVTK(p_FAST%TurbinePos, HD%y%AllHdroOrigin, trim(p_FAST%VTK_OutFileRoot)//'.HD_AllHdroOrigin', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, HD%Input(1)%Mesh ) outputFields = .false. else OutputFields = p_FAST%VTK_fields end if - call MeshWrVTK(p_FAST%TurbinePos, HD%Input(1)%Morison%DistribMesh, trim(VTK_path)//'.HD_MorisonDistrib', & - y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, Twidth, Sib=HD%y%Morison%DistribMesh ) + call MeshWrVTK(p_FAST%TurbinePos, HD%Input(1)%Morison%DistribMesh, trim(p_FAST%VTK_OutFileRoot)//'.HD_MorisonDistrib', & + y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, Sib=HD%y%Morison%DistribMesh ) END IF ! Mooring Lines? ! IF ( p_FAST%CompMooring == Module_MAP ) THEN -! call MeshWrVTK(p_FAST%TurbinePos, MAPp%Input(1)%PtFairDisplacement, trim(p_FAST%OutFileRoot)//'.MAP_PtFair_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) +! call MeshWrVTK(p_FAST%TurbinePos, MAPp%Input(1)%PtFairDisplacement, trim(p_FAST%VTK_OutFileRoot)//'.MAP_PtFair_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) ! ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN -! call MeshWrVTK(p_FAST%TurbinePos, MD%Input(1)%PtFairleadDisplacement, trim(p_FAST%OutFileRoot)//'.MD_PtFair_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) +! call MeshWrVTK(p_FAST%TurbinePos, MD%Input(1)%PtFairleadDisplacement, trim(p_FAST%VTK_OutFileRoot)//'.MD_PtFair_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) ! ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN -! call MeshWrVTK(p_FAST%TurbinePos, FEAM%Input(1)%PtFairleadDisplacement, trim(p_FAST%OutFileRoot)//'FEAM_PtFair_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) +! call MeshWrVTK(p_FAST%TurbinePos, FEAM%Input(1)%PtFairleadDisplacement, trim(p_FAST%VTK_OutFileRoot)//'FEAM_PtFair_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) ! END IF @@ -5340,7 +5493,7 @@ END SUBROUTINE WrVTK_BasicMeshes !---------------------------------------------------------------------------------------------------------------------------------- !> This routine writes a minimal subset of meshes with surfaces to VTK-formatted files. It doesn't bother with !! returning an error code. -SUBROUTINE WrVTK_Surfaces(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD14, AD, IfW, OpFM, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) +SUBROUTINE WrVTK_Surfaces(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) REAL(DbKi), INTENT(IN ) :: t_global !< Current global time TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code @@ -5350,7 +5503,6 @@ SUBROUTINE WrVTK_Surfaces(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD14, A TYPE(ElastoDyn_Data), INTENT(IN ) :: ED !< ElastoDyn data TYPE(BeamDyn_Data), INTENT(IN ) :: BD !< BeamDyn data TYPE(ServoDyn_Data), INTENT(IN ) :: SrvD !< ServoDyn data - TYPE(AeroDyn14_Data), INTENT(IN ) :: AD14 !< AeroDyn14 data TYPE(AeroDyn_Data), INTENT(IN ) :: AD !< AeroDyn data TYPE(InflowWind_Data), INTENT(IN ) :: IfW !< InflowWind data TYPE(OpenFOAM_Data), INTENT(IN ) :: OpFM !< OpenFOAM data @@ -5365,76 +5517,64 @@ SUBROUTINE WrVTK_Surfaces(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD14, A 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, Twidth - CHARACTER(1024) :: VTK_path + INTEGER(IntKi) :: NumBl, k INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMSg2 CHARACTER(*), PARAMETER :: RoutineName = 'WrVTK_Surfaces' - ! Calculate the number of digits for the maximum number of output steps to be written. - ! This will be used to pad the write-out step in the VTK filename with zeros in calls to MeshWrVTK() - if ( (p_FAST%n_VTKTime>0) .and. (p_FAST%n_TMax_m1+1>0) ) then - Twidth = CEILING( log10( real(p_FAST%n_TMax_m1+1, ReKi) / p_FAST%n_VTKTime ) ) + 1 - else - Twidth = 1 - endif - - NumBl = 0 - if (allocated(ED%Output(1)%BladeRootMotion)) then - NumBl = SIZE(ED%Output(1)%BladeRootMotion) + if (allocated(ED%y%BladeRootMotion)) then + NumBl = SIZE(ED%y%BladeRootMotion) end if - VTK_path = get_vtkroot_path( p_FAST%OutFileRoot ) - ! Ground (written at initialization) ! Wave elevation if ( allocated( p_FAST%VTK_Surface%WaveElev ) ) call WrVTK_WaveElev( t_global, p_FAST, y_FAST, HD) - ! Nacelle - call MeshWrVTK_PointSurface (p_FAST%TurbinePos, ED%Output(1)%NacelleMotion, trim(VTK_path)//'.NacelleSurface', & - y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, Twidth , verts = p_FAST%VTK_Surface%NacelleBox, Sib=ED%Input(1)%NacelleLoads ) + 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 ) ! Hub - call MeshWrVTK_PointSurface (p_FAST%TurbinePos, ED%Output(1)%HubPtMotion, trim(VTK_path)//'.HubSurface', & - y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, Twidth , & + 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 ) + ! Blades IF ( p_FAST%CompAero == Module_AD ) THEN ! These meshes may have airfoil data associated with nodes... DO K=1,NumBl - call MeshWrVTK_Ln2Surface (p_FAST%TurbinePos, AD%Input(1)%BladeMotion(K), trim(VTK_path)//'.Blade'//trim(num2lstr(k))//'Surface', & - y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, Twidth , verts=p_FAST%VTK_Surface%BladeShape(K)%AirfoilCoords & + call MeshWrVTK_Ln2Surface (p_FAST%TurbinePos, AD%Input(1)%BladeMotion(K), trim(p_FAST%VTK_OutFileRoot)//'.Blade'//trim(num2lstr(k))//'Surface', & + y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth , verts=p_FAST%VTK_Surface%BladeShape(K)%AirfoilCoords & ,Sib=AD%y%BladeLoad(k) ) END DO ELSE IF ( p_FAST%CompElast == Module_BD ) THEN DO K=1,NumBl - call MeshWrVTK_Ln2Surface (p_FAST%TurbinePos, BD%y(k)%BldMotion, trim(VTK_path)//'.Blade'//trim(num2lstr(k))//'Surface', & - y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, Twidth , verts=p_FAST%VTK_Surface%BladeShape(K)%AirfoilCoords ) + call MeshWrVTK_Ln2Surface (p_FAST%TurbinePos, BD%y(k)%BldMotion, trim(p_FAST%VTK_OutFileRoot)//'.Blade'//trim(num2lstr(k))//'Surface', & + y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth , verts=p_FAST%VTK_Surface%BladeShape(K)%AirfoilCoords ) END DO - ELSE + ELSE IF ( p_FAST%CompElast == Module_ED ) THEN DO K=1,NumBl - call MeshWrVTK_Ln2Surface (p_FAST%TurbinePos, ED%Output(1)%BladeLn2Mesh(K), trim(VTK_path)//'.Blade'//trim(num2lstr(k))//'Surface', & - y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, Twidth , verts=p_FAST%VTK_Surface%BladeShape(K)%AirfoilCoords ) + call MeshWrVTK_Ln2Surface (p_FAST%TurbinePos, ED%y%BladeLn2Mesh(K), trim(p_FAST%VTK_OutFileRoot)//'.Blade'//trim(num2lstr(k))//'Surface', & + y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth , verts=p_FAST%VTK_Surface%BladeShape(K)%AirfoilCoords ) END DO END IF -! Tower motions - call MeshWrVTK_Ln2Surface (p_FAST%TurbinePos, ED%Output(1)%TowerLn2Mesh, trim(VTK_path)//'.TowerSurface', & - y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, Twidth, p_FAST%VTK_Surface%NumSectors, p_FAST%VTK_Surface%TowerRad ) ! Platform -! call MeshWrVTK_PointSurface (p_FAST%TurbinePos, ED%Output(1)%PlatformPtMesh, trim(p_FAST%OutFileRoot)//'.PlatformSurface', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, Radius = p_FAST%VTK_Surface%GroundRad ) +! call MeshWrVTK_PointSurface (p_FAST%TurbinePos, ED%y%PlatformPtMesh, trim(p_FAST%VTK_OutFileRoot)//'.PlatformSurface', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, Radius = p_FAST%VTK_Surface%GroundRad ) ! Substructure -! call MeshWrVTK(p_FAST%TurbinePos, ED%Output(1)%PlatformPtMesh, trim(p_FAST%OutFileRoot)//'.ED_PlatformPtMesh_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) +! call MeshWrVTK(p_FAST%TurbinePos, ED%y%PlatformPtMesh, trim(p_FAST%VTK_OutFileRoot)//'.ED_PlatformPtMesh_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) ! IF ( p_FAST%CompSub == Module_SD ) THEN -! call MeshWrVTK(p_FAST%TurbinePos, SD%Input(1)%TPMesh, trim(p_FAST%OutFileRoot)//'.SD_TPMesh_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) -! call MeshWrVTK(p_FAST%TurbinePos, SD%y%y2Mesh, trim(p_FAST%OutFileRoot)//'.SD_y2Mesh_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) +! call MeshWrVTK(p_FAST%TurbinePos, SD%Input(1)%TPMesh, trim(p_FAST%VTK_OutFileRoot)//'.SD_TPMesh_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) +! call MeshWrVTK(p_FAST%TurbinePos, SD%y%y2Mesh, trim(p_FAST%VTK_OutFileRoot)//'.SD_y2Mesh_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) ! END IF IF ( HD%Input(1)%Morison%DistribMesh%Committed ) THEN @@ -5444,24 +5584,24 @@ SUBROUTINE WrVTK_Surfaces(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD14, A ! OutputFields = p_FAST%VTK_fields !end if - call MeshWrVTK_Ln2Surface (p_FAST%TurbinePos, HD%Input(1)%Morison%DistribMesh, trim(VTK_path)//'.MorisonSurface', & - y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, Twidth, p_FAST%VTK_Surface%NumSectors, & + call MeshWrVTK_Ln2Surface (p_FAST%TurbinePos, HD%Input(1)%Morison%DistribMesh, trim(p_FAST%VTK_OutFileRoot)//'.MorisonSurface', & + y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, p_FAST%VTK_Surface%NumSectors, & p_FAST%VTK_Surface%MorisonRad, Sib=HD%y%Morison%DistribMesh ) END IF ! Mooring Lines? ! IF ( p_FAST%CompMooring == Module_MAP ) THEN -! call MeshWrVTK(p_FAST%TurbinePos, MAPp%Input(1)%PtFairDisplacement, trim(p_FAST%OutFileRoot)//'.MAP_PtFair_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) +! call MeshWrVTK(p_FAST%TurbinePos, MAPp%Input(1)%PtFairDisplacement, trim(p_FAST%VTK_OutFileRoot)//'.MAP_PtFair_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) ! ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN -! call MeshWrVTK(p_FAST%TurbinePos, MD%Input(1)%PtFairleadDisplacement, trim(p_FAST%OutFileRoot)//'.MD_PtFair_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) +! call MeshWrVTK(p_FAST%TurbinePos, MD%Input(1)%PtFairleadDisplacement, trim(p_FAST%VTK_OutFileRoot)//'.MD_PtFair_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) ! ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN -! call MeshWrVTK(p_FAST%TurbinePos, FEAM%Input(1)%PtFairleadDisplacement, trim(p_FAST%OutFileRoot)//'FEAM_PtFair_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) +! call MeshWrVTK(p_FAST%TurbinePos, FEAM%Input(1)%PtFairleadDisplacement, trim(p_FAST%VTK_OutFileRoot)//'FEAM_PtFair_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) ! END IF if (p_FAST%VTK_fields) then - call WrVTK_BasicMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD14, AD, IfW, OpFM, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) + call WrVTK_BasicMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) end if @@ -5484,8 +5624,7 @@ SUBROUTINE WrVTK_WaveElev(t_global, p_FAST, y_FAST, HD) INTEGER(IntKi) :: NumberOfPoints INTEGER(IntKi), parameter :: NumberOfLines = 0 INTEGER(IntKi) :: NumberOfPolys - INTEGER(IntKi) :: Twidth - CHARACTER(1024) :: VTK_path, Tstr = '' + CHARACTER(1024) :: Tstr INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*),PARAMETER :: RoutineName = 'WrVTK_WaveElev' @@ -5499,21 +5638,11 @@ SUBROUTINE WrVTK_WaveElev(t_global, p_FAST, y_FAST, HD) !................................................................. ! write the data that potentially changes each time step: !................................................................. - ! Calculate the number of digits for the maximum number of output steps to be written. - ! This will be used to pad the write-out step in the VTK filename with zeros in calls to MeshWrVTK() - if ( (p_FAST%n_VTKTime>0) .and. (p_FAST%n_TMax_m1+1>0) ) then - Twidth = CEILING( log10( real(p_FAST%n_TMax_m1+1, ReKi) / p_FAST%n_VTKTime ) ) + 1 - else - Twidth = 1 - endif - - VTK_path = get_vtkroot_path( p_FAST%OutFileRoot ) - ! construct the string for the zero-padded VTK write-out step - write(Tstr(1 : Twidth), '(i' // trim(Num2LStr(Twidth)) //'.'// trim(Num2LStr(Twidth)) // ')') y_FAST%VTK_count + write(Tstr, '(i' // trim(Num2LStr(p_FAST%VTK_tWidth)) //'.'// trim(Num2LStr(p_FAST%VTK_tWidth)) // ')') y_FAST%VTK_count ! PolyData (.vtp) - Serial vtkPolyData (unstructured) file - FileName = TRIM(VTK_path)//'.WaveSurface.'//TRIM(Tstr)//'.vtp' + FileName = TRIM(p_FAST%VTK_OutFileRoot)//'.WaveSurface.'//TRIM(Tstr)//'.vtp' call WrVTK_header( FileName, NumberOfPoints, NumberOfLines, NumberOfPolys, Un, ErrStat2, ErrMsg2 ) if (ErrStat2 >= AbortErrLev) return @@ -5819,10 +5948,10 @@ SUBROUTINE FAST_Linearize_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg) ! local variables REAL(DbKi) :: t_global ! current simulation time REAL(DbKi) :: next_lin_time ! next simulation time where linearization analysis should be performed + INTEGER(IntKi) :: iLinTime ! loop counter INTEGER(IntKi) :: ErrStat2 ! local error status CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message - CHARACTER(MaxWrScrLen) :: BlankLine - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Linearize_T' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Linearize_T' ErrStat = ErrID_None @@ -5830,34 +5959,82 @@ SUBROUTINE FAST_Linearize_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg) if ( .not. Turbine%p_FAST%Linearize ) return - if (Turbine%m_FAST%NextLinTimeIndx <= size(Turbine%p_FAST%LinTimes) ) then !bjj: maybe this logic should go in FAST_Linearize_OP??? + if (.not. Turbine%p_FAST%CalcSteady) then + + if ( Turbine%m_FAST%Lin%NextLinTimeIndx <= Turbine%p_FAST%NLinTimes ) then !bjj: maybe this logic should go in FAST_Linearize_OP??? - next_lin_time = Turbine%p_FAST%LinTimes( Turbine%m_FAST%NextLinTimeIndx ) - t_global = t_initial + n_t_global*Turbine%p_FAST%dt + next_lin_time = Turbine%m_FAST%Lin%LinTimes( Turbine%m_FAST%Lin%NextLinTimeIndx ) + t_global = t_initial + n_t_global*Turbine%p_FAST%dt - if ( EqualRealNos( t_global, next_lin_time ) .or. t_global > next_lin_time ) then - - BlankLine = "" - CALL WrOver( BlankLine ) ! BlankLine contains MaxWrScrLen spaces - CALL WrOver ( ' Performing linearization at simulation time '//TRIM( Num2LStr(t_global) )//' s. (RotSpeed='& - //trim(num2lstr(Turbine%ED%Output(1)%RotSpeed*RPS2RPM))//' rpm, BldPitch1='//trim(num2lstr(Turbine%ED%Output(1)%BlPitch(1)*R2D))//' deg)' ) - CALL WrScr('') + if ( EqualRealNos( t_global, next_lin_time ) .or. t_global > next_lin_time ) then + + CALL FAST_Linearize_OP(t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & + Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%IfW, Turbine%OpFM, & + Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & + Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF (ErrStat >= AbortErrLev) RETURN + + if (Turbine%p_FAST%WrVTK == VTK_ModeShapes) then + if (Turbine%m_FAST%Lin%NextLinTimeIndx > Turbine%p_FAST%NLinTimes) call WrVTKCheckpoint() + end if + + end if + end if + + else ! CalcSteady - CALL FAST_Linearize_OP(t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%IfW, Turbine%OpFM, & - Turbine%HD, Turbine%SD, 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 + t_global = t_initial + n_t_global*Turbine%p_FAST%dt + + call FAST_CalcSteady( n_t_global, t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, Turbine%ED, Turbine%BD, Turbine%SrvD, & + Turbine%AD, Turbine%IfW, Turbine%OpFM, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, & + Turbine%Orca, Turbine%IceF, Turbine%IceD, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + if (Turbine%m_FAST%Lin%FoundSteady) then + + do iLinTime=1,Turbine%p_FAST%NLinTimes + t_global = Turbine%m_FAST%Lin%LinTimes(iLinTime) + + call SetOperatingPoint(iLinTime, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, Turbine%ED, Turbine%BD, Turbine%SrvD, & + Turbine%AD, Turbine%IfW, Turbine%OpFM, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, & + Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, Turbine%IceF, Turbine%IceD, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + if (Turbine%p_FAST%DT_UJac < Turbine%p_FAST%TMax) then + Turbine%m_FAST%calcJacobian = .true. + Turbine%m_FAST%NextJacCalcTime = t_global + end if + + CALL CalcOutputs_And_SolveForInputs( -1, t_global, STATE_CURR, Turbine%m_FAST%calcJacobian, Turbine%m_FAST%NextJacCalcTime, & + Turbine%p_FAST, Turbine%m_FAST, .false., Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%IfW, Turbine%OpFM, & + Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF (ErrStat >= AbortErrLev) RETURN + + CALL FAST_Linearize_OP(t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & + Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%IfW, Turbine%OpFM, & + Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & + Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF (ErrStat >= AbortErrLev) RETURN - Turbine%m_FAST%NextLinTimeIndx = Turbine%m_FAST%NextLinTimeIndx + 1 + end do + + if (Turbine%p_FAST%WrVTK == VTK_ModeShapes) CALL WrVTKCheckpoint() 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 !---------------------------------------------------------------------------------------------------------------------------------- @@ -5867,12 +6044,21 @@ END SUBROUTINE FAST_Linearize_T !> Routine that calls ExitThisProgram for one instance of a Turbine data structure. This is a separate subroutine so that the FAST !! driver programs do not need to change or operate on the individual module level. !! This routine should be called from glue code only (e.g., FAST_Prog.f90). It should not be called in any of these driver routines. -SUBROUTINE ExitThisProgram_T( Turbine, ErrLevel_in, StopTheProgram, ErrLocMsg ) +SUBROUTINE ExitThisProgram_T( Turbine, ErrLevel_in, StopTheProgram, ErrLocMsg, SkipRunTimeMsg ) TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< Data for one turbine instance INTEGER(IntKi), INTENT(IN) :: ErrLevel_in !< Error level when Error == .TRUE. (required when Error is .TRUE.) LOGICAL, INTENT(IN) :: StopTheProgram !< flag indicating if the program should end (false if there are more turbines to end) CHARACTER(*), OPTIONAL, INTENT(IN) :: ErrLocMsg !< an optional message describing the location of the error + LOGICAL, OPTIONAL, INTENT(IN) :: SkipRunTimeMsg !< an optional message describing run-time stats + + LOGICAL :: SkipRunTimes + + IF (PRESENT(SkipRunTimeMsg)) THEN + SkipRunTimes = SkipRunTimeMsg + ELSE + SkipRunTimes = .FALSE. + END IF IF (PRESENT(ErrLocMsg)) THEN @@ -5880,14 +6066,14 @@ SUBROUTINE ExitThisProgram_T( Turbine, ErrLevel_in, StopTheProgram, ErrLocMsg ) CALL ExitThisProgram( Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%IfW, Turbine%OpFM, & Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrLevel_in, StopTheProgram, ErrLocMsg ) + Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrLevel_in, StopTheProgram, ErrLocMsg, SkipRunTimes ) ELSE CALL ExitThisProgram( Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%IfW, Turbine%OpFM, & Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrLevel_in, StopTheProgram ) + Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrLevel_in, StopTheProgram, SkipRunTimeMsg=SkipRunTimes ) END IF @@ -5898,7 +6084,7 @@ END SUBROUTINE ExitThisProgram_T !! This routine should not be called from glue code (e.g., FAST_Prog.f90) or ExitThisProgram_T only. It should not be called in any !! of these driver routines. SUBROUTINE ExitThisProgram( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, & - MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrLevel_in, StopTheProgram, ErrLocMsg ) + MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrLevel_in, StopTheProgram, ErrLocMsg, SkipRunTimeMsg ) !............................................................................................................................... ! Passed arguments @@ -5928,28 +6114,27 @@ SUBROUTINE ExitThisProgram( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, INTEGER(IntKi), INTENT(IN) :: ErrLevel_in !< Error level when Error == .TRUE. (required when Error is .TRUE.) LOGICAL, INTENT(IN) :: StopTheProgram !< flag indicating if the program should end (false if there are more turbines to end) CHARACTER(*), OPTIONAL, INTENT(IN) :: ErrLocMsg !< an optional message describing the location of the error + LOGICAL, OPTIONAL, INTENT(IN) :: SkipRunTimeMsg !< an optional message describing run-time stats ! Local variables: INTEGER(IntKi) :: ErrorLevel + LOGICAL :: PrintRunTimes INTEGER(IntKi) :: ErrStat2 ! Error status CHARACTER(ErrMsgLen) :: ErrMsg2 ! Error message CHARACTER(1224) :: SimMsg ! optional message to print about where the error took place in the simulation CHARACTER(*), PARAMETER :: RoutineName = 'ExitThisProgram' - CHARACTER( LEN(p_FAST%OutFileRoot) ) :: TmpOutFileRoot ErrorLevel = ErrLevel_in ! for debugging, let's output the meshes and all of their fields IF ( ErrorLevel >= AbortErrLev .AND. p_FAST%WrVTK > VTK_None) THEN - TmpOutFileRoot = p_FAST%OutFileRoot - p_FAST%OutFileRoot = trim(p_FAST%OutFileRoot)//'.DebugError' + p_FAST%VTK_OutFileRoot = trim(p_FAST%VTK_OutFileRoot)//'.DebugError' p_FAST%VTK_fields = .true. - CALL WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) - p_FAST%OutFileRoot = TmpOutFileRoot + CALL WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) end if @@ -5980,6 +6165,12 @@ SUBROUTINE ExitThisProgram( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, 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 = 'FAST encountered an error '//TRIM(SimMsg)//'.'//NewLine//' Simulation error level: '//TRIM(GetErrStr(ErrorLevel)) if (StopTheProgram) then @@ -5993,11 +6184,19 @@ SUBROUTINE ExitThisProgram( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, !............................................................................................................................ ! Write simulation times and stop !............................................................................................................................ - - IF (p_FAST%WrSttsTime) THEN - CALL RunTimes( m_FAST%StrtTime, m_FAST%UsrTime1, m_FAST%SimStrtTime, m_FAST%UsrTime2, m_FAST%t_global, DescStrIn=p_FAST%TDesc ) - END IF + 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) @@ -6013,10 +6212,11 @@ END SUBROUTINE ExitThisProgram !---------------------------------------------------------------------------------------------------------------------------------- !> This subroutine is called at program termination. It writes any additional output files, !! deallocates variables for FAST file I/O and closes files. -SUBROUTINE FAST_EndOutput( p_FAST, y_FAST, ErrStat, ErrMsg ) +SUBROUTINE FAST_EndOutput( p_FAST, y_FAST, m_FAST, ErrStat, ErrMsg ) TYPE(FAST_ParameterType), INTENT(INOUT) :: p_FAST !< FAST Parameters TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< FAST Output + TYPE(FAST_MiscVarType), INTENT(IN ) :: m_FAST !< Miscellaneous variables (only for the final time) INTEGER(IntKi), INTENT(OUT) :: ErrStat !< Error status CHARACTER(*), INTENT(OUT) :: ErrMsg !< Message associated with errro status @@ -6118,12 +6318,12 @@ SUBROUTINE FAST_EndMods( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, HD ErrMsg = "" - CALL FAST_EndOutput( p_FAST, y_FAST, ErrStat2, ErrMsg2 ) + CALL FAST_EndOutput( p_FAST, y_FAST, m_FAST, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF ( p_FAST%ModuleInitialized(Module_ED) ) THEN CALL ED_End( ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), & - ED%Output(1), ED%m, ErrStat2, ErrMsg2 ) + ED%y, ED%m, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END IF @@ -6731,4 +6931,497 @@ SUBROUTINE FAST_RestoreFromCheckpoint_T(t_initial, n_t_global, NumTurbines, Turb END SUBROUTINE FAST_RestoreFromCheckpoint_T !---------------------------------------------------------------------------------------------------------------------------------- +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine that calls FAST_RestoreForVTKModeShape_T for an array of Turbine data structures. +SUBROUTINE FAST_RestoreForVTKModeShape_Tary(t_initial, Turbine, InputFileName, ErrStat, ErrMsg ) + + REAL(DbKi), INTENT(IN ) :: t_initial !< initial time (for comparing with time from checkpoint file) + TYPE(FAST_TurbineType), INTENT( OUT) :: Turbine(:) !< all data for one instance of a turbine + CHARACTER(*), INTENT(IN ) :: InputFileName !< Name of the input file + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables + INTEGER(IntKi) :: i_turb + INTEGER(IntKi) :: n_t_global !< loop counter + INTEGER(IntKi) :: NumTurbines ! Number of turbines in this simulation + INTEGER(IntKi) :: ErrStat2 ! local error status + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_RestoreForVTKModeShape_Tary' + + + ErrStat = ErrID_None + ErrMsg = "" + + NumTurbines = SIZE(Turbine) + if (NumTurbines /=1) then + call SetErrStat(ErrID_Fatal, "Mode-shape visualization is not available for multiple turbines.", ErrStat, ErrMsg, RoutineName) + return + end if + + + CALL ReadModeShapeFile( Turbine(1)%p_FAST, trim(InputFileName), ErrStat2, ErrMsg2, checkpointOnly=.true. ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (ErrStat >= AbortErrLev) return + + CALL FAST_RestoreFromCheckpoint_Tary( t_initial, n_t_global, Turbine, trim(Turbine(1)%p_FAST%VTK_modes%CheckpointRoot), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + + DO i_turb = 1,NumTurbines + if (.not. allocated(Turbine(i_turb)%m_FAST%Lin%LinTimes)) then + call SetErrStat(ErrID_Fatal, "Mode-shape visualization requires a checkpoint file from a simulation with linearization analysis, but NLinTimes is 0.", ErrStat, ErrMsg, RoutineName) + return + end if + + CALL FAST_RestoreForVTKModeShape_T(t_initial, Turbine(i_turb)%p_FAST, Turbine(i_turb)%y_FAST, Turbine(i_turb)%m_FAST, & + Turbine(i_turb)%ED, Turbine(i_turb)%BD, Turbine(i_turb)%SrvD, Turbine(i_turb)%AD14, Turbine(i_turb)%AD, Turbine(i_turb)%IfW, Turbine(i_turb)%OpFM, & + Turbine(i_turb)%HD, Turbine(i_turb)%SD, Turbine(i_turb)%ExtPtfm, Turbine(i_turb)%MAP, Turbine(i_turb)%FEAM, Turbine(i_turb)%MD, Turbine(i_turb)%Orca, & + Turbine(i_turb)%IceF, Turbine(i_turb)%IceD, Turbine(i_turb)%MeshMapData, trim(InputFileName), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + +END SUBROUTINE FAST_RestoreForVTKModeShape_Tary + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine calculates the motions generated by mode shapes and outputs VTK data for it +SUBROUTINE FAST_RestoreForVTKModeShape_T(t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, & + MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, InputFileName, ErrStat, ErrMsg ) + + REAL(DbKi), INTENT(IN ) :: t_initial !< initial time + + TYPE(FAST_ParameterType), INTENT(INOUT) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data + TYPE(AeroDyn14_Data), INTENT(INOUT) :: AD14 !< AeroDyn14 data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data + TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpFM !< OpenFOAM data + TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data + TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module + TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop + + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + CHARACTER(*), INTENT(IN ) :: InputFileName !< Name of the input file + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables + REAL(DbKi) :: dt ! time + REAL(DbKi) :: tprime ! time + INTEGER(IntKi) :: nt + + INTEGER(IntKi) :: iLinTime ! generic loop counters + INTEGER(IntKi) :: it ! generic loop counters + INTEGER(IntKi) :: iMode ! generic loop counters + INTEGER(IntKi) :: ModeNo ! mode number + INTEGER(IntKi) :: NLinTimes + + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_RestoreForVTKModeShape_T' + CHARACTER(1024) :: VTK_RootName + + + ErrStat = ErrID_None + ErrMsg = "" + + CALL ReadModeShapeFile( p_FAST, trim(InputFileName), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (ErrStat >= AbortErrLev) return + + call ReadModeShapeMatlabFile( p_FAST, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (ErrStat >= AbortErrLev ) return + + y_FAST%WriteThisStep = .true. + y_FAST%UnSum = -1 + + NLinTimes = min( p_FAST%VTK_modes%VTKNLinTimes, size(p_FAST%VTK_modes%x_eig_magnitude,2), p_FAST%NLinTimes ) + + VTK_RootName = p_FAST%VTK_OutFileRoot + + select case (p_FAST%VTK_modes%VTKLinTim) + case (1) + + do iMode = 1,p_FAST%VTK_modes%VTKLinModes + ModeNo = p_FAST%VTK_modes%VTKModes(iMode) + + call GetTimeConstants(p_FAST%VTK_modes%DampedFreq_Hz(ModeNo), p_FAST%VTK_fps, nt, dt, p_FAST%VTK_tWidth ) + if (nt > 500) cycle + + p_FAST%VTK_OutFileRoot = trim(VTK_RootName)//'.Mode'//trim(num2lstr(ModeNo)) + y_FAST%VTK_count = 1 ! we are skipping the reference meshes by starting at 1 + do iLinTime = 1,NLinTimes + tprime = m_FAST%Lin%LinTimes(iLinTime) - m_FAST%Lin%LinTimes(1) + + if (p_FAST%DT_UJac < p_FAST%TMax) then + m_FAST%calcJacobian = .true. + m_FAST%NextJacCalcTime = m_FAST%Lin%LinTimes(iLinTime) + end if + + call SetOperatingPoint(iLinTime, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, ExtPtfm, & + MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! set perturbation of states based on x_eig magnitude and phase + call PerturbOP(tprime, iLinTime, ModeNo, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + IceF, IceD, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF (ErrStat >= AbortErrLev) RETURN + + CALL CalcOutputs_And_SolveForInputs( -1, m_FAST%Lin%LinTimes(iLinTime), STATE_CURR, m_FAST%calcJacobian, m_FAST%NextJacCalcTime, & + p_FAST, m_FAST, .true., ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF (ErrStat >= AbortErrLev) RETURN + + call WriteVTK(m_FAST%Lin%LinTimes(iLinTime), p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) + + end do ! iLinTime + end do ! iMode + + case (2) + + do iMode = 1,p_FAST%VTK_modes%VTKLinModes + ModeNo = p_FAST%VTK_modes%VTKModes(iMode) + + call GetTimeConstants(p_FAST%VTK_modes%DampedFreq_Hz(ModeNo), p_FAST%VTK_fps, nt, dt, p_FAST%VTK_tWidth ) + if (nt > 500) cycle + + do iLinTime = 1,NLinTimes + p_FAST%VTK_OutFileRoot = trim(VTK_RootName)//'.Mode'//trim(num2lstr(ModeNo))//'.LinTime'//trim(num2lstr(iLinTime)) + y_FAST%VTK_count = 1 ! we are skipping the reference meshes by starting at 1 + + if (p_FAST%DT_UJac < p_FAST%TMax) then + m_FAST%calcJacobian = .true. + m_FAST%NextJacCalcTime = m_FAST%Lin%LinTimes(iLinTime) + end if + + do it = 1,nt + tprime = (it-1)*dt + + call SetOperatingPoint(iLinTime, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, ExtPtfm, & + MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! set perturbation of states based on x_eig magnitude and phase + call PerturbOP(tprime, iLinTime, ModeNo, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + IceF, IceD, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF (ErrStat >= AbortErrLev) RETURN + + CALL CalcOutputs_And_SolveForInputs( -1, m_FAST%Lin%LinTimes(iLinTime), STATE_CURR, m_FAST%calcJacobian, m_FAST%NextJacCalcTime, & + p_FAST, m_FAST, .true., ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF (ErrStat >= AbortErrLev) RETURN + + call WriteVTK(m_FAST%Lin%LinTimes(iLinTime)+tprime, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) + + end do + + + end do ! iLinTime + end do ! iMode + + end select + +END SUBROUTINE FAST_RestoreForVTKModeShape_T +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE GetTimeConstants(DampedFreq_Hz, VTK_fps, nt, dt, VTK_tWidth ) + REAL(R8Ki), INTENT(IN ) :: DampedFreq_Hz + REAL(DbKi), INTENT(IN ) :: VTK_fps + INTEGER(IntKi), INTENT( OUT) :: nt !< number of steps + REAL(DbKi), INTENT( OUT) :: dt !< time step + INTEGER(IntKi), INTENT( OUT) :: VTK_tWidth + + REAL(DbKi) :: cycle_time ! time for one cycle of mode + INTEGER(IntKi) :: NCycles + INTEGER(IntKi), PARAMETER :: MinFrames = 5 + + if (DampedFreq_Hz <= 0.0_DbKi) then + nt = huge(nt) + dt = epsilon(dt) + VTK_tWidth = 1 + return + end if + + nt = 1 + NCycles = 0 + do while (nt= AbortErrLev) RETURN + + ! Process the requested data records of this file. + + CALL WrScr ( NewLine//' =======================================================' ) + CALL WrScr ( ' Reading in data from file "'//TRIM( p_FAST%VTK_modes%MatlabFileName )//'".'//NewLine ) + + + ! Read some of the header information. + + READ (UnIn, IOSTAT=ErrStat2) FileType ! placeholder for future file format changes + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat ( ErrID_Fatal, 'Fatal error reading FileType from file "'//TRIM( p_FAST%VTK_modes%MatlabFileName )//'".', ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + + READ (UnIn, IOSTAT=ErrStat2) nModes ! number of modes in the file + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat ( ErrID_Fatal, 'Fatal error reading nModes from file "'//TRIM( p_FAST%VTK_modes%MatlabFileName )//'".', ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + + READ (UnIn, IOSTAT=ErrStat2) nStates ! number of states in the file + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat ( ErrID_Fatal, 'Fatal error reading nStates from file "'//TRIM( p_FAST%VTK_modes%MatlabFileName )//'".', ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + + READ (UnIn, IOSTAT=ErrStat2) NLinTimes ! number of linearization times / azimuths in the file + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat ( ErrID_Fatal, 'Fatal error reading NLinTimes from file "'//TRIM( p_FAST%VTK_modes%MatlabFileName )//'".', ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + + ALLOCATE( p_FAST%VTK_Modes%NaturalFreq_Hz(nModes), & + p_FAST%VTK_Modes%DampingRatio( nModes), & + p_FAST%VTK_Modes%DampedFreq_Hz( nModes), STAT=ErrStat2 ) + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat ( ErrID_Fatal, 'Error allocating arrays to read from file.', ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + + + READ(UnIn, IOSTAT=ErrStat2) p_FAST%VTK_Modes%NaturalFreq_Hz ! read entire array + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat ( ErrID_Fatal, 'Fatal error reading NaturalFreq_Hz array from file "'//TRIM( p_FAST%VTK_modes%MatlabFileName )//'".', ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + + READ(UnIn, IOSTAT=ErrStat2) p_FAST%VTK_Modes%DampingRatio ! read entire array + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat ( ErrID_Fatal, 'Fatal error reading DampingRatio array from file "'//TRIM( p_FAST%VTK_modes%MatlabFileName )//'".', ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + + READ(UnIn, IOSTAT=ErrStat2) p_FAST%VTK_Modes%DampedFreq_Hz ! read entire array + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat ( ErrID_Fatal, 'Fatal error reading DampedFreq_Hz array from file "'//TRIM( p_FAST%VTK_modes%MatlabFileName )//'".', ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + + if (nModes < p_FAST%VTK_Modes%VTKLinModes) CALL SetErrStat(ErrID_Severe,'Number of modes requested exceeds the number of modes in the linearization analysis file "'//TRIM( p_FAST%VTK_modes%MatlabFileName )//'".', ErrStat, ErrMsg, RoutineName) + if (NLinTimes /= p_FAST%NLinTimes) CALL SetErrStat(ErrID_Severe,'Number of times linearization was performed is not the same as the number of linearization times in the linearization analysis file "'//TRIM( p_FAST%VTK_modes%MatlabFileName )//'".', ErrStat, ErrMsg, RoutineName) + + + !Let's read only the number of modes we need to use + nModes = min( nModes, p_FAST%VTK_Modes%VTKLinModes ) + + ALLOCATE( p_FAST%VTK_Modes%x_eig_magnitude(nStates, NLinTimes, nModes), & + p_FAST%VTK_Modes%x_eig_phase( nStates, NLinTimes, nModes), STAT=ErrStat2 ) + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat ( ErrID_Fatal, 'Error allocating arrays to read from file.', ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + + do iMode = 1,nModes + + READ(UnIn, IOSTAT=ErrStat2) p_FAST%VTK_Modes%x_eig_magnitude(:,:,iMode) ! read data for one mode + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat ( ErrID_Fatal, 'Fatal error reading x_eig_magnitude from file "'//TRIM( p_FAST%VTK_modes%MatlabFileName )//'".', ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + + READ(UnIn, IOSTAT=ErrStat2) p_FAST%VTK_Modes%x_eig_phase(:,:,iMode) ! read data for one mode + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat ( ErrID_Fatal, 'Fatal error reading x_eig_phase from file "'//TRIM( p_FAST%VTK_modes%MatlabFileName )//'".', ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + + end do + +END SUBROUTINE ReadModeShapeMatlabFile +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE ReadModeShapeFile(p_FAST, InputFile, ErrStat, ErrMsg, checkpointOnly) + TYPE(FAST_ParameterType), INTENT(INOUT) :: p_FAST !< Parameters for the glue code + CHARACTER(*), INTENT(IN ) :: InputFile !< Name of the text input file to read + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + LOGICAL, OPTIONAL, INTENT(IN ) :: checkpointOnly !< Whether to return after reading checkpoint file name + + ! local variables + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ReadModeShapeFile' + + INTEGER(IntKi) :: i + INTEGER(IntKi) :: UnIn + INTEGER(IntKi) :: UnEc + LOGICAL :: VTKLinTimes1 + + ErrStat = ErrID_None + ErrMsg = "" + UnEc = -1 + + ! Open data file. + CALL GetNewUnit( UnIn, ErrStat2, ErrMsg2 ) + + CALL OpenFInpFile ( UnIn, InputFile, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF (ErrStat >= AbortErrLev) RETURN + + + CALL ReadCom( UnIn, InputFile, 'File header: (line 1)', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL ReadCom( UnIn, InputFile, 'File header: (line 2)', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + !----------- FILE NAMES ---------------------------------------------------- + CALL ReadCom( UnIn, InputFile, 'Section Header: File Names', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL ReadVar( UnIn, InputFile, p_FAST%VTK_modes%CheckpointRoot, 'CheckpointRoot', 'Name of the checkpoint file written by FAST when linearization data was produced', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + if (present(checkpointOnly)) then + if (checkpointOnly) then + call cleanup() + return + end if + end if + + CALL ReadVar( UnIn, InputFile, p_FAST%VTK_modes%MatlabFileName, 'MatlabFileName', 'Name of the file with eigenvectors written by Matlab', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF ( ErrStat >= AbortErrLev ) THEN + CALL Cleanup() + RETURN + END IF + + !----------- VISUALIZATION OPTIONS ------------------------------------------ + + CALL ReadCom( UnIn, InputFile, 'Section Header: Visualization Options', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL ReadVar( UnIn, InputFile, p_FAST%VTK_modes%VTKLinModes, 'VTKLinModes', 'Number of modes to visualize', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + + if (p_FAST%VTK_modes%VTKLinModes <= 0) CALL SetErrStat( ErrID_Fatal, "VTKLinModes must be a positive number.", ErrStat, ErrMsg, RoutineName ) + + if (ErrStat >= AbortErrLev) then + CALL Cleanup() + RETURN + end if + + + call AllocAry( p_FAST%VTK_modes%VTKModes, p_FAST%VTK_modes%VTKLinModes, 'VTKModes', ErrStat2, ErrMsg2) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if ( ErrStat >= AbortErrLev ) then + call Cleanup() + return + end if + + p_FAST%VTK_modes%VTKModes = -1 + + CALL ReadAry( UnIn, InputFile, p_FAST%VTK_modes%VTKModes, p_FAST%VTK_modes%VTKLinModes, 'VTKModes', 'List of modes to visualize', ErrStat2, ErrMsg2, UnEc ) + ! note that we don't check the ErrStat here; if the user entered fewer than p_FAST%VTK_modes%VTKLinModes values, we will use the + ! last entry to fill in remaining values. + !Check 1st value, we need at least one good value from user or throw error + IF (p_FAST%VTK_modes%VTKModes(1) < 0 ) THEN + call SetErrStat( ErrID_Fatal, "VTKModes must contain positive numbers.", ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + RETURN + ELSE + DO i = 2, p_FAST%VTK_modes%VTKLinModes + IF ( p_FAST%VTK_modes%VTKModes(i) < 0 ) THEN + p_FAST%VTK_modes%VTKModes(i)=p_FAST%VTK_modes%VTKModes(i-1) + 1 + ENDIF + ENDDO + ENDIF + + + CALL ReadVar( UnIn, InputFile, p_FAST%VTK_modes%VTKLinScale, 'VTKLinScale', 'Mode shape visualization scaling factor', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL ReadVar( UnIn, InputFile, p_FAST%VTK_modes%VTKLinTim, 'VTKLinTim', 'Switch to make one animation for all LinTimes together (1) or separate animations for each LinTimes(2)', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL ReadVar( UnIn, InputFile, VTKLinTimes1, 'VTKLinTimes1', 'If VTKLinTim=2, visualize modes at LinTimes(1) only?', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + + CALL ReadVar( UnIn, InputFile, p_FAST%VTK_modes%VTKLinPhase, 'VTKLinPhase', 'Phase when making one animation for all LinTimes together (used only when VTKLinTim=1)', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + +! overwrite these based on inputs: + + if (p_FAST%VTK_modes%VTKLinTim == 2) then + p_FAST%VTK_modes%VTKLinPhase = 0 ! "Phase when making one animation for all LinTimes together (used only when VTKLinTim=1)" - + + if (VTKLinTimes1) then + p_FAST%VTK_modes%VTKNLinTimes = 1 + else + p_FAST%VTK_modes%VTKNLinTimes = p_FAST%NLinTimes + end if + else + p_FAST%VTK_modes%VTKNLinTimes = p_FAST%NLinTimes + end if + +contains + SUBROUTINE Cleanup() + IF (UnIn > 0) CLOSE(UnIn) + END SUBROUTINE Cleanup + +END SUBROUTINE ReadModeShapeFile +!---------------------------------------------------------------------------------------------------------------------------------- END MODULE FAST_Subs +!---------------------------------------------------------------------------------------------------------------------------------- diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index b68592f5c3..ec89c4a381 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -171,6 +171,7 @@ MODULE FAST_Types LOGICAL :: WrSttsTime !< Whether we should write the status times to the screen [-] INTEGER(IntKi) :: n_SttsTime !< Number of time steps between screen status messages [-] INTEGER(IntKi) :: n_ChkptTime !< Number of time steps between writing checkpoint files [-] + INTEGER(IntKi) :: n_DT_Out !< Number of time steps between writing a line in the time-marching output files [-] INTEGER(IntKi) :: n_VTKTime !< Number of time steps between writing VTK files [-] INTEGER(IntKi) :: TurbineType !< Type_LandBased, Type_Offshore_Fixed, or Type_Offshore_Floating [-] LOGICAL :: WrBinOutFile !< Write a binary output file? (.outb) [-] @@ -187,18 +188,28 @@ MODULE FAST_Types INTEGER(IntKi) :: TChanLen !< width of the time channel [-] CHARACTER(1024) :: OutFileRoot !< The rootname of the output files [-] CHARACTER(1024) :: FTitle !< The description line from the FAST (glue-code) input file [-] + CHARACTER(1024) :: VTK_OutFileRoot = '' !< The rootname of the VTK output files [-] + INTEGER(IntKi) :: VTK_tWidth !< Width of number of files for leading zeros in file name format [-] REAL(DbKi) :: VTK_fps !< number of frames per second to output VTK data [-] - REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: LinTimes !< List of times at which to linearize [s] + TYPE(FAST_VTK_SurfaceType) :: VTK_surface !< Data for VTK surface visualization [-] + REAL(SiKi) , DIMENSION(1:3) :: TurbinePos !< Initial position of turbine base (origin used for graphics) [m] + CHARACTER(4) :: Tdesc !< description of turbine ID (for FAST.Farm) screen printing [-] + LOGICAL :: CalcSteady !< Calculate a steady-state periodic operating point before linearization [unused if Linearize=False] [-] + INTEGER(IntKi) :: TrimCase !< Controller parameter to be trimmed {1:yaw; 2:torque; 3:pitch} [unused if Linearize=False; used only if CalcSteady=True] [-] + REAL(ReKi) :: TrimTol !< Tolerance for the rotational speed convergence (>0) [unused if Linearize=False; used only if CalcSteady=True] [-] + REAL(ReKi) :: TrimGain !< Proportional gain for the rotational speed error (>0) [unused if Linearize=False; used only if CalcSteady=True] [rad/(rad/s) for yaw or pitch; Nm/(rad/s) for torque] + REAL(ReKi) :: Twr_Kdmp !< Damping factor for the tower [unused if Linearize=False; used only if CalcSteady=True] [N/(m/s)] + REAL(ReKi) :: Bld_Kdmp !< Damping factor for the blades [unused if Linearize=False; used only if CalcSteady=True] [N/(m/s)] + INTEGER(IntKi) :: NLinTimes !< Number of LinTimes, or equally-spaced azimuth steps in periodic linearized model (>0)[unused if Linearize=False] [-] + REAL(DbKi) :: AzimDelta !< difference between two consecutive azimuth positions in CalcSteady algorithm [rad] INTEGER(IntKi) :: LinInputs !< Inputs included in linearization (switch) {0=none; 1=standard; 2=all module inputs (debug)} [unused if Linearize=False] [-] INTEGER(IntKi) :: LinOutputs !< Outputs included in linearization (switch) {0=none; 1=from OutList(s); 2=all module outputs (debug)} [unused if Linearize=False] [-] LOGICAL :: LinOutJac !< Include full Jacabians in linearization output (for debug) (flag) [unused if Linearize=False; used only if LinInputs=LinOutputs=2] [-] LOGICAL :: LinOutMod !< Write module-level linearization output files in addition to output for full system? (flag) [unused if Linearize=False] [-] - TYPE(FAST_VTK_SurfaceType) :: VTK_surface !< Data for VTK surface visualization [-] TYPE(FAST_VTK_ModeShapeType) :: VTK_modes !< Data for VTK mode-shape visualization [-] - REAL(SiKi) , DIMENSION(1:3) :: TurbinePos !< Initial position of turbine base (origin used for graphics) [m] INTEGER(IntKi) :: Lin_NumMods !< number of modules in the linearization [-] INTEGER(IntKi) , DIMENSION(NumModules) :: Lin_ModOrder !< indices that determine which order the modules are in the glue-code linearization matrix [-] - CHARACTER(4) :: Tdesc !< description of turbine ID (for FAST.Farm) screen printing [-] + INTEGER(IntKi) :: LinInterpOrder !< Interpolation order for CalcSteady solution [-] END TYPE FAST_ParameterType ! ======================= ! ========= FAST_LinStateSave ======= @@ -314,9 +325,26 @@ MODULE FAST_Types TYPE(FAST_ModLinType) , DIMENSION(NumModules) :: Modules !< Linearization data for each module [-] TYPE(FAST_LinType) :: Glue !< Linearization data for the glue code (coupled system) [-] REAL(ReKi) :: RotSpeed !< Rotor azimuth angular speed [rad/s] - REAL(ReKi) :: Azimuth + REAL(ReKi) :: Azimuth !< Rotor azimuth position [rad] + REAL(ReKi) :: WindSpeed !< Wind speed at reference height [m/s] END TYPE FAST_LinFileType ! ======================= +! ========= FAST_MiscLinType ======= + TYPE, PUBLIC :: FAST_MiscLinType + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: LinTimes !< List of times at which to linearize [s] + INTEGER(IntKi) :: CopyOP_CtrlCode !< if we are mesh control code for copy type [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: AzimTarget !< target azimuth positions in CalcSteady algorithm [rad] + LOGICAL :: IsConverged !< whether the error calculation in the CalcSteady algorithm is converged [-] + LOGICAL :: FoundSteady !< whether the CalcSteady algorithm found a steady-state solution [-] + INTEGER(IntKi) :: n_rot !< number of rotations completed in CalcSteady algorithm [-] + INTEGER(IntKi) :: AzimIndx !< index into target azimuth array in CalcSteady algorithm [-] + INTEGER(IntKi) :: NextLinTimeIndx !< index for next time in LinTimes where linearization should occur [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: Psi !< Azimuth angle at the current and previous time steps (uses LinInterpOrder); DbKi so that we can use registry-generated extrap/interp routines [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: y_interp !< Interpolated outputs packed into an array [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: y_ref !< Reference output range for CalcSteady error calculation [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Y_prevRot !< Linearization outputs from previous rotor revolution at each target azimuth [-] + END TYPE FAST_MiscLinType +! ======================= ! ========= FAST_OutputFileType ======= TYPE, PUBLIC :: FAST_OutputFileType REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: TimeData !< Array to contain the time output data for the binary file (first output time and a time [fixed] increment) [-] @@ -332,9 +360,12 @@ MODULE FAST_Types CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: ChannelUnits !< Units for the output channels [-] TYPE(ProgDesc) , DIMENSION(NumModules) :: Module_Ver !< version information from all modules [-] CHARACTER(ChanLen) , DIMENSION(NumModules) :: Module_Abrev !< abbreviation for module (used in file output naming conventions) [-] + LOGICAL :: WriteThisStep !< Whether this step will be written in the FAST output files [-] INTEGER(IntKi) :: VTK_count !< Number of VTK files written (for naming output files) [-] INTEGER(IntKi) :: VTK_LastWaveIndx !< last index into wave array [-] TYPE(FAST_LinFileType) :: Lin !< linearization data for output [-] + INTEGER(IntKi) :: ActualChanLen !< width of the column headers output in the text and/or binary file [-] + CHARACTER(30) :: OutFmt_a !< Format used for text tabular output (except time); combines OutFmt with delim and appropriate spaces [-] TYPE(FAST_LinStateSave) :: op !< operating points of states and inputs for VTK output of mode shapes [-] END TYPE FAST_OutputFileType ! ======================= @@ -362,6 +393,8 @@ MODULE FAST_Types 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 [-] + 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 @@ -376,7 +409,8 @@ MODULE FAST_Types 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 InputTimes [-] + TYPE(ED_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] + 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 @@ -391,6 +425,8 @@ MODULE FAST_Types 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_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 @@ -419,6 +455,8 @@ MODULE FAST_Types 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 [-] + 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 @@ -433,6 +471,8 @@ MODULE FAST_Types 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 [-] + 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 @@ -490,6 +530,8 @@ MODULE FAST_Types 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 [-] + 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 @@ -518,6 +560,8 @@ MODULE FAST_Types TYPE(MAP_InputType) :: u !< System inputs [-] TYPE(MAP_OutputType) :: y !< System outputs [-] 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 @@ -623,7 +667,7 @@ MODULE FAST_Types REAL(ReKi) :: ElecPwr !< electric power input from Simulink/Labview [-] REAL(ReKi) :: YawPosCom !< yaw position command from Simulink/Labview [-] REAL(ReKi) :: YawRateCom !< yaw rate command from Simulink/Labview [-] - REAL(ReKi) , DIMENSION(1:3) :: BlPitchCom !< blade pitch commands from Simulink/Labview [rad/s] + REAL(ReKi) , DIMENSION(1:3) :: BlPitchCom !< blade pitch commands from Simulink/Labview [rad] REAL(ReKi) :: HSSBrFrac !< Fraction of full braking torque: 0 (off) <= HSSBrFrac <= 1 (full) from Simulink or LabVIEW [-] REAL(ReKi) , DIMENSION(1:3) :: LidarFocus !< lidar focus (relative to lidar location) [m] END TYPE FAST_ExternInputType @@ -640,7 +684,7 @@ MODULE FAST_Types INTEGER(IntKi) , DIMENSION(1:8) :: SimStrtTime !< Start time of simulation (after initialization) [-] LOGICAL :: calcJacobian !< Should we calculate Jacobians in Option 1? [(flag)] TYPE(FAST_ExternInputType) :: ExternInput !< external input values [-] - INTEGER(IntKi) :: NextLinTimeIndx !< index for next time in LinTimes where linearization should occur [-] + TYPE(FAST_MiscLinType) :: Lin !< misc data for linearization analysis [-] END TYPE FAST_MiscVarType ! ======================= ! ========= FAST_ExternInitType ======= @@ -2035,6 +2079,7 @@ SUBROUTINE FAST_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%WrSttsTime = SrcParamData%WrSttsTime DstParamData%n_SttsTime = SrcParamData%n_SttsTime DstParamData%n_ChkptTime = SrcParamData%n_ChkptTime + DstParamData%n_DT_Out = SrcParamData%n_DT_Out DstParamData%n_VTKTime = SrcParamData%n_VTKTime DstParamData%TurbineType = SrcParamData%TurbineType DstParamData%WrBinOutFile = SrcParamData%WrBinOutFile @@ -2051,33 +2096,32 @@ SUBROUTINE FAST_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%TChanLen = SrcParamData%TChanLen DstParamData%OutFileRoot = SrcParamData%OutFileRoot DstParamData%FTitle = SrcParamData%FTitle + DstParamData%VTK_OutFileRoot = SrcParamData%VTK_OutFileRoot + DstParamData%VTK_tWidth = SrcParamData%VTK_tWidth DstParamData%VTK_fps = SrcParamData%VTK_fps -IF (ALLOCATED(SrcParamData%LinTimes)) THEN - i1_l = LBOUND(SrcParamData%LinTimes,1) - i1_u = UBOUND(SrcParamData%LinTimes,1) - IF (.NOT. ALLOCATED(DstParamData%LinTimes)) THEN - ALLOCATE(DstParamData%LinTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%LinTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%LinTimes = SrcParamData%LinTimes -ENDIF + CALL FAST_Copyvtk_surfacetype( SrcParamData%VTK_surface, DstParamData%VTK_surface, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + DstParamData%TurbinePos = SrcParamData%TurbinePos + DstParamData%Tdesc = SrcParamData%Tdesc + DstParamData%CalcSteady = SrcParamData%CalcSteady + DstParamData%TrimCase = SrcParamData%TrimCase + DstParamData%TrimTol = SrcParamData%TrimTol + DstParamData%TrimGain = SrcParamData%TrimGain + DstParamData%Twr_Kdmp = SrcParamData%Twr_Kdmp + DstParamData%Bld_Kdmp = SrcParamData%Bld_Kdmp + DstParamData%NLinTimes = SrcParamData%NLinTimes + DstParamData%AzimDelta = SrcParamData%AzimDelta DstParamData%LinInputs = SrcParamData%LinInputs DstParamData%LinOutputs = SrcParamData%LinOutputs DstParamData%LinOutJac = SrcParamData%LinOutJac DstParamData%LinOutMod = SrcParamData%LinOutMod - CALL FAST_Copyvtk_surfacetype( SrcParamData%VTK_surface, DstParamData%VTK_surface, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN CALL FAST_Copyvtk_modeshapetype( SrcParamData%VTK_modes, DstParamData%VTK_modes, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - DstParamData%TurbinePos = SrcParamData%TurbinePos DstParamData%Lin_NumMods = SrcParamData%Lin_NumMods DstParamData%Lin_ModOrder = SrcParamData%Lin_ModOrder - DstParamData%Tdesc = SrcParamData%Tdesc + DstParamData%LinInterpOrder = SrcParamData%LinInterpOrder END SUBROUTINE FAST_CopyParam SUBROUTINE FAST_DestroyParam( ParamData, ErrStat, ErrMsg ) @@ -2089,9 +2133,6 @@ SUBROUTINE FAST_DestroyParam( ParamData, ErrStat, ErrMsg ) ! ErrStat = ErrID_None ErrMsg = "" -IF (ALLOCATED(ParamData%LinTimes)) THEN - DEALLOCATE(ParamData%LinTimes) -ENDIF CALL FAST_Destroyvtk_surfacetype( ParamData%VTK_surface, ErrStat, ErrMsg ) CALL FAST_Destroyvtk_modeshapetype( ParamData%VTK_modes, ErrStat, ErrMsg ) END SUBROUTINE FAST_DestroyParam @@ -2170,6 +2211,7 @@ SUBROUTINE FAST_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_BufSz = Int_BufSz + 1 ! WrSttsTime Int_BufSz = Int_BufSz + 1 ! n_SttsTime Int_BufSz = Int_BufSz + 1 ! n_ChkptTime + Int_BufSz = Int_BufSz + 1 ! n_DT_Out Int_BufSz = Int_BufSz + 1 ! n_VTKTime Int_BufSz = Int_BufSz + 1 ! TurbineType Int_BufSz = Int_BufSz + 1 ! WrBinOutFile @@ -2186,16 +2228,9 @@ SUBROUTINE FAST_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_BufSz = Int_BufSz + 1 ! TChanLen Int_BufSz = Int_BufSz + 1*LEN(InData%OutFileRoot) ! OutFileRoot Int_BufSz = Int_BufSz + 1*LEN(InData%FTitle) ! FTitle + Int_BufSz = Int_BufSz + 1*LEN(InData%VTK_OutFileRoot) ! VTK_OutFileRoot + Int_BufSz = Int_BufSz + 1 ! VTK_tWidth Db_BufSz = Db_BufSz + 1 ! VTK_fps - Int_BufSz = Int_BufSz + 1 ! LinTimes allocated yes/no - IF ( ALLOCATED(InData%LinTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%LinTimes) ! LinTimes - END IF - Int_BufSz = Int_BufSz + 1 ! LinInputs - Int_BufSz = Int_BufSz + 1 ! LinOutputs - Int_BufSz = Int_BufSz + 1 ! LinOutJac - Int_BufSz = Int_BufSz + 1 ! LinOutMod ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! VTK_surface: size of buffers for each call to pack subtype CALL FAST_Packvtk_surfacetype( Re_Buf, Db_Buf, Int_Buf, InData%VTK_surface, ErrStat2, ErrMsg2, .TRUE. ) ! VTK_surface @@ -2214,6 +2249,20 @@ SUBROUTINE FAST_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF + Re_BufSz = Re_BufSz + SIZE(InData%TurbinePos) ! TurbinePos + Int_BufSz = Int_BufSz + 1*LEN(InData%Tdesc) ! Tdesc + Int_BufSz = Int_BufSz + 1 ! CalcSteady + Int_BufSz = Int_BufSz + 1 ! TrimCase + Re_BufSz = Re_BufSz + 1 ! TrimTol + Re_BufSz = Re_BufSz + 1 ! TrimGain + Re_BufSz = Re_BufSz + 1 ! Twr_Kdmp + Re_BufSz = Re_BufSz + 1 ! Bld_Kdmp + Int_BufSz = Int_BufSz + 1 ! NLinTimes + Db_BufSz = Db_BufSz + 1 ! AzimDelta + Int_BufSz = Int_BufSz + 1 ! LinInputs + Int_BufSz = Int_BufSz + 1 ! LinOutputs + Int_BufSz = Int_BufSz + 1 ! LinOutJac + Int_BufSz = Int_BufSz + 1 ! LinOutMod Int_BufSz = Int_BufSz + 3 ! VTK_modes: size of buffers for each call to pack subtype CALL FAST_Packvtk_modeshapetype( Re_Buf, Db_Buf, Int_Buf, InData%VTK_modes, ErrStat2, ErrMsg2, .TRUE. ) ! VTK_modes CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2231,10 +2280,9 @@ SUBROUTINE FAST_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF - Re_BufSz = Re_BufSz + SIZE(InData%TurbinePos) ! TurbinePos Int_BufSz = Int_BufSz + 1 ! Lin_NumMods Int_BufSz = Int_BufSz + SIZE(InData%Lin_ModOrder) ! Lin_ModOrder - Int_BufSz = Int_BufSz + 1*LEN(InData%Tdesc) ! Tdesc + Int_BufSz = Int_BufSz + 1 ! LinInterpOrder IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -2368,6 +2416,8 @@ SUBROUTINE FAST_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = InData%n_ChkptTime Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%n_DT_Out + Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = InData%n_VTKTime Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = InData%TurbineType @@ -2410,31 +2460,14 @@ SUBROUTINE FAST_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf(Int_Xferred) = ICHAR(InData%FTitle(I:I), IntKi) Int_Xferred = Int_Xferred + 1 END DO ! I + DO I = 1, LEN(InData%VTK_OutFileRoot) + IntKiBuf(Int_Xferred) = ICHAR(InData%VTK_OutFileRoot(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%VTK_tWidth + Int_Xferred = Int_Xferred + 1 DbKiBuf(Db_Xferred) = InData%VTK_fps Db_Xferred = Db_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%LinTimes) ) 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%LinTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinTimes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinTimes,1), UBOUND(InData%LinTimes,1) - DbKiBuf(Db_Xferred) = InData%LinTimes(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%LinInputs - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%LinOutputs - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%LinOutJac, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%LinOutMod, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 CALL FAST_Packvtk_surfacetype( Re_Buf, Db_Buf, Int_Buf, InData%VTK_surface, ErrStat2, ErrMsg2, OnlySize ) ! VTK_surface CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2463,6 +2496,38 @@ SUBROUTINE FAST_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF + DO i1 = LBOUND(InData%TurbinePos,1), UBOUND(InData%TurbinePos,1) + ReKiBuf(Re_Xferred) = InData%TurbinePos(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO I = 1, LEN(InData%Tdesc) + IntKiBuf(Int_Xferred) = ICHAR(InData%Tdesc(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%CalcSteady, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TrimCase + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TrimTol + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TrimGain + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Twr_Kdmp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Bld_Kdmp + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NLinTimes + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%AzimDelta + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%LinInputs + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%LinOutputs + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%LinOutJac, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%LinOutMod, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 CALL FAST_Packvtk_modeshapetype( Re_Buf, Db_Buf, Int_Buf, InData%VTK_modes, ErrStat2, ErrMsg2, OnlySize ) ! VTK_modes CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2491,20 +2556,14 @@ SUBROUTINE FAST_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - DO i1 = LBOUND(InData%TurbinePos,1), UBOUND(InData%TurbinePos,1) - ReKiBuf(Re_Xferred) = InData%TurbinePos(i1) - Re_Xferred = Re_Xferred + 1 - END DO IntKiBuf(Int_Xferred) = InData%Lin_NumMods Int_Xferred = Int_Xferred + 1 DO i1 = LBOUND(InData%Lin_ModOrder,1), UBOUND(InData%Lin_ModOrder,1) IntKiBuf(Int_Xferred) = InData%Lin_ModOrder(i1) Int_Xferred = Int_Xferred + 1 END DO - DO I = 1, LEN(InData%Tdesc) - IntKiBuf(Int_Xferred) = ICHAR(InData%Tdesc(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + IntKiBuf(Int_Xferred) = InData%LinInterpOrder + Int_Xferred = Int_Xferred + 1 END SUBROUTINE FAST_PackParam SUBROUTINE FAST_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2650,6 +2709,8 @@ SUBROUTINE FAST_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Int_Xferred = Int_Xferred + 1 OutData%n_ChkptTime = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 + OutData%n_DT_Out = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 OutData%n_VTKTime = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 OutData%TurbineType = IntKiBuf(Int_Xferred) @@ -2692,34 +2753,14 @@ SUBROUTINE FAST_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs OutData%FTitle(I:I) = CHAR(IntKiBuf(Int_Xferred)) Int_Xferred = Int_Xferred + 1 END DO ! I + DO I = 1, LEN(OutData%VTK_OutFileRoot) + OutData%VTK_OutFileRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%VTK_tWidth = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 OutData%VTK_fps = DbKiBuf(Db_Xferred) Db_Xferred = Db_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinTimes 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%LinTimes)) DEALLOCATE(OutData%LinTimes) - ALLOCATE(OutData%LinTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinTimes,1), UBOUND(OutData%LinTimes,1) - OutData%LinTimes(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - OutData%LinInputs = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%LinOutputs = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%LinOutJac = TRANSFER(IntKiBuf(Int_Xferred), OutData%LinOutJac) - Int_Xferred = Int_Xferred + 1 - OutData%LinOutMod = TRANSFER(IntKiBuf(Int_Xferred), OutData%LinOutMod) - Int_Xferred = Int_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -2760,6 +2801,40 @@ SUBROUTINE FAST_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + i1_l = LBOUND(OutData%TurbinePos,1) + i1_u = UBOUND(OutData%TurbinePos,1) + DO i1 = LBOUND(OutData%TurbinePos,1), UBOUND(OutData%TurbinePos,1) + OutData%TurbinePos(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + DO I = 1, LEN(OutData%Tdesc) + OutData%Tdesc(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%CalcSteady = TRANSFER(IntKiBuf(Int_Xferred), OutData%CalcSteady) + Int_Xferred = Int_Xferred + 1 + OutData%TrimCase = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TrimTol = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TrimGain = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Twr_Kdmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Bld_Kdmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NLinTimes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%AzimDelta = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%LinInputs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%LinOutputs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%LinOutJac = TRANSFER(IntKiBuf(Int_Xferred), OutData%LinOutJac) + Int_Xferred = Int_Xferred + 1 + OutData%LinOutMod = TRANSFER(IntKiBuf(Int_Xferred), OutData%LinOutMod) + Int_Xferred = Int_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -2800,12 +2875,6 @@ SUBROUTINE FAST_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - i1_l = LBOUND(OutData%TurbinePos,1) - i1_u = UBOUND(OutData%TurbinePos,1) - DO i1 = LBOUND(OutData%TurbinePos,1), UBOUND(OutData%TurbinePos,1) - OutData%TurbinePos(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO OutData%Lin_NumMods = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%Lin_ModOrder,1) @@ -2814,10 +2883,8 @@ SUBROUTINE FAST_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs OutData%Lin_ModOrder(i1) = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 END DO - DO I = 1, LEN(OutData%Tdesc) - OutData%Tdesc(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + OutData%LinInterpOrder = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE FAST_UnPackParam SUBROUTINE FAST_CopyLinStateSave( SrcLinStateSaveData, DstLinStateSaveData, CtrlCode, ErrStat, ErrMsg ) @@ -14242,6 +14309,7 @@ SUBROUTINE FAST_CopyLinFileType( SrcLinFileTypeData, DstLinFileTypeData, CtrlCod IF (ErrStat>=AbortErrLev) RETURN DstLinFileTypeData%RotSpeed = SrcLinFileTypeData%RotSpeed DstLinFileTypeData%Azimuth = SrcLinFileTypeData%Azimuth + DstLinFileTypeData%WindSpeed = SrcLinFileTypeData%WindSpeed END SUBROUTINE FAST_CopyLinFileType SUBROUTINE FAST_DestroyLinFileType( LinFileTypeData, ErrStat, ErrMsg ) @@ -14333,6 +14401,7 @@ SUBROUTINE FAST_PackLinFileType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er END IF Re_BufSz = Re_BufSz + 1 ! RotSpeed Re_BufSz = Re_BufSz + 1 ! Azimuth + Re_BufSz = Re_BufSz + 1 ! WindSpeed IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -14422,6 +14491,8 @@ SUBROUTINE FAST_PackLinFileType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Re_Xferred = Re_Xferred + 1 ReKiBuf(Re_Xferred) = InData%Azimuth Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WindSpeed + Re_Xferred = Re_Xferred + 1 END SUBROUTINE FAST_PackLinFileType SUBROUTINE FAST_UnPackLinFileType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -14539,11 +14610,13 @@ SUBROUTINE FAST_UnPackLinFileType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = Re_Xferred + 1 OutData%Azimuth = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 + OutData%WindSpeed = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE FAST_UnPackLinFileType - SUBROUTINE FAST_CopyOutputFileType( SrcOutputFileTypeData, DstOutputFileTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_OutputFileType), INTENT(INOUT) :: SrcOutputFileTypeData - TYPE(FAST_OutputFileType), INTENT(INOUT) :: DstOutputFileTypeData + SUBROUTINE FAST_CopyMiscLinType( SrcMiscLinTypeData, DstMiscLinTypeData, CtrlCode, ErrStat, ErrMsg ) + TYPE(FAST_MiscLinType), INTENT(IN) :: SrcMiscLinTypeData + TYPE(FAST_MiscLinType), INTENT(INOUT) :: DstMiscLinTypeData INTEGER(IntKi), INTENT(IN ) :: CtrlCode INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg @@ -14553,116 +14626,126 @@ SUBROUTINE FAST_CopyOutputFileType( SrcOutputFileTypeData, DstOutputFileTypeData INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyOutputFileType' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyMiscLinType' ! ErrStat = ErrID_None ErrMsg = "" -IF (ALLOCATED(SrcOutputFileTypeData%TimeData)) THEN - i1_l = LBOUND(SrcOutputFileTypeData%TimeData,1) - i1_u = UBOUND(SrcOutputFileTypeData%TimeData,1) - IF (.NOT. ALLOCATED(DstOutputFileTypeData%TimeData)) THEN - ALLOCATE(DstOutputFileTypeData%TimeData(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcMiscLinTypeData%LinTimes)) THEN + i1_l = LBOUND(SrcMiscLinTypeData%LinTimes,1) + i1_u = UBOUND(SrcMiscLinTypeData%LinTimes,1) + IF (.NOT. ALLOCATED(DstMiscLinTypeData%LinTimes)) THEN + ALLOCATE(DstMiscLinTypeData%LinTimes(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%TimeData.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%LinTimes.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstOutputFileTypeData%TimeData = SrcOutputFileTypeData%TimeData + DstMiscLinTypeData%LinTimes = SrcMiscLinTypeData%LinTimes ENDIF -IF (ALLOCATED(SrcOutputFileTypeData%AllOutData)) THEN - i1_l = LBOUND(SrcOutputFileTypeData%AllOutData,1) - i1_u = UBOUND(SrcOutputFileTypeData%AllOutData,1) - i2_l = LBOUND(SrcOutputFileTypeData%AllOutData,2) - i2_u = UBOUND(SrcOutputFileTypeData%AllOutData,2) - IF (.NOT. ALLOCATED(DstOutputFileTypeData%AllOutData)) THEN - ALLOCATE(DstOutputFileTypeData%AllOutData(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + DstMiscLinTypeData%CopyOP_CtrlCode = SrcMiscLinTypeData%CopyOP_CtrlCode +IF (ALLOCATED(SrcMiscLinTypeData%AzimTarget)) THEN + i1_l = LBOUND(SrcMiscLinTypeData%AzimTarget,1) + i1_u = UBOUND(SrcMiscLinTypeData%AzimTarget,1) + IF (.NOT. ALLOCATED(DstMiscLinTypeData%AzimTarget)) THEN + ALLOCATE(DstMiscLinTypeData%AzimTarget(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%AllOutData.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%AzimTarget.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstOutputFileTypeData%AllOutData = SrcOutputFileTypeData%AllOutData + DstMiscLinTypeData%AzimTarget = SrcMiscLinTypeData%AzimTarget ENDIF - DstOutputFileTypeData%n_Out = SrcOutputFileTypeData%n_Out - DstOutputFileTypeData%NOutSteps = SrcOutputFileTypeData%NOutSteps - DstOutputFileTypeData%numOuts = SrcOutputFileTypeData%numOuts - DstOutputFileTypeData%UnOu = SrcOutputFileTypeData%UnOu - DstOutputFileTypeData%UnSum = SrcOutputFileTypeData%UnSum - DstOutputFileTypeData%UnGra = SrcOutputFileTypeData%UnGra - DstOutputFileTypeData%FileDescLines = SrcOutputFileTypeData%FileDescLines -IF (ALLOCATED(SrcOutputFileTypeData%ChannelNames)) THEN - i1_l = LBOUND(SrcOutputFileTypeData%ChannelNames,1) - i1_u = UBOUND(SrcOutputFileTypeData%ChannelNames,1) - IF (.NOT. ALLOCATED(DstOutputFileTypeData%ChannelNames)) THEN - ALLOCATE(DstOutputFileTypeData%ChannelNames(i1_l:i1_u),STAT=ErrStat2) + DstMiscLinTypeData%IsConverged = SrcMiscLinTypeData%IsConverged + DstMiscLinTypeData%FoundSteady = SrcMiscLinTypeData%FoundSteady + DstMiscLinTypeData%n_rot = SrcMiscLinTypeData%n_rot + DstMiscLinTypeData%AzimIndx = SrcMiscLinTypeData%AzimIndx + DstMiscLinTypeData%NextLinTimeIndx = SrcMiscLinTypeData%NextLinTimeIndx +IF (ALLOCATED(SrcMiscLinTypeData%Psi)) THEN + i1_l = LBOUND(SrcMiscLinTypeData%Psi,1) + i1_u = UBOUND(SrcMiscLinTypeData%Psi,1) + IF (.NOT. ALLOCATED(DstMiscLinTypeData%Psi)) THEN + ALLOCATE(DstMiscLinTypeData%Psi(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%ChannelNames.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%Psi.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstOutputFileTypeData%ChannelNames = SrcOutputFileTypeData%ChannelNames + DstMiscLinTypeData%Psi = SrcMiscLinTypeData%Psi ENDIF -IF (ALLOCATED(SrcOutputFileTypeData%ChannelUnits)) THEN - i1_l = LBOUND(SrcOutputFileTypeData%ChannelUnits,1) - i1_u = UBOUND(SrcOutputFileTypeData%ChannelUnits,1) - IF (.NOT. ALLOCATED(DstOutputFileTypeData%ChannelUnits)) THEN - ALLOCATE(DstOutputFileTypeData%ChannelUnits(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcMiscLinTypeData%y_interp)) THEN + i1_l = LBOUND(SrcMiscLinTypeData%y_interp,1) + i1_u = UBOUND(SrcMiscLinTypeData%y_interp,1) + IF (.NOT. ALLOCATED(DstMiscLinTypeData%y_interp)) THEN + ALLOCATE(DstMiscLinTypeData%y_interp(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%ChannelUnits.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%y_interp.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstOutputFileTypeData%ChannelUnits = SrcOutputFileTypeData%ChannelUnits + DstMiscLinTypeData%y_interp = SrcMiscLinTypeData%y_interp ENDIF - DO i1 = LBOUND(SrcOutputFileTypeData%Module_Ver,1), UBOUND(SrcOutputFileTypeData%Module_Ver,1) - CALL NWTC_Library_Copyprogdesc( SrcOutputFileTypeData%Module_Ver(i1), DstOutputFileTypeData%Module_Ver(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DstOutputFileTypeData%Module_Abrev = SrcOutputFileTypeData%Module_Abrev - DstOutputFileTypeData%VTK_count = SrcOutputFileTypeData%VTK_count - DstOutputFileTypeData%VTK_LastWaveIndx = SrcOutputFileTypeData%VTK_LastWaveIndx - CALL FAST_Copylinfiletype( SrcOutputFileTypeData%Lin, DstOutputFileTypeData%Lin, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copylinstatesave( SrcOutputFileTypeData%op, DstOutputFileTypeData%op, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE FAST_CopyOutputFileType +IF (ALLOCATED(SrcMiscLinTypeData%y_ref)) THEN + i1_l = LBOUND(SrcMiscLinTypeData%y_ref,1) + i1_u = UBOUND(SrcMiscLinTypeData%y_ref,1) + IF (.NOT. ALLOCATED(DstMiscLinTypeData%y_ref)) THEN + ALLOCATE(DstMiscLinTypeData%y_ref(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%y_ref.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscLinTypeData%y_ref = SrcMiscLinTypeData%y_ref +ENDIF +IF (ALLOCATED(SrcMiscLinTypeData%Y_prevRot)) THEN + i1_l = LBOUND(SrcMiscLinTypeData%Y_prevRot,1) + i1_u = UBOUND(SrcMiscLinTypeData%Y_prevRot,1) + i2_l = LBOUND(SrcMiscLinTypeData%Y_prevRot,2) + i2_u = UBOUND(SrcMiscLinTypeData%Y_prevRot,2) + IF (.NOT. ALLOCATED(DstMiscLinTypeData%Y_prevRot)) THEN + ALLOCATE(DstMiscLinTypeData%Y_prevRot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%Y_prevRot.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscLinTypeData%Y_prevRot = SrcMiscLinTypeData%Y_prevRot +ENDIF + END SUBROUTINE FAST_CopyMiscLinType - SUBROUTINE FAST_DestroyOutputFileType( OutputFileTypeData, ErrStat, ErrMsg ) - TYPE(FAST_OutputFileType), INTENT(INOUT) :: OutputFileTypeData + SUBROUTINE FAST_DestroyMiscLinType( MiscLinTypeData, ErrStat, ErrMsg ) + TYPE(FAST_MiscLinType), INTENT(INOUT) :: MiscLinTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyOutputFileType' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyMiscLinType' INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 ! ErrStat = ErrID_None ErrMsg = "" -IF (ALLOCATED(OutputFileTypeData%TimeData)) THEN - DEALLOCATE(OutputFileTypeData%TimeData) +IF (ALLOCATED(MiscLinTypeData%LinTimes)) THEN + DEALLOCATE(MiscLinTypeData%LinTimes) ENDIF -IF (ALLOCATED(OutputFileTypeData%AllOutData)) THEN - DEALLOCATE(OutputFileTypeData%AllOutData) +IF (ALLOCATED(MiscLinTypeData%AzimTarget)) THEN + DEALLOCATE(MiscLinTypeData%AzimTarget) ENDIF -IF (ALLOCATED(OutputFileTypeData%ChannelNames)) THEN - DEALLOCATE(OutputFileTypeData%ChannelNames) +IF (ALLOCATED(MiscLinTypeData%Psi)) THEN + DEALLOCATE(MiscLinTypeData%Psi) ENDIF -IF (ALLOCATED(OutputFileTypeData%ChannelUnits)) THEN - DEALLOCATE(OutputFileTypeData%ChannelUnits) +IF (ALLOCATED(MiscLinTypeData%y_interp)) THEN + DEALLOCATE(MiscLinTypeData%y_interp) ENDIF -DO i1 = LBOUND(OutputFileTypeData%Module_Ver,1), UBOUND(OutputFileTypeData%Module_Ver,1) - CALL NWTC_Library_Destroyprogdesc( OutputFileTypeData%Module_Ver(i1), ErrStat, ErrMsg ) -ENDDO - CALL FAST_Destroylinfiletype( OutputFileTypeData%Lin, ErrStat, ErrMsg ) - CALL FAST_Destroylinstatesave( OutputFileTypeData%op, ErrStat, ErrMsg ) - END SUBROUTINE FAST_DestroyOutputFileType +IF (ALLOCATED(MiscLinTypeData%y_ref)) THEN + DEALLOCATE(MiscLinTypeData%y_ref) +ENDIF +IF (ALLOCATED(MiscLinTypeData%Y_prevRot)) THEN + DEALLOCATE(MiscLinTypeData%Y_prevRot) +ENDIF + END SUBROUTINE FAST_DestroyMiscLinType - SUBROUTINE FAST_PackOutputFileType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + SUBROUTINE FAST_PackMiscLinType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FAST_OutputFileType), INTENT(IN) :: InData + TYPE(FAST_MiscLinType), INTENT(IN) :: InData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly @@ -14677,7 +14760,7 @@ SUBROUTINE FAST_PackOutputFileType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackOutputFileType' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackMiscLinType' ! buffers to store subtypes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -14693,90 +14776,575 @@ SUBROUTINE FAST_PackOutputFileType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Re_BufSz = 0 Db_BufSz = 0 Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! TimeData allocated yes/no - IF ( ALLOCATED(InData%TimeData) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TimeData upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%TimeData) ! TimeData + Int_BufSz = Int_BufSz + 1 ! LinTimes allocated yes/no + IF ( ALLOCATED(InData%LinTimes) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! LinTimes upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%LinTimes) ! LinTimes END IF - Int_BufSz = Int_BufSz + 1 ! AllOutData allocated yes/no - IF ( ALLOCATED(InData%AllOutData) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AllOutData upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AllOutData) ! AllOutData + Int_BufSz = Int_BufSz + 1 ! CopyOP_CtrlCode + Int_BufSz = Int_BufSz + 1 ! AzimTarget allocated yes/no + IF ( ALLOCATED(InData%AzimTarget) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! AzimTarget upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%AzimTarget) ! AzimTarget END IF - Int_BufSz = Int_BufSz + 1 ! n_Out - Int_BufSz = Int_BufSz + 1 ! NOutSteps - Int_BufSz = Int_BufSz + SIZE(InData%numOuts) ! numOuts - Int_BufSz = Int_BufSz + 1 ! UnOu - Int_BufSz = Int_BufSz + 1 ! UnSum - Int_BufSz = Int_BufSz + 1 ! UnGra - Int_BufSz = Int_BufSz + SIZE(InData%FileDescLines)*LEN(InData%FileDescLines) ! FileDescLines - Int_BufSz = Int_BufSz + 1 ! ChannelNames allocated yes/no - IF ( ALLOCATED(InData%ChannelNames) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ChannelNames upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ChannelNames)*LEN(InData%ChannelNames) ! ChannelNames - END IF - Int_BufSz = Int_BufSz + 1 ! ChannelUnits allocated yes/no - IF ( ALLOCATED(InData%ChannelUnits) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ChannelUnits upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ChannelUnits)*LEN(InData%ChannelUnits) ! ChannelUnits + Int_BufSz = Int_BufSz + 1 ! IsConverged + Int_BufSz = Int_BufSz + 1 ! FoundSteady + Int_BufSz = Int_BufSz + 1 ! n_rot + Int_BufSz = Int_BufSz + 1 ! AzimIndx + Int_BufSz = Int_BufSz + 1 ! NextLinTimeIndx + Int_BufSz = Int_BufSz + 1 ! Psi allocated yes/no + IF ( ALLOCATED(InData%Psi) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Psi upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%Psi) ! Psi + END IF + Int_BufSz = Int_BufSz + 1 ! y_interp allocated yes/no + IF ( ALLOCATED(InData%y_interp) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! y_interp upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%y_interp) ! y_interp + END IF + Int_BufSz = Int_BufSz + 1 ! y_ref allocated yes/no + IF ( ALLOCATED(InData%y_ref) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! y_ref upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%y_ref) ! y_ref + END IF + Int_BufSz = Int_BufSz + 1 ! Y_prevRot allocated yes/no + IF ( ALLOCATED(InData%Y_prevRot) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Y_prevRot upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Y_prevRot) ! Y_prevRot END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%Module_Ver,1), UBOUND(InData%Module_Ver,1) - Int_BufSz = Int_BufSz + 3 ! Module_Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Module_Ver(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Module_Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Module_Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Module_Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Module_Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + SIZE(InData%Module_Abrev)*LEN(InData%Module_Abrev) ! Module_Abrev - Int_BufSz = Int_BufSz + 1 ! VTK_count - Int_BufSz = Int_BufSz + 1 ! VTK_LastWaveIndx - Int_BufSz = Int_BufSz + 3 ! Lin: size of buffers for each call to pack subtype - CALL FAST_Packlinfiletype( Re_Buf, Db_Buf, Int_Buf, InData%Lin, ErrStat2, ErrMsg2, .TRUE. ) ! Lin - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Lin - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Lin - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Lin - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! op: size of buffers for each call to pack subtype - CALL FAST_Packlinstatesave( Re_Buf, Db_Buf, Int_Buf, InData%op, ErrStat2, ErrMsg2, .TRUE. ) ! op - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! op - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! op - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! op - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IF ( .NOT. ALLOCATED(InData%LinTimes) ) 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%LinTimes,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinTimes,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%LinTimes,1), UBOUND(InData%LinTimes,1) + DbKiBuf(Db_Xferred) = InData%LinTimes(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = InData%CopyOP_CtrlCode + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%AzimTarget) ) 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%AzimTarget,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AzimTarget,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%AzimTarget,1), UBOUND(InData%AzimTarget,1) + DbKiBuf(Db_Xferred) = InData%AzimTarget(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = TRANSFER(InData%IsConverged, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%FoundSteady, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%n_rot + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%AzimIndx + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NextLinTimeIndx + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%Psi) ) 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%Psi,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Psi,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Psi,1), UBOUND(InData%Psi,1) + DbKiBuf(Db_Xferred) = InData%Psi(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%y_interp) ) 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%y_interp,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y_interp,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%y_interp,1), UBOUND(InData%y_interp,1) + ReKiBuf(Re_Xferred) = InData%y_interp(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%y_ref) ) 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%y_ref,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y_ref,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%y_ref,1), UBOUND(InData%y_ref,1) + ReKiBuf(Re_Xferred) = InData%y_ref(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Y_prevRot) ) 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%Y_prevRot,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Y_prevRot,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Y_prevRot,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Y_prevRot,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%Y_prevRot,2), UBOUND(InData%Y_prevRot,2) + DO i1 = LBOUND(InData%Y_prevRot,1), UBOUND(InData%Y_prevRot,1) + ReKiBuf(Re_Xferred) = InData%Y_prevRot(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + END SUBROUTINE FAST_PackMiscLinType + + SUBROUTINE FAST_UnPackMiscLinType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(FAST_MiscLinType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackMiscLinType' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinTimes 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%LinTimes)) DEALLOCATE(OutData%LinTimes) + ALLOCATE(OutData%LinTimes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinTimes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%LinTimes,1), UBOUND(OutData%LinTimes,1) + OutData%LinTimes(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + OutData%CopyOP_CtrlCode = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AzimTarget 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%AzimTarget)) DEALLOCATE(OutData%AzimTarget) + ALLOCATE(OutData%AzimTarget(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AzimTarget.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%AzimTarget,1), UBOUND(OutData%AzimTarget,1) + OutData%AzimTarget(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + OutData%IsConverged = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsConverged) + Int_Xferred = Int_Xferred + 1 + OutData%FoundSteady = TRANSFER(IntKiBuf(Int_Xferred), OutData%FoundSteady) + Int_Xferred = Int_Xferred + 1 + OutData%n_rot = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%AzimIndx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NextLinTimeIndx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Psi 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%Psi)) DEALLOCATE(OutData%Psi) + ALLOCATE(OutData%Psi(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Psi.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Psi,1), UBOUND(OutData%Psi,1) + OutData%Psi(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y_interp 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%y_interp)) DEALLOCATE(OutData%y_interp) + ALLOCATE(OutData%y_interp(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_interp.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%y_interp,1), UBOUND(OutData%y_interp,1) + OutData%y_interp(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y_ref 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%y_ref)) DEALLOCATE(OutData%y_ref) + ALLOCATE(OutData%y_ref(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_ref.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%y_ref,1), UBOUND(OutData%y_ref,1) + OutData%y_ref(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Y_prevRot 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%Y_prevRot)) DEALLOCATE(OutData%Y_prevRot) + ALLOCATE(OutData%Y_prevRot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y_prevRot.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%Y_prevRot,2), UBOUND(OutData%Y_prevRot,2) + DO i1 = LBOUND(OutData%Y_prevRot,1), UBOUND(OutData%Y_prevRot,1) + OutData%Y_prevRot(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + END SUBROUTINE FAST_UnPackMiscLinType + + SUBROUTINE FAST_CopyOutputFileType( SrcOutputFileTypeData, DstOutputFileTypeData, CtrlCode, ErrStat, ErrMsg ) + TYPE(FAST_OutputFileType), INTENT(INOUT) :: SrcOutputFileTypeData + TYPE(FAST_OutputFileType), INTENT(INOUT) :: DstOutputFileTypeData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyOutputFileType' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(SrcOutputFileTypeData%TimeData)) THEN + i1_l = LBOUND(SrcOutputFileTypeData%TimeData,1) + i1_u = UBOUND(SrcOutputFileTypeData%TimeData,1) + IF (.NOT. ALLOCATED(DstOutputFileTypeData%TimeData)) THEN + ALLOCATE(DstOutputFileTypeData%TimeData(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%TimeData.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstOutputFileTypeData%TimeData = SrcOutputFileTypeData%TimeData +ENDIF +IF (ALLOCATED(SrcOutputFileTypeData%AllOutData)) THEN + i1_l = LBOUND(SrcOutputFileTypeData%AllOutData,1) + i1_u = UBOUND(SrcOutputFileTypeData%AllOutData,1) + i2_l = LBOUND(SrcOutputFileTypeData%AllOutData,2) + i2_u = UBOUND(SrcOutputFileTypeData%AllOutData,2) + IF (.NOT. ALLOCATED(DstOutputFileTypeData%AllOutData)) THEN + ALLOCATE(DstOutputFileTypeData%AllOutData(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%AllOutData.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstOutputFileTypeData%AllOutData = SrcOutputFileTypeData%AllOutData +ENDIF + DstOutputFileTypeData%n_Out = SrcOutputFileTypeData%n_Out + DstOutputFileTypeData%NOutSteps = SrcOutputFileTypeData%NOutSteps + DstOutputFileTypeData%numOuts = SrcOutputFileTypeData%numOuts + DstOutputFileTypeData%UnOu = SrcOutputFileTypeData%UnOu + DstOutputFileTypeData%UnSum = SrcOutputFileTypeData%UnSum + DstOutputFileTypeData%UnGra = SrcOutputFileTypeData%UnGra + DstOutputFileTypeData%FileDescLines = SrcOutputFileTypeData%FileDescLines +IF (ALLOCATED(SrcOutputFileTypeData%ChannelNames)) THEN + i1_l = LBOUND(SrcOutputFileTypeData%ChannelNames,1) + i1_u = UBOUND(SrcOutputFileTypeData%ChannelNames,1) + IF (.NOT. ALLOCATED(DstOutputFileTypeData%ChannelNames)) THEN + ALLOCATE(DstOutputFileTypeData%ChannelNames(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%ChannelNames.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstOutputFileTypeData%ChannelNames = SrcOutputFileTypeData%ChannelNames +ENDIF +IF (ALLOCATED(SrcOutputFileTypeData%ChannelUnits)) THEN + i1_l = LBOUND(SrcOutputFileTypeData%ChannelUnits,1) + i1_u = UBOUND(SrcOutputFileTypeData%ChannelUnits,1) + IF (.NOT. ALLOCATED(DstOutputFileTypeData%ChannelUnits)) THEN + ALLOCATE(DstOutputFileTypeData%ChannelUnits(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%ChannelUnits.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstOutputFileTypeData%ChannelUnits = SrcOutputFileTypeData%ChannelUnits +ENDIF + DO i1 = LBOUND(SrcOutputFileTypeData%Module_Ver,1), UBOUND(SrcOutputFileTypeData%Module_Ver,1) + CALL NWTC_Library_Copyprogdesc( SrcOutputFileTypeData%Module_Ver(i1), DstOutputFileTypeData%Module_Ver(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DstOutputFileTypeData%Module_Abrev = SrcOutputFileTypeData%Module_Abrev + DstOutputFileTypeData%WriteThisStep = SrcOutputFileTypeData%WriteThisStep + DstOutputFileTypeData%VTK_count = SrcOutputFileTypeData%VTK_count + DstOutputFileTypeData%VTK_LastWaveIndx = SrcOutputFileTypeData%VTK_LastWaveIndx + CALL FAST_Copylinfiletype( SrcOutputFileTypeData%Lin, DstOutputFileTypeData%Lin, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + DstOutputFileTypeData%ActualChanLen = SrcOutputFileTypeData%ActualChanLen + DstOutputFileTypeData%OutFmt_a = SrcOutputFileTypeData%OutFmt_a + CALL FAST_Copylinstatesave( SrcOutputFileTypeData%op, DstOutputFileTypeData%op, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + END SUBROUTINE FAST_CopyOutputFileType + + SUBROUTINE FAST_DestroyOutputFileType( OutputFileTypeData, ErrStat, ErrMsg ) + TYPE(FAST_OutputFileType), INTENT(INOUT) :: OutputFileTypeData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyOutputFileType' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(OutputFileTypeData%TimeData)) THEN + DEALLOCATE(OutputFileTypeData%TimeData) +ENDIF +IF (ALLOCATED(OutputFileTypeData%AllOutData)) THEN + DEALLOCATE(OutputFileTypeData%AllOutData) +ENDIF +IF (ALLOCATED(OutputFileTypeData%ChannelNames)) THEN + DEALLOCATE(OutputFileTypeData%ChannelNames) +ENDIF +IF (ALLOCATED(OutputFileTypeData%ChannelUnits)) THEN + DEALLOCATE(OutputFileTypeData%ChannelUnits) +ENDIF +DO i1 = LBOUND(OutputFileTypeData%Module_Ver,1), UBOUND(OutputFileTypeData%Module_Ver,1) + CALL NWTC_Library_Destroyprogdesc( OutputFileTypeData%Module_Ver(i1), ErrStat, ErrMsg ) +ENDDO + CALL FAST_Destroylinfiletype( OutputFileTypeData%Lin, ErrStat, ErrMsg ) + CALL FAST_Destroylinstatesave( OutputFileTypeData%op, ErrStat, ErrMsg ) + END SUBROUTINE FAST_DestroyOutputFileType + + SUBROUTINE FAST_PackOutputFileType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(FAST_OutputFileType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackOutputFileType' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! TimeData allocated yes/no + IF ( ALLOCATED(InData%TimeData) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! TimeData upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%TimeData) ! TimeData + END IF + Int_BufSz = Int_BufSz + 1 ! AllOutData allocated yes/no + IF ( ALLOCATED(InData%AllOutData) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! AllOutData upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%AllOutData) ! AllOutData + END IF + Int_BufSz = Int_BufSz + 1 ! n_Out + Int_BufSz = Int_BufSz + 1 ! NOutSteps + Int_BufSz = Int_BufSz + SIZE(InData%numOuts) ! numOuts + Int_BufSz = Int_BufSz + 1 ! UnOu + Int_BufSz = Int_BufSz + 1 ! UnSum + Int_BufSz = Int_BufSz + 1 ! UnGra + Int_BufSz = Int_BufSz + SIZE(InData%FileDescLines)*LEN(InData%FileDescLines) ! FileDescLines + Int_BufSz = Int_BufSz + 1 ! ChannelNames allocated yes/no + IF ( ALLOCATED(InData%ChannelNames) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! ChannelNames upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%ChannelNames)*LEN(InData%ChannelNames) ! ChannelNames + END IF + Int_BufSz = Int_BufSz + 1 ! ChannelUnits allocated yes/no + IF ( ALLOCATED(InData%ChannelUnits) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! ChannelUnits upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%ChannelUnits)*LEN(InData%ChannelUnits) ! ChannelUnits + END IF + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + DO i1 = LBOUND(InData%Module_Ver,1), UBOUND(InData%Module_Ver,1) + Int_BufSz = Int_BufSz + 3 ! Module_Ver: size of buffers for each call to pack subtype + CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Module_Ver(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Module_Ver + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Module_Ver + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Module_Ver + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Module_Ver + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + Int_BufSz = Int_BufSz + SIZE(InData%Module_Abrev)*LEN(InData%Module_Abrev) ! Module_Abrev + Int_BufSz = Int_BufSz + 1 ! WriteThisStep + Int_BufSz = Int_BufSz + 1 ! VTK_count + Int_BufSz = Int_BufSz + 1 ! VTK_LastWaveIndx + Int_BufSz = Int_BufSz + 3 ! Lin: size of buffers for each call to pack subtype + CALL FAST_Packlinfiletype( Re_Buf, Db_Buf, Int_Buf, InData%Lin, ErrStat2, ErrMsg2, .TRUE. ) ! Lin + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Lin + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Lin + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Lin + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! ActualChanLen + Int_BufSz = Int_BufSz + 1*LEN(InData%OutFmt_a) ! OutFmt_a + Int_BufSz = Int_BufSz + 3 ! op: size of buffers for each call to pack subtype + CALL FAST_Packlinstatesave( Re_Buf, Db_Buf, Int_Buf, InData%op, ErrStat2, ErrMsg2, .TRUE. ) ! op + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! op + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! op + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! op + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -14929,6 +15497,8 @@ SUBROUTINE FAST_PackOutputFileType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_Xferred = Int_Xferred + 1 END DO ! I END DO + IntKiBuf(Int_Xferred) = TRANSFER(InData%WriteThisStep, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = InData%VTK_count Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = InData%VTK_LastWaveIndx @@ -14961,6 +15531,12 @@ SUBROUTINE FAST_PackOutputFileType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF + IntKiBuf(Int_Xferred) = InData%ActualChanLen + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%OutFmt_a) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt_a(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I CALL FAST_Packlinstatesave( Re_Buf, Db_Buf, Int_Buf, InData%op, ErrStat2, ErrMsg2, OnlySize ) ! op CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -15176,6 +15752,8 @@ SUBROUTINE FAST_UnPackOutputFileType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Int_Xferred = Int_Xferred + 1 END DO ! I END DO + OutData%WriteThisStep = TRANSFER(IntKiBuf(Int_Xferred), OutData%WriteThisStep) + Int_Xferred = Int_Xferred + 1 OutData%VTK_count = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 OutData%VTK_LastWaveIndx = IntKiBuf(Int_Xferred) @@ -15220,6 +15798,12 @@ SUBROUTINE FAST_UnPackOutputFileType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + OutData%ActualChanLen = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%OutFmt_a) + OutData%OutFmt_a(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -16979,6 +17563,42 @@ SUBROUTINE FAST_CopyBeamDyn_Data( SrcBeamDyn_DataData, DstBeamDyn_DataData, Ctrl IF (ErrStat>=AbortErrLev) RETURN ENDDO ENDIF +IF (ALLOCATED(SrcBeamDyn_DataData%Output)) THEN + i1_l = LBOUND(SrcBeamDyn_DataData%Output,1) + i1_u = UBOUND(SrcBeamDyn_DataData%Output,1) + i2_l = LBOUND(SrcBeamDyn_DataData%Output,2) + i2_u = UBOUND(SrcBeamDyn_DataData%Output,2) + IF (.NOT. ALLOCATED(DstBeamDyn_DataData%Output)) THEN + ALLOCATE(DstBeamDyn_DataData%Output(i1_l:i1_u,i2_l:i2_u),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 = LBOUND(SrcBeamDyn_DataData%Output,2), UBOUND(SrcBeamDyn_DataData%Output,2) + DO i1 = LBOUND(SrcBeamDyn_DataData%Output,1), UBOUND(SrcBeamDyn_DataData%Output,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 + ENDDO + ENDDO +ENDIF +IF (ALLOCATED(SrcBeamDyn_DataData%y_interp)) THEN + i1_l = LBOUND(SrcBeamDyn_DataData%y_interp,1) + i1_u = UBOUND(SrcBeamDyn_DataData%y_interp,1) + IF (.NOT. ALLOCATED(DstBeamDyn_DataData%y_interp)) THEN + ALLOCATE(DstBeamDyn_DataData%y_interp(i1_l:i1_u),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 = LBOUND(SrcBeamDyn_DataData%y_interp,1), UBOUND(SrcBeamDyn_DataData%y_interp,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 + ENDDO +ENDIF IF (ALLOCATED(SrcBeamDyn_DataData%Input)) THEN i1_l = LBOUND(SrcBeamDyn_DataData%Input,1) i1_u = UBOUND(SrcBeamDyn_DataData%Input,1) @@ -17080,6 +17700,20 @@ SUBROUTINE FAST_DestroyBeamDyn_Data( BeamDyn_DataData, ErrStat, ErrMsg ) ENDDO DEALLOCATE(BeamDyn_DataData%m) ENDIF +IF (ALLOCATED(BeamDyn_DataData%Output)) THEN +DO i2 = LBOUND(BeamDyn_DataData%Output,2), UBOUND(BeamDyn_DataData%Output,2) +DO i1 = LBOUND(BeamDyn_DataData%Output,1), UBOUND(BeamDyn_DataData%Output,1) + CALL BD_DestroyOutput( BeamDyn_DataData%Output(i1,i2), ErrStat, ErrMsg ) +ENDDO +ENDDO + DEALLOCATE(BeamDyn_DataData%Output) +ENDIF +IF (ALLOCATED(BeamDyn_DataData%y_interp)) THEN +DO i1 = LBOUND(BeamDyn_DataData%y_interp,1), UBOUND(BeamDyn_DataData%y_interp,1) + CALL BD_DestroyOutput( BeamDyn_DataData%y_interp(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(BeamDyn_DataData%y_interp) +ENDIF IF (ALLOCATED(BeamDyn_DataData%Input)) THEN DO i2 = LBOUND(BeamDyn_DataData%Input,2), UBOUND(BeamDyn_DataData%Input,2) DO i1 = LBOUND(BeamDyn_DataData%Input,1), UBOUND(BeamDyn_DataData%Input,1) @@ -17321,6 +17955,54 @@ SUBROUTINE FAST_PackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E END IF END DO END IF + Int_BufSz = Int_BufSz + 1 ! Output allocated yes/no + IF ( ALLOCATED(InData%Output) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Output upper/lower bounds for each dimension + DO i2 = LBOUND(InData%Output,2), UBOUND(InData%Output,2) + DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) + Int_BufSz = Int_BufSz + 3 ! Output: size of buffers for each call to pack subtype + CALL BD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! Output + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Output + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Output + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Output + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! y_interp allocated yes/no + IF ( ALLOCATED(InData%y_interp) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! y_interp upper/lower bounds for each dimension + DO i1 = LBOUND(InData%y_interp,1), UBOUND(InData%y_interp,1) + Int_BufSz = Int_BufSz + 3 ! y_interp: size of buffers for each call to pack subtype + CALL BD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp(i1), ErrStat2, ErrMsg2, .TRUE. ) ! y_interp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! y_interp + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! y_interp + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! y_interp + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no IF ( ALLOCATED(InData%Input) ) THEN Int_BufSz = Int_BufSz + 2*2 ! Input upper/lower bounds for each dimension @@ -17726,6 +18408,93 @@ SUBROUTINE FAST_PackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ENDIF END DO END IF + IF ( .NOT. ALLOCATED(InData%Output) ) 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%Output,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Output,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Output,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Output,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%Output,2), UBOUND(InData%Output,2) + DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) + CALL BD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! Output + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%y_interp) ) 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%y_interp,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y_interp,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%y_interp,1), UBOUND(InData%y_interp,1) + CALL BD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp(i1), ErrStat2, ErrMsg2, OnlySize ) ! y_interp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF IF ( .NOT. ALLOCATED(InData%Input) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -17873,7 +18642,247 @@ SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL BD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1,i2), ErrStat2, ErrMsg2 ) ! x + CALL BD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1,i2), ErrStat2, ErrMsg2 ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd 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%xd)) DEALLOCATE(OutData%xd) + ALLOCATE(OutData%xd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%xd,2), UBOUND(OutData%xd,2) + DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL BD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1,i2), ErrStat2, ErrMsg2 ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z 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%z)) DEALLOCATE(OutData%z) + ALLOCATE(OutData%z(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%z,2), UBOUND(OutData%z,2) + DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL BD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1,i2), ErrStat2, ErrMsg2 ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OtherSt 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%OtherSt)) DEALLOCATE(OutData%OtherSt) + ALLOCATE(OutData%OtherSt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%OtherSt,2), UBOUND(OutData%OtherSt,2) + DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL BD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1,i2), ErrStat2, ErrMsg2 ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! p 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%p)) DEALLOCATE(OutData%p) + ALLOCATE(OutData%p(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%p.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%p,1), UBOUND(OutData%p,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL BD_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p(i1), ErrStat2, ErrMsg2 ) ! p CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -17881,26 +18890,21 @@ SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%xd)) DEALLOCATE(OutData%xd) - ALLOCATE(OutData%xd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%u)) DEALLOCATE(OutData%u) + ALLOCATE(OutData%u(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i2 = LBOUND(OutData%xd,2), UBOUND(OutData%xd,2) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,1) + DO i1 = LBOUND(OutData%u,1), UBOUND(OutData%u,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -17934,7 +18938,7 @@ SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL BD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1,i2), ErrStat2, ErrMsg2 ) ! xd + CALL BD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u(i1), ErrStat2, ErrMsg2 ) ! u CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -17942,26 +18946,21 @@ SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y 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%z)) DEALLOCATE(OutData%z) - ALLOCATE(OutData%z(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%y)) DEALLOCATE(OutData%y) + ALLOCATE(OutData%y(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i2 = LBOUND(OutData%z,2), UBOUND(OutData%z,2) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) + DO i1 = LBOUND(OutData%y,1), UBOUND(OutData%y,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -17995,7 +18994,7 @@ SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL BD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1,i2), ErrStat2, ErrMsg2 ) ! z + CALL BD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y(i1), ErrStat2, ErrMsg2 ) ! y CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -18003,26 +19002,21 @@ SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OtherSt not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! m not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OtherSt)) DEALLOCATE(OutData%OtherSt) - ALLOCATE(OutData%OtherSt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%m)) DEALLOCATE(OutData%m) + ALLOCATE(OutData%m(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%m.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i2 = LBOUND(OutData%OtherSt,2), UBOUND(OutData%OtherSt,2) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) + DO i1 = LBOUND(OutData%m,1), UBOUND(OutData%m,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -18056,7 +19050,7 @@ SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL BD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1,i2), ErrStat2, ErrMsg2 ) ! OtherSt + CALL BD_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m(i1), ErrStat2, ErrMsg2 ) ! m CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -18064,78 +19058,25 @@ SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! p not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Output 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%p)) DEALLOCATE(OutData%p) - ALLOCATE(OutData%p(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%p.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%p,1), UBOUND(OutData%p,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL BD_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p(i1), ErrStat2, ErrMsg2 ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%u)) DEALLOCATE(OutData%u) - ALLOCATE(OutData%u(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%Output)) DEALLOCATE(OutData%Output) + ALLOCATE(OutData%Output(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%u,1), UBOUND(OutData%u,1) + DO i2 = LBOUND(OutData%Output,2), UBOUND(OutData%Output,2) + DO i1 = LBOUND(OutData%Output,1), UBOUND(OutData%Output,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -18169,7 +19110,7 @@ SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL BD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u(i1), ErrStat2, ErrMsg2 ) ! u + CALL BD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Output(i1,i2), ErrStat2, ErrMsg2 ) ! Output CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -18177,77 +19118,22 @@ SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y 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%y)) DEALLOCATE(OutData%y) - ALLOCATE(OutData%y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%y,1), UBOUND(OutData%y,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL BD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y(i1), ErrStat2, ErrMsg2 ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! m not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y_interp 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%m)) DEALLOCATE(OutData%m) - ALLOCATE(OutData%m(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%y_interp)) DEALLOCATE(OutData%y_interp) + ALLOCATE(OutData%y_interp(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%m.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_interp.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%m,1), UBOUND(OutData%m,1) + DO i1 = LBOUND(OutData%y_interp,1), UBOUND(OutData%y_interp,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -18281,7 +19167,7 @@ SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL BD_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m(i1), ErrStat2, ErrMsg2 ) ! m + CALL BD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_interp(i1), ErrStat2, ErrMsg2 ) ! y_interp CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -18439,6 +19325,9 @@ SUBROUTINE FAST_CopyElastoDyn_Data( SrcElastoDyn_DataData, DstElastoDyn_DataData IF (ErrStat>=AbortErrLev) RETURN ENDDO ENDIF + 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 i1_l = LBOUND(SrcElastoDyn_DataData%Input,1) i1_u = UBOUND(SrcElastoDyn_DataData%Input,1) @@ -18500,6 +19389,7 @@ SUBROUTINE FAST_DestroyElastoDyn_Data( ElastoDyn_DataData, ErrStat, ErrMsg ) ENDDO DEALLOCATE(ElastoDyn_DataData%Output) ENDIF + CALL ED_DestroyOutput( ElastoDyn_DataData%y_interp, ErrStat, ErrMsg ) IF (ALLOCATED(ElastoDyn_DataData%Input)) THEN DO i1 = LBOUND(ElastoDyn_DataData%Input,1), UBOUND(ElastoDyn_DataData%Input,1) CALL ED_DestroyInput( ElastoDyn_DataData%Input(i1), ErrStat, ErrMsg ) @@ -18714,6 +19604,23 @@ SUBROUTINE FAST_PackElastoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, END IF END DO END IF + Int_BufSz = Int_BufSz + 3 ! y_interp: size of buffers for each call to pack subtype + CALL ED_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, .TRUE. ) ! y_interp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! y_interp + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! y_interp + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! y_interp + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no IF ( ALLOCATED(InData%Input) ) THEN Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension @@ -19042,6 +19949,34 @@ SUBROUTINE FAST_PackElastoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ENDIF END DO END IF + CALL ED_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, OnlySize ) ! y_interp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF IF ( .NOT. ALLOCATED(InData%Input) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -19519,6 +20454,46 @@ SUBROUTINE FAST_UnPackElastoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL ED_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_interp, ErrStat2, ErrMsg2 ) ! y_interp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -19642,6 +20617,25 @@ SUBROUTINE FAST_CopyServoDyn_Data( SrcServoDyn_DataData, DstServoDyn_DataData, C CALL SrvD_CopyMisc( SrcServoDyn_DataData%m, DstServoDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcServoDyn_DataData%Output)) THEN + i1_l = LBOUND(SrcServoDyn_DataData%Output,1) + i1_u = UBOUND(SrcServoDyn_DataData%Output,1) + IF (.NOT. ALLOCATED(DstServoDyn_DataData%Output)) THEN + ALLOCATE(DstServoDyn_DataData%Output(i1_l:i1_u),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 = LBOUND(SrcServoDyn_DataData%Output,1), UBOUND(SrcServoDyn_DataData%Output,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 + ENDDO +ENDIF + 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 i1_l = LBOUND(SrcServoDyn_DataData%Input,1) i1_u = UBOUND(SrcServoDyn_DataData%Input,1) @@ -19697,6 +20691,13 @@ SUBROUTINE FAST_DestroyServoDyn_Data( ServoDyn_DataData, ErrStat, ErrMsg ) CALL SrvD_DestroyInput( ServoDyn_DataData%u, ErrStat, ErrMsg ) CALL SrvD_DestroyOutput( ServoDyn_DataData%y, ErrStat, ErrMsg ) CALL SrvD_DestroyMisc( ServoDyn_DataData%m, ErrStat, ErrMsg ) +IF (ALLOCATED(ServoDyn_DataData%Output)) THEN +DO i1 = LBOUND(ServoDyn_DataData%Output,1), UBOUND(ServoDyn_DataData%Output,1) + CALL SrvD_DestroyOutput( ServoDyn_DataData%Output(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(ServoDyn_DataData%Output) +ENDIF + CALL SrvD_DestroyOutput( ServoDyn_DataData%y_interp, ErrStat, ErrMsg ) IF (ALLOCATED(ServoDyn_DataData%Input)) THEN DO i1 = LBOUND(ServoDyn_DataData%Input,1), UBOUND(ServoDyn_DataData%Input,1) CALL SrvD_DestroyInput( ServoDyn_DataData%Input(i1), ErrStat, ErrMsg ) @@ -19888,6 +20889,46 @@ SUBROUTINE FAST_PackServoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF + Int_BufSz = Int_BufSz + 1 ! Output allocated yes/no + IF ( ALLOCATED(InData%Output) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Output upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) + Int_BufSz = Int_BufSz + 3 ! Output: size of buffers for each call to pack subtype + CALL SrvD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Output + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Output + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Output + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Output + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 3 ! y_interp: size of buffers for each call to pack subtype + CALL SrvD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, .TRUE. ) ! y_interp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! y_interp + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! y_interp + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! y_interp + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no IF ( ALLOCATED(InData%Input) ) THEN Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension @@ -20151,6 +21192,75 @@ SUBROUTINE FAST_PackServoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%Output) ) 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%Output,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Output,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) + CALL SrvD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, OnlySize ) ! Output + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + CALL SrvD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, OnlySize ) ! y_interp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + IF(ALLOCATED(Re_Buf)) THEN IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf @@ -20296,17 +21406,226 @@ SUBROUTINE FAST_UnPackServoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL SrvD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x + CALL SrvD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + i1_l = LBOUND(OutData%xd,1) + i1_u = UBOUND(OutData%xd,1) + DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SrvD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + i1_l = LBOUND(OutData%z,1) + i1_u = UBOUND(OutData%z,1) + DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SrvD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + i1_l = LBOUND(OutData%OtherSt,1) + i1_u = UBOUND(OutData%OtherSt,1) + DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SrvD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SrvD_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SrvD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - i1_l = LBOUND(OutData%xd,1) - i1_u = UBOUND(OutData%xd,1) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -20340,17 +21659,13 @@ SUBROUTINE FAST_UnPackServoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL SrvD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd + CALL SrvD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - i1_l = LBOUND(OutData%z,1) - i1_u = UBOUND(OutData%z,1) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -20384,17 +21699,27 @@ SUBROUTINE FAST_UnPackServoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL SrvD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z + CALL SrvD_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - i1_l = LBOUND(OutData%OtherSt,1) - i1_u = UBOUND(OutData%OtherSt,1) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Output 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%Output)) DEALLOCATE(OutData%Output) + ALLOCATE(OutData%Output(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Output,1), UBOUND(OutData%Output,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -20428,7 +21753,7 @@ SUBROUTINE FAST_UnPackServoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL SrvD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt + CALL SrvD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Output(i1), ErrStat2, ErrMsg2 ) ! Output CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -20436,6 +21761,7 @@ SUBROUTINE FAST_UnPackServoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO + END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -20469,127 +21795,7 @@ SUBROUTINE FAST_UnPackServoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL SrvD_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SrvD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SrvD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SrvD_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m + CALL SrvD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_interp, ErrStat2, ErrMsg2 ) ! y_interp CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -21796,6 +23002,25 @@ SUBROUTINE FAST_CopyAeroDyn_Data( SrcAeroDyn_DataData, DstAeroDyn_DataData, Ctrl 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 + i1_l = LBOUND(SrcAeroDyn_DataData%Output,1) + i1_u = UBOUND(SrcAeroDyn_DataData%Output,1) + IF (.NOT. ALLOCATED(DstAeroDyn_DataData%Output)) THEN + ALLOCATE(DstAeroDyn_DataData%Output(i1_l:i1_u),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 = LBOUND(SrcAeroDyn_DataData%Output,1), UBOUND(SrcAeroDyn_DataData%Output,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 + ENDDO +ENDIF + 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 i1_l = LBOUND(SrcAeroDyn_DataData%Input,1) i1_u = UBOUND(SrcAeroDyn_DataData%Input,1) @@ -21851,6 +23076,13 @@ SUBROUTINE FAST_DestroyAeroDyn_Data( AeroDyn_DataData, ErrStat, ErrMsg ) CALL AD_DestroyInput( AeroDyn_DataData%u, ErrStat, ErrMsg ) CALL AD_DestroyOutput( AeroDyn_DataData%y, ErrStat, ErrMsg ) CALL AD_DestroyMisc( AeroDyn_DataData%m, ErrStat, ErrMsg ) +IF (ALLOCATED(AeroDyn_DataData%Output)) THEN +DO i1 = LBOUND(AeroDyn_DataData%Output,1), UBOUND(AeroDyn_DataData%Output,1) + CALL AD_DestroyOutput( AeroDyn_DataData%Output(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(AeroDyn_DataData%Output) +ENDIF + CALL AD_DestroyOutput( AeroDyn_DataData%y_interp, ErrStat, ErrMsg ) IF (ALLOCATED(AeroDyn_DataData%Input)) THEN DO i1 = LBOUND(AeroDyn_DataData%Input,1), UBOUND(AeroDyn_DataData%Input,1) CALL AD_DestroyInput( AeroDyn_DataData%Input(i1), ErrStat, ErrMsg ) @@ -22042,6 +23274,46 @@ SUBROUTINE FAST_PackAeroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF + Int_BufSz = Int_BufSz + 1 ! Output allocated yes/no + IF ( ALLOCATED(InData%Output) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Output upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) + Int_BufSz = Int_BufSz + 3 ! Output: size of buffers for each call to pack subtype + CALL AD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Output + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Output + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Output + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Output + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 3 ! y_interp: size of buffers for each call to pack subtype + CALL AD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, .TRUE. ) ! y_interp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! y_interp + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! y_interp + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! y_interp + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no IF ( ALLOCATED(InData%Input) ) THEN Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension @@ -22273,7 +23545,74 @@ SUBROUTINE FAST_PackAeroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL AD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y + CALL AD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL AD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%Output) ) 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%Output,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Output,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) + CALL AD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, OnlySize ) ! Output CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -22301,7 +23640,9 @@ SUBROUTINE FAST_PackAeroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL AD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m + END DO + END IF + CALL AD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, OnlySize ) ! y_interp CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -22747,6 +24088,102 @@ SUBROUTINE FAST_UnPackAeroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Output 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%Output)) DEALLOCATE(OutData%Output) + ALLOCATE(OutData%Output(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Output,1), UBOUND(OutData%Output,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL AD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Output(i1), ErrStat2, ErrMsg2 ) ! Output + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL AD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_interp, ErrStat2, ErrMsg2 ) ! y_interp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) @@ -22873,6 +24310,25 @@ SUBROUTINE FAST_CopyInflowWind_Data( SrcInflowWind_DataData, DstInflowWind_DataD 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 + i1_l = LBOUND(SrcInflowWind_DataData%Output,1) + i1_u = UBOUND(SrcInflowWind_DataData%Output,1) + IF (.NOT. ALLOCATED(DstInflowWind_DataData%Output)) THEN + ALLOCATE(DstInflowWind_DataData%Output(i1_l:i1_u),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 = LBOUND(SrcInflowWind_DataData%Output,1), UBOUND(SrcInflowWind_DataData%Output,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 + ENDDO +ENDIF + 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 i1_l = LBOUND(SrcInflowWind_DataData%Input,1) i1_u = UBOUND(SrcInflowWind_DataData%Input,1) @@ -22928,6 +24384,13 @@ SUBROUTINE FAST_DestroyInflowWind_Data( InflowWind_DataData, ErrStat, ErrMsg ) CALL InflowWind_DestroyInput( InflowWind_DataData%u, ErrStat, ErrMsg ) CALL InflowWind_DestroyOutput( InflowWind_DataData%y, ErrStat, ErrMsg ) CALL InflowWind_DestroyMisc( InflowWind_DataData%m, ErrStat, ErrMsg ) +IF (ALLOCATED(InflowWind_DataData%Output)) THEN +DO i1 = LBOUND(InflowWind_DataData%Output,1), UBOUND(InflowWind_DataData%Output,1) + CALL InflowWind_DestroyOutput( InflowWind_DataData%Output(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(InflowWind_DataData%Output) +ENDIF + CALL InflowWind_DestroyOutput( InflowWind_DataData%y_interp, ErrStat, ErrMsg ) IF (ALLOCATED(InflowWind_DataData%Input)) THEN DO i1 = LBOUND(InflowWind_DataData%Input,1), UBOUND(InflowWind_DataData%Input,1) CALL InflowWind_DestroyInput( InflowWind_DataData%Input(i1), ErrStat, ErrMsg ) @@ -23119,6 +24582,46 @@ SUBROUTINE FAST_PackInflowWind_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF + Int_BufSz = Int_BufSz + 1 ! Output allocated yes/no + IF ( ALLOCATED(InData%Output) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Output upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) + Int_BufSz = Int_BufSz + 3 ! Output: size of buffers for each call to pack subtype + CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Output + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Output + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Output + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Output + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 3 ! y_interp: size of buffers for each call to pack subtype + CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, .TRUE. ) ! y_interp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! y_interp + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! y_interp + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! y_interp + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no IF ( ALLOCATED(InData%Input) ) THEN Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension @@ -23382,6 +24885,75 @@ SUBROUTINE FAST_PackInflowWind_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%Output) ) 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%Output,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Output,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) + CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, OnlySize ) ! Output + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, OnlySize ) ! y_interp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + IF(ALLOCATED(Re_Buf)) THEN IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf @@ -23615,7 +25187,51 @@ SUBROUTINE FAST_UnPackInflowWind_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL InflowWind_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z + CALL InflowWind_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + i1_l = LBOUND(OutData%OtherSt,1) + i1_u = UBOUND(OutData%OtherSt,1) + DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL InflowWind_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -23623,9 +25239,6 @@ SUBROUTINE FAST_UnPackInflowWind_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO - i1_l = LBOUND(OutData%OtherSt,1) - i1_u = UBOUND(OutData%OtherSt,1) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -23659,14 +25272,13 @@ SUBROUTINE FAST_UnPackInflowWind_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL InflowWind_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt + CALL InflowWind_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -23700,7 +25312,7 @@ SUBROUTINE FAST_UnPackInflowWind_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL InflowWind_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p + CALL InflowWind_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -23740,7 +25352,7 @@ SUBROUTINE FAST_UnPackInflowWind_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL InflowWind_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u + CALL InflowWind_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -23780,13 +25392,27 @@ SUBROUTINE FAST_UnPackInflowWind_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL InflowWind_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y + CALL InflowWind_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Output 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%Output)) DEALLOCATE(OutData%Output) + ALLOCATE(OutData%Output(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Output,1), UBOUND(OutData%Output,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -23820,7 +25446,49 @@ SUBROUTINE FAST_UnPackInflowWind_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL InflowWind_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m + CALL InflowWind_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Output(i1), ErrStat2, ErrMsg2 ) ! Output + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL InflowWind_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_interp, ErrStat2, ErrMsg2 ) ! y_interp CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -26967,6 +28635,25 @@ SUBROUTINE FAST_CopyHydroDyn_Data( SrcHydroDyn_DataData, DstHydroDyn_DataData, C 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 + i1_l = LBOUND(SrcHydroDyn_DataData%Output,1) + i1_u = UBOUND(SrcHydroDyn_DataData%Output,1) + IF (.NOT. ALLOCATED(DstHydroDyn_DataData%Output)) THEN + ALLOCATE(DstHydroDyn_DataData%Output(i1_l:i1_u),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 = LBOUND(SrcHydroDyn_DataData%Output,1), UBOUND(SrcHydroDyn_DataData%Output,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 + ENDDO +ENDIF + 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 i1_l = LBOUND(SrcHydroDyn_DataData%Input,1) i1_u = UBOUND(SrcHydroDyn_DataData%Input,1) @@ -27022,6 +28709,13 @@ SUBROUTINE FAST_DestroyHydroDyn_Data( HydroDyn_DataData, ErrStat, ErrMsg ) CALL HydroDyn_DestroyInput( HydroDyn_DataData%u, ErrStat, ErrMsg ) CALL HydroDyn_DestroyOutput( HydroDyn_DataData%y, ErrStat, ErrMsg ) CALL HydroDyn_DestroyMisc( HydroDyn_DataData%m, ErrStat, ErrMsg ) +IF (ALLOCATED(HydroDyn_DataData%Output)) THEN +DO i1 = LBOUND(HydroDyn_DataData%Output,1), UBOUND(HydroDyn_DataData%Output,1) + CALL HydroDyn_DestroyOutput( HydroDyn_DataData%Output(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(HydroDyn_DataData%Output) +ENDIF + CALL HydroDyn_DestroyOutput( HydroDyn_DataData%y_interp, ErrStat, ErrMsg ) IF (ALLOCATED(HydroDyn_DataData%Input)) THEN DO i1 = LBOUND(HydroDyn_DataData%Input,1), UBOUND(HydroDyn_DataData%Input,1) CALL HydroDyn_DestroyInput( HydroDyn_DataData%Input(i1), ErrStat, ErrMsg ) @@ -27213,6 +28907,46 @@ SUBROUTINE FAST_PackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF + Int_BufSz = Int_BufSz + 1 ! Output allocated yes/no + IF ( ALLOCATED(InData%Output) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Output upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) + Int_BufSz = Int_BufSz + 3 ! Output: size of buffers for each call to pack subtype + CALL HydroDyn_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Output + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Output + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Output + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Output + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 3 ! y_interp: size of buffers for each call to pack subtype + CALL HydroDyn_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, .TRUE. ) ! y_interp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! y_interp + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! y_interp + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! y_interp + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no IF ( ALLOCATED(InData%Input) ) THEN Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension @@ -27476,6 +29210,75 @@ SUBROUTINE FAST_PackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%Output) ) 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%Output,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Output,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) + CALL HydroDyn_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, OnlySize ) ! Output + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + CALL HydroDyn_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, OnlySize ) ! y_interp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + IF(ALLOCATED(Re_Buf)) THEN IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf @@ -27918,6 +29721,102 @@ SUBROUTINE FAST_UnPackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Output 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%Output)) DEALLOCATE(OutData%Output) + ALLOCATE(OutData%Output(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Output,1), UBOUND(OutData%Output,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL HydroDyn_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Output(i1), ErrStat2, ErrMsg2 ) ! Output + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL HydroDyn_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_interp, ErrStat2, ErrMsg2 ) ! y_interp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) @@ -29119,6 +31018,25 @@ SUBROUTINE FAST_CopyMAP_Data( SrcMAP_DataData, DstMAP_DataData, CtrlCode, ErrSta 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 + i1_l = LBOUND(SrcMAP_DataData%Output,1) + i1_u = UBOUND(SrcMAP_DataData%Output,1) + IF (.NOT. ALLOCATED(DstMAP_DataData%Output)) THEN + ALLOCATE(DstMAP_DataData%Output(i1_l:i1_u),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 = LBOUND(SrcMAP_DataData%Output,1), UBOUND(SrcMAP_DataData%Output,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 + ENDDO +ENDIF + 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 i1_l = LBOUND(SrcMAP_DataData%Input,1) i1_u = UBOUND(SrcMAP_DataData%Input,1) @@ -29172,6 +31090,13 @@ SUBROUTINE FAST_DestroyMAP_Data( MAP_DataData, ErrStat, ErrMsg ) CALL MAP_DestroyInput( MAP_DataData%u, ErrStat, ErrMsg ) CALL MAP_DestroyOutput( MAP_DataData%y, ErrStat, ErrMsg ) CALL MAP_DestroyOtherState( MAP_DataData%OtherSt_old, ErrStat, ErrMsg ) +IF (ALLOCATED(MAP_DataData%Output)) THEN +DO i1 = LBOUND(MAP_DataData%Output,1), UBOUND(MAP_DataData%Output,1) + CALL MAP_DestroyOutput( MAP_DataData%Output(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(MAP_DataData%Output) +ENDIF + CALL MAP_DestroyOutput( MAP_DataData%y_interp, ErrStat, ErrMsg ) IF (ALLOCATED(MAP_DataData%Input)) THEN DO i1 = LBOUND(MAP_DataData%Input,1), UBOUND(MAP_DataData%Input,1) CALL MAP_DestroyInput( MAP_DataData%Input(i1), ErrStat, ErrMsg ) @@ -29361,6 +31286,46 @@ SUBROUTINE FAST_PackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF + Int_BufSz = Int_BufSz + 1 ! Output allocated yes/no + IF ( ALLOCATED(InData%Output) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Output upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) + Int_BufSz = Int_BufSz + 3 ! Output: size of buffers for each call to pack subtype + CALL MAP_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Output + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Output + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Output + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Output + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 3 ! y_interp: size of buffers for each call to pack subtype + CALL MAP_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, .TRUE. ) ! y_interp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! y_interp + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! y_interp + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! y_interp + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no IF ( ALLOCATED(InData%Input) ) THEN Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension @@ -29622,6 +31587,75 @@ SUBROUTINE FAST_PackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%Output) ) 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%Output,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Output,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) + CALL MAP_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, OnlySize ) ! Output + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + CALL MAP_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, OnlySize ) ! y_interp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + IF(ALLOCATED(Re_Buf)) THEN IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf @@ -29811,17 +31845,272 @@ SUBROUTINE FAST_UnPackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MAP_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd + CALL MAP_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + i1_l = LBOUND(OutData%z,1) + i1_u = UBOUND(OutData%z,1) + DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MAP_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MAP_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt, ErrStat2, ErrMsg2 ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MAP_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MAP_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MAP_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MAP_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_old, ErrStat2, ErrMsg2 ) ! OtherSt_old CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - i1_l = LBOUND(OutData%z,1) - i1_u = UBOUND(OutData%z,1) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Output 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%Output)) DEALLOCATE(OutData%Output) + ALLOCATE(OutData%Output(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Output,1), UBOUND(OutData%Output,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -29855,7 +32144,7 @@ SUBROUTINE FAST_UnPackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MAP_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z + CALL MAP_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Output(i1), ErrStat2, ErrMsg2 ) ! Output CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -29863,6 +32152,7 @@ SUBROUTINE FAST_UnPackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO + END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -29896,167 +32186,7 @@ SUBROUTINE FAST_UnPackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MAP_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt, ErrStat2, ErrMsg2 ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MAP_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MAP_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MAP_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MAP_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_old, ErrStat2, ErrMsg2 ) ! OtherSt_old + CALL MAP_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_interp, ErrStat2, ErrMsg2 ) ! y_interp CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -38556,7 +40686,9 @@ SUBROUTINE FAST_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) CALL FAST_Copyexterninputtype( SrcMiscData%ExternInput, DstMiscData%ExternInput, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - DstMiscData%NextLinTimeIndx = SrcMiscData%NextLinTimeIndx + CALL FAST_Copymisclintype( SrcMiscData%Lin, DstMiscData%Lin, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE FAST_CopyMisc SUBROUTINE FAST_DestroyMisc( MiscData, ErrStat, ErrMsg ) @@ -38569,6 +40701,7 @@ SUBROUTINE FAST_DestroyMisc( MiscData, ErrStat, ErrMsg ) ErrStat = ErrID_None ErrMsg = "" CALL FAST_Destroyexterninputtype( MiscData%ExternInput, ErrStat, ErrMsg ) + CALL FAST_Destroymisclintype( MiscData%Lin, ErrStat, ErrMsg ) END SUBROUTINE FAST_DestroyMisc SUBROUTINE FAST_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -38633,7 +40766,23 @@ SUBROUTINE FAST_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF - Int_BufSz = Int_BufSz + 1 ! NextLinTimeIndx + Int_BufSz = Int_BufSz + 3 ! Lin: size of buffers for each call to pack subtype + CALL FAST_Packmisclintype( Re_Buf, Db_Buf, Int_Buf, InData%Lin, ErrStat2, ErrMsg2, .TRUE. ) ! Lin + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Lin + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Lin + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Lin + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -38711,8 +40860,34 @@ SUBROUTINE FAST_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - IntKiBuf(Int_Xferred) = InData%NextLinTimeIndx - Int_Xferred = Int_Xferred + 1 + CALL FAST_Packmisclintype( Re_Buf, Db_Buf, Int_Buf, InData%Lin, ErrStat2, ErrMsg2, OnlySize ) ! Lin + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF END SUBROUTINE FAST_PackMisc SUBROUTINE FAST_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -38808,8 +40983,46 @@ SUBROUTINE FAST_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%NextLinTimeIndx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL FAST_Unpackmisclintype( Re_Buf, Db_Buf, Int_Buf, OutData%Lin, ErrStat2, ErrMsg2 ) ! Lin + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END SUBROUTINE FAST_UnPackMisc SUBROUTINE FAST_CopyExternInitType( SrcExternInitTypeData, DstExternInitTypeData, CtrlCode, ErrStat, ErrMsg ) From 09fcd621bb44fadf56bd5430ee50fc60564fc734 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Thu, 5 Dec 2019 12:59:01 -0700 Subject: [PATCH 16/72] Update autogenerated _Types.f90 files --- modules/openfoam/src/OpenFOAM_Types.f90 | 189 +++++++++++++----------- 1 file changed, 105 insertions(+), 84 deletions(-) diff --git a/modules/openfoam/src/OpenFOAM_Types.f90 b/modules/openfoam/src/OpenFOAM_Types.f90 index fcc23b60af..d613cd232a 100644 --- a/modules/openfoam/src/OpenFOAM_Types.f90 +++ b/modules/openfoam/src/OpenFOAM_Types.f90 @@ -3344,8 +3344,10 @@ SUBROUTINE OpFM_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xdotForce,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%xdotForce)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%xdotForce))-1 ) = PACK(InData%xdotForce,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%xdotForce) + DO i1 = LBOUND(InData%xdotForce,1), UBOUND(InData%xdotForce,1) + ReKiBuf(Re_Xferred) = InData%xdotForce(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%ydotForce) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3357,8 +3359,10 @@ SUBROUTINE OpFM_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ydotForce,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ydotForce)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%ydotForce))-1 ) = PACK(InData%ydotForce,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%ydotForce) + DO i1 = LBOUND(InData%ydotForce,1), UBOUND(InData%ydotForce,1) + ReKiBuf(Re_Xferred) = InData%ydotForce(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%zdotForce) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3370,8 +3374,10 @@ SUBROUTINE OpFM_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%zdotForce,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%zdotForce)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%zdotForce))-1 ) = PACK(InData%zdotForce,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%zdotForce) + DO i1 = LBOUND(InData%zdotForce,1), UBOUND(InData%zdotForce,1) + ReKiBuf(Re_Xferred) = InData%zdotForce(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%pOrientation) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3679,15 +3685,10 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs OutData%c_obj%xdotForce_Len = SIZE(OutData%xdotForce) IF (OutData%c_obj%xdotForce_Len > 0) & OutData%c_obj%xdotForce = C_LOC( OutData%xdotForce(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%xdotForce)>0) OutData%xdotForce = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%xdotForce))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%xdotForce) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%xdotForce,1), UBOUND(OutData%xdotForce,1) + OutData%xdotForce(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ydotForce not allocated Int_Xferred = Int_Xferred + 1 @@ -3705,15 +3706,10 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs OutData%c_obj%ydotForce_Len = SIZE(OutData%ydotForce) IF (OutData%c_obj%ydotForce_Len > 0) & OutData%c_obj%ydotForce = C_LOC( OutData%ydotForce(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%ydotForce)>0) OutData%ydotForce = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%ydotForce))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%ydotForce) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%ydotForce,1), UBOUND(OutData%ydotForce,1) + OutData%ydotForce(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! zdotForce not allocated Int_Xferred = Int_Xferred + 1 @@ -3731,15 +3727,10 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs OutData%c_obj%zdotForce_Len = SIZE(OutData%zdotForce) IF (OutData%c_obj%zdotForce_Len > 0) & OutData%c_obj%zdotForce = C_LOC( OutData%zdotForce(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%zdotForce)>0) OutData%zdotForce = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%zdotForce))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%zdotForce) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%zdotForce,1), UBOUND(OutData%zdotForce,1) + OutData%zdotForce(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! pOrientation not allocated Int_Xferred = Int_Xferred + 1 @@ -4003,24 +3994,30 @@ SUBROUTINE OpFM_C2Fary_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) END IF ! -- xdotForce Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%xdotForce ) ) THEN - NULLIFY( InputData%xdotForce ) - ELSE - CALL C_F_POINTER(InputData%C_obj%xdotForce, InputData%xdotForce, (/InputData%C_obj%xdotForce_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%xdotForce ) ) THEN + NULLIFY( InputData%xdotForce ) + ELSE + CALL C_F_POINTER(InputData%C_obj%xdotForce, InputData%xdotForce, (/InputData%C_obj%xdotForce_Len/)) + END IF END IF ! -- ydotForce Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%ydotForce ) ) THEN - NULLIFY( InputData%ydotForce ) - ELSE - CALL C_F_POINTER(InputData%C_obj%ydotForce, InputData%ydotForce, (/InputData%C_obj%ydotForce_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%ydotForce ) ) THEN + NULLIFY( InputData%ydotForce ) + ELSE + CALL C_F_POINTER(InputData%C_obj%ydotForce, InputData%ydotForce, (/InputData%C_obj%ydotForce_Len/)) + END IF END IF ! -- zdotForce Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%zdotForce ) ) THEN - NULLIFY( InputData%zdotForce ) - ELSE - CALL C_F_POINTER(InputData%C_obj%zdotForce, InputData%zdotForce, (/InputData%C_obj%zdotForce_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%zdotForce ) ) THEN + NULLIFY( InputData%zdotForce ) + ELSE + CALL C_F_POINTER(InputData%C_obj%zdotForce, InputData%zdotForce, (/InputData%C_obj%zdotForce_Len/)) + END IF END IF ! -- pOrientation Input Data fields @@ -4193,6 +4190,42 @@ SUBROUTINE OpFM_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) END IF END IF + ! -- xdotForce Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%xdotForce)) THEN + InputData%c_obj%xdotForce_Len = 0 + InputData%c_obj%xdotForce = C_NULL_PTR + 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) ) ) + END IF + END IF + + ! -- ydotForce Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%ydotForce)) THEN + InputData%c_obj%ydotForce_Len = 0 + InputData%c_obj%ydotForce = C_NULL_PTR + 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) ) ) + END IF + END IF + + ! -- zdotForce Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%zdotForce)) THEN + InputData%c_obj%zdotForce_Len = 0 + InputData%c_obj%zdotForce = C_NULL_PTR + 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) ) ) + END IF + END IF + ! -- pOrientation Input Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(InputData%pOrientation)) THEN @@ -4976,28 +5009,22 @@ SUBROUTINE OpFM_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg END DO END IF ! check if allocated IF (ASSOCIATED(u_out%xdotForce) .AND. ASSOCIATED(u1%xdotForce)) THEN - ALLOCATE(b1(SIZE(u_out%xdotForce,1))) - ALLOCATE(c1(SIZE(u_out%xdotForce,1))) - b1 = -(u1%xdotForce - u2%xdotForce)/t(2) - u_out%xdotForce = u1%xdotForce + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%xdotForce,1),UBOUND(u_out%xdotForce,1) + b = -(u1%xdotForce(i1) - u2%xdotForce(i1)) + u_out%xdotForce(i1) = u1%xdotForce(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%ydotForce) .AND. ASSOCIATED(u1%ydotForce)) THEN - ALLOCATE(b1(SIZE(u_out%ydotForce,1))) - ALLOCATE(c1(SIZE(u_out%ydotForce,1))) - b1 = -(u1%ydotForce - u2%ydotForce)/t(2) - u_out%ydotForce = u1%ydotForce + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%ydotForce,1),UBOUND(u_out%ydotForce,1) + b = -(u1%ydotForce(i1) - u2%ydotForce(i1)) + u_out%ydotForce(i1) = u1%ydotForce(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%zdotForce) .AND. ASSOCIATED(u1%zdotForce)) THEN - ALLOCATE(b1(SIZE(u_out%zdotForce,1))) - ALLOCATE(c1(SIZE(u_out%zdotForce,1))) - b1 = -(u1%zdotForce - u2%zdotForce)/t(2) - u_out%zdotForce = u1%zdotForce + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%zdotForce,1),UBOUND(u_out%zdotForce,1) + b = -(u1%zdotForce(i1) - u2%zdotForce(i1)) + u_out%zdotForce(i1) = u1%zdotForce(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%pOrientation) .AND. ASSOCIATED(u1%pOrientation)) THEN DO i1 = LBOUND(u_out%pOrientation,1),UBOUND(u_out%pOrientation,1) @@ -5153,31 +5180,25 @@ SUBROUTINE OpFM_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er END DO END IF ! check if allocated IF (ASSOCIATED(u_out%xdotForce) .AND. ASSOCIATED(u1%xdotForce)) THEN - ALLOCATE(b1(SIZE(u_out%xdotForce,1))) - ALLOCATE(c1(SIZE(u_out%xdotForce,1))) - b1 = (t(3)**2*(u1%xdotForce - u2%xdotForce) + t(2)**2*(-u1%xdotForce + u3%xdotForce))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%xdotForce + t(3)*u2%xdotForce - t(2)*u3%xdotForce ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%xdotForce = u1%xdotForce + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%xdotForce,1),UBOUND(u_out%xdotForce,1) + b = (t(3)**2*(u1%xdotForce(i1) - u2%xdotForce(i1)) + t(2)**2*(-u1%xdotForce(i1) + u3%xdotForce(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%xdotForce(i1) + t(3)*u2%xdotForce(i1) - t(2)*u3%xdotForce(i1) ) * scaleFactor + u_out%xdotForce(i1) = u1%xdotForce(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%ydotForce) .AND. ASSOCIATED(u1%ydotForce)) THEN - ALLOCATE(b1(SIZE(u_out%ydotForce,1))) - ALLOCATE(c1(SIZE(u_out%ydotForce,1))) - b1 = (t(3)**2*(u1%ydotForce - u2%ydotForce) + t(2)**2*(-u1%ydotForce + u3%ydotForce))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%ydotForce + t(3)*u2%ydotForce - t(2)*u3%ydotForce ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%ydotForce = u1%ydotForce + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%ydotForce,1),UBOUND(u_out%ydotForce,1) + b = (t(3)**2*(u1%ydotForce(i1) - u2%ydotForce(i1)) + t(2)**2*(-u1%ydotForce(i1) + u3%ydotForce(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%ydotForce(i1) + t(3)*u2%ydotForce(i1) - t(2)*u3%ydotForce(i1) ) * scaleFactor + u_out%ydotForce(i1) = u1%ydotForce(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%zdotForce) .AND. ASSOCIATED(u1%zdotForce)) THEN - ALLOCATE(b1(SIZE(u_out%zdotForce,1))) - ALLOCATE(c1(SIZE(u_out%zdotForce,1))) - b1 = (t(3)**2*(u1%zdotForce - u2%zdotForce) + t(2)**2*(-u1%zdotForce + u3%zdotForce))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%zdotForce + t(3)*u2%zdotForce - t(2)*u3%zdotForce ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%zdotForce = u1%zdotForce + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%zdotForce,1),UBOUND(u_out%zdotForce,1) + b = (t(3)**2*(u1%zdotForce(i1) - u2%zdotForce(i1)) + t(2)**2*(-u1%zdotForce(i1) + u3%zdotForce(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%zdotForce(i1) + t(3)*u2%zdotForce(i1) - t(2)*u3%zdotForce(i1) ) * scaleFactor + u_out%zdotForce(i1) = u1%zdotForce(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%pOrientation) .AND. ASSOCIATED(u1%pOrientation)) THEN DO i1 = LBOUND(u_out%pOrientation,1),UBOUND(u_out%pOrientation,1) From d67d3089ee30dbfb2202a9d3a2e5080fbc9eeadf Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Thu, 5 Dec 2019 13:58:57 -0700 Subject: [PATCH 17/72] BD docs [bug fix]: Update example input files Someone should document these, too. --- .../user/beamdyn/examples/bd_driver_dynamic_nrel_5mw.inp | 9 +++++---- .../user/beamdyn/examples/bd_driver_static_nrel_5mw.inp | 9 +++++---- 2 files changed, 10 insertions(+), 8 deletions(-) diff --git a/docs/source/user/beamdyn/examples/bd_driver_dynamic_nrel_5mw.inp b/docs/source/user/beamdyn/examples/bd_driver_dynamic_nrel_5mw.inp index df2cca9641..2e36b3eb7c 100644 --- a/docs/source/user/beamdyn/examples/bd_driver_dynamic_nrel_5mw.inp +++ b/docs/source/user/beamdyn/examples/bd_driver_dynamic_nrel_5mw.inp @@ -14,14 +14,15 @@ True DynamicSolve - Dynamic solve (false for static solve) (-) 0 GlbPos(2) - Component of position vector of the reference blade frame along Y direction (m) 1 GlbPos(3) - Component of position vector of the reference blade frame along Z direction (m) ---The following 3 by 3 matrix is the direction cosine matirx ,GlbDCM(3,3), ----relates global frame to reference blade frame +---relates global frame to the initial blade root frame 1.0000000E+00 0.0000000E+00 0.0000000E+00 0.0000000E+00 1.0000000E+00 0.0000000E+00 0.0000000E+00 0.0000000E+00 1.0000000E+00 +True GlbRotBladeT0 - Reference orientation for BeamDyn calculations is aligned with initial blade root? ---------------------- ROOT VELOCITY PARAMETER ---------------------------------- - 1.0006 RootVel(4) - Component of angular velocity vector of the beam root about X axis (rad/s) - 0 RootVel(5) - Component of angular velocity vector of the beam root about Y axis (rad/s) - 0 RootVel(6) - Component of angular velocity vector of the beam root about Z axis (rad/s) + 1.0006 RootVel(4) - Component of angular velocity vector of the beam root about X axis (rad/s) + 0 RootVel(5) - Component of angular velocity vector of the beam root about Y axis (rad/s) + 0 RootVel(6) - Component of angular velocity vector of the beam root about Z axis (rad/s) ---------------------- APPLIED FORCE ---------------------------------- 0 DistrLoad(1) - Component of distributed force vector along X direction (N/m) 0 DistrLoad(2) - Component of distributed force vector along Y direction (N/m) diff --git a/docs/source/user/beamdyn/examples/bd_driver_static_nrel_5mw.inp b/docs/source/user/beamdyn/examples/bd_driver_static_nrel_5mw.inp index 080cc927dc..6d1cb4f53c 100644 --- a/docs/source/user/beamdyn/examples/bd_driver_static_nrel_5mw.inp +++ b/docs/source/user/beamdyn/examples/bd_driver_static_nrel_5mw.inp @@ -14,14 +14,15 @@ False DynamicSolve - Dynamic solve (false for static solve) (-) 0 GlbPos(2) - Component of position vector of the reference blade frame along Y direction (m) 1 GlbPos(3) - Component of position vector of the reference blade frame along Z direction (m) ---The following 3 by 3 matrix is the direction cosine matirx ,GlbDCM(3,3), ----relates global frame to reference blade frame +---relates global frame to the initial blade root frame 1.0000000E+00 0.0000000E+00 0.0000000E+00 0.0000000E+00 1.0000000E+00 0.0000000E+00 0.0000000E+00 0.0000000E+00 1.0000000E+00 +True GlbRotBladeT0 - Reference orientation for BeamDyn calculations is aligned with initial blade root? ---------------------- ROOT VELOCITY PARAMETER ---------------------------------- - 0 RootVel(4) - Component of angular velocity vector of the beam root about X axis (rad/s) - 0 RootVel(5) - Component of angular velocity vector of the beam root about Y axis (rad/s) - 0 RootVel(6) - Component of angular velocity vector of the beam root about Z axis (rad/s) + 0 RootVel(4) - Component of angular velocity vector of the beam root about X axis (rad/s) + 0 RootVel(5) - Component of angular velocity vector of the beam root about Y axis (rad/s) + 0 RootVel(6) - Component of angular velocity vector of the beam root about Z axis (rad/s) ---------------------- APPLIED FORCE ---------------------------------- 10000 DistrLoad(1) - Component of distributed force vector along X direction (N/m) 0 DistrLoad(2) - Component of distributed force vector along Y direction (N/m) From 986e9bb1dca89a4180612ceeed6a20e1be2d3284 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Tue, 10 Dec 2019 12:03:21 -0700 Subject: [PATCH 18/72] NWTC_Lib: add code to write binary files with more than 10-char headers This is not used in OpenFAST, yet. --- modules/nwtc-library/src/NWTC_IO.f90 | 57 ++++++++++++++++++++-------- 1 file changed, 41 insertions(+), 16 deletions(-) diff --git a/modules/nwtc-library/src/NWTC_IO.f90 b/modules/nwtc-library/src/NWTC_IO.f90 index 9b6271e991..ab726213d5 100644 --- a/modules/nwtc-library/src/NWTC_IO.f90 +++ b/modules/nwtc-library/src/NWTC_IO.f90 @@ -52,7 +52,8 @@ MODULE NWTC_IO INTEGER(B2Ki), PARAMETER :: FileFmtID_WithTime = 1 !< ID for FAST Output File Format, specifies that the time channel is included in the output file (use if the output can occur at variable times) INTEGER(B2Ki), PARAMETER :: FileFmtID_WithoutTime = 2 !< ID for FAST Output File Format, specifies that the time channel is not included in the output file (used only with constant time-step output) - INTEGER(B2Ki), PARAMETER :: FileFmtID_NoCompressWithoutTime = 3 !< ID for FAST Output File Format, specifies that the time channel is not included in the output file (used only with constant time-step output), and data is not compressed, but written as double precision floats + INTEGER(B2Ki), PARAMETER :: FileFmtID_NoCompressWithoutTime = 3 !< ID for FAST Output File Format, specifies that the time channel is not included in the output file (used only with constant time-step output), and data is not compressed, but written as double-precision floats + INTEGER(B2Ki), PARAMETER :: FileFmtID_ChanLen_In = 4 !< ID for FAST Output File Format, specifies that the time channel is not included in the output file, and channel length is included in the file LOGICAL :: Beep = .TRUE. !< Flag that specifies whether or not to beep for error messages and program terminations. @@ -4984,14 +4985,14 @@ SUBROUTINE ReadFASTbin ( UnIn, Init, FASTdata, ErrStat, ErrMsg ) ! Argument declarations. - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< An optional error level to be returned to the calling routine. - INTEGER(IntKi), INTENT(INOUT) :: UnIn !< The IO unit for the FAST binary file. + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< An optional error level to be returned to the calling routine. + INTEGER(IntKi), INTENT(INOUT) :: UnIn !< The IO unit for the FAST binary file. - LOGICAL, INTENT(IN) :: Init !< A flag to tell the routine to read only the file header for initialization purposes. + LOGICAL, INTENT(IN) :: Init !< A flag to tell the routine to read only the file header for initialization purposes. - CHARACTER(*), INTENT( OUT) :: ErrMsg !< An optional error message to be returned to the calling routine. + CHARACTER(*), INTENT( OUT) :: ErrMsg !< An optional error message to be returned to the calling routine. - TYPE (FASTdataType), INTENT(INOUT) :: FASTdata !< The derived type for holding FAST output data. + TYPE (FASTdataType), INTENT(INOUT) :: FASTdata !< The derived type for holding FAST output data. ! Local declarations. @@ -5012,17 +5013,18 @@ SUBROUTINE ReadFASTbin ( UnIn, Init, FASTdata, ErrStat, ErrMsg ) INTEGER(IntKi) :: IRow ! The row index used for DO loops. INTEGER(IntKi) :: LenDesc ! The length of the description string, DescStr. INTEGER(IntKi), PARAMETER :: MaxLenDesc = 1024 ! The maximum allowed length of the description string, DescStr. - INTEGER(IntKi), PARAMETER :: MaxChrLen = 10 ! The maximum length for channel names and units. - + INTEGER(IntKi) :: ChanLen2 ! The lengths of channel names in the file + INTEGER(B4Ki), ALLOCATABLE :: TmpTimeArray(:) ! This array holds the normalized time channel that was read from the binary file. INTEGER(B4Ki) :: Tmp4BInt ! This scalar temporarially holds a 4-byte integer that was stored in the binary file INTEGER(B2Ki) :: FileType ! The type of FAST data file (1: Time channel included in file; 2: Time stored as start time and step). + INTEGER(B2Ki) :: Tmp2BInt ! This scalar temporarially holds a 2-byte integer that was stored in the binary file. INTEGER(B2Ki), ALLOCATABLE :: TmpInArray(:,:) ! This array holds the normalized channels that were read from the binary file. INTEGER(R8Ki), ALLOCATABLE :: TmpR8InArray(:,:) ! This array holds the uncompressed channels that were read from the binary file. INTEGER(B1Ki), ALLOCATABLE :: DescStrASCII(:) ! The ASCII equivalent of DescStr. - INTEGER(B1Ki) :: TmpStrASCII(MaxChrLen) ! The temporary ASCII equivalent of a channel name or units. + INTEGER(B1Ki), ALLOCATABLE :: TmpStrASCII(:) ! The temporary ASCII equivalent of a channel name or units. INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -5060,6 +5062,19 @@ SUBROUTINE ReadFASTbin ( UnIn, Init, FASTdata, ErrStat, ErrMsg ) RETURN ENDIF + + IF (FileType == FileFmtID_ChanLen_In) THEN + READ (UnIn, IOSTAT=ErrStat2) Tmp2BInt + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat ( ErrID_Fatal, 'Fatal error reading ChanLen from file "'//TRIM( FASTdata%File )//'".', ErrStat, ErrMsg, RoutineName ) + CALL Cleanup() + RETURN + ENDIF + ChanLen2 = Tmp2BInt + ELSE + ChanLen2 = 10 + END IF + READ (UnIn, IOSTAT=ErrStat2) Tmp4BInt IF ( ErrStat2 /= 0 ) THEN CALL SetErrStat ( ErrID_Fatal, 'Fatal error reading the number of channels from file "' & @@ -5253,6 +5268,13 @@ SUBROUTINE ReadFASTbin ( UnIn, Init, FASTdata, ErrStat, ErrMsg ) FASTdata%Descr(IChr:IChr) = CHAR( DescStrASCII(IChr) ) END DO + + ALLOCATE ( TmpStrASCII( ChanLen2 ) , STAT=ErrStat2 ) + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat ( ErrID_Fatal, 'Fatal error allocating memory for the DescStrASCII array.', ErrStat, ErrMsg, RoutineName ) + CALL Cleanup() + RETURN + ENDIF TmpStrASCII(:) = ICHAR( ' ' ) DO IChan=1,FASTdata%NumChans+1 READ (UnIn, IOSTAT=ErrStat2) TmpStrASCII @@ -5263,7 +5285,7 @@ SUBROUTINE ReadFASTbin ( UnIn, Init, FASTdata, ErrStat, ErrMsg ) RETURN ENDIF FASTdata%ChanNames(IChan) = '' - DO IChr=1,MaxChrLen + DO IChr=1,ChanLen2 FASTdata%ChanNames(IChan)(IChr:IChr) = CHAR( TmpStrASCII(IChr) ) END DO END DO @@ -5278,7 +5300,7 @@ SUBROUTINE ReadFASTbin ( UnIn, Init, FASTdata, ErrStat, ErrMsg ) RETURN ENDIF FASTdata%ChanUnits(IChan) = '' - DO IChr=1,MaxChrLen + DO IChr=1,ChanLen2 FASTdata%ChanUnits(IChan)(IChr:IChr) = CHAR( TmpStrASCII(IChr) ) END DO END DO @@ -5335,15 +5357,17 @@ SUBROUTINE ReadFASTbin ( UnIn, Init, FASTdata, ErrStat, ErrMsg ) END DO ! IRow=1,FASTdata%NumRecs - DO IRow=1,FASTdata%NumRecs - IF ( FileType == FileFmtID_NoCompressWithoutTime ) THEN + IF ( FileType == FileFmtID_NoCompressWithoutTime ) THEN + DO IRow=1,FASTdata%NumRecs FASTdata%Data(IRow,2:) = REAL(TmpInArray(IRow,:), ReKi) - ELSE + END DO ! IRow=1,FASTdata%NumRecs + ELSE + DO IRow=1,FASTdata%NumRecs ! Denormalize the data one row at a time and store it in the FASTdata%Data array. FASTdata%Data(IRow,2:) = ( TmpInArray(IRow,:) - ColOff(:) )/ColScl(:) - END IF + END DO ! IRow=1,FASTdata%NumRecs + END IF - END DO ! IRow=1,FASTdata%NumRecs CALL Cleanup( ) @@ -5364,6 +5388,7 @@ SUBROUTINE Cleanup ( ) IF ( ALLOCATED( ColOff ) ) DEALLOCATE( ColOff ) IF ( ALLOCATED( ColScl ) ) DEALLOCATE( ColScl ) IF ( ALLOCATED( DescStrASCII ) ) DEALLOCATE( DescStrASCII ) + IF ( ALLOCATED( TmpStrASCII ) ) DEALLOCATE( TmpStrASCII ) IF ( ALLOCATED( TmpInArray ) ) DEALLOCATE( TmpInArray ) IF ( ALLOCATED( TmpR8InArray ) ) DEALLOCATE( TmpR8InArray ) IF ( ALLOCATED( TmpTimeArray ) ) DEALLOCATE( TmpTimeArray ) From 12f3ef2bd18631c75fdd8fb9858de9618d550fb6 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Tue, 10 Dec 2019 13:11:50 -0700 Subject: [PATCH 19/72] remove unused variables --- modules/beamdyn/src/BeamDyn_BldNdOuts_IO.f90 | 3 --- modules/elastodyn/src/ElastoDyn.f90 | 2 +- modules/moordyn/src/MoorDyn_IO.f90 | 2 +- modules/openfast-library/src/FAST_Solver.f90 | 11 +++-------- modules/openfast-library/src/FAST_Subs.f90 | 2 +- 5 files changed, 6 insertions(+), 14 deletions(-) diff --git a/modules/beamdyn/src/BeamDyn_BldNdOuts_IO.f90 b/modules/beamdyn/src/BeamDyn_BldNdOuts_IO.f90 index 569deb518c..94dd3d0bca 100644 --- a/modules/beamdyn/src/BeamDyn_BldNdOuts_IO.f90 +++ b/modules/beamdyn/src/BeamDyn_BldNdOuts_IO.f90 @@ -292,11 +292,8 @@ SUBROUTINE Calc_WriteBldNdOutput( p, m, y, ErrStat, ErrMsg ) INTEGER(IntKi) :: nelem ! current element INTEGER(IntKi) :: idx_node ! Counter to the blade node we are on INTEGER(IntKi) :: compIndx ! index for array component (x,y,z) - REAL(BDKi) :: BladeLocalOrient(3,3) ! Local blade orientation matrix REAL(BDKi) :: Tmp33a(3,3) ! Temporary 3x4 for orientation calcs REAL(BDKi) :: Tmp33b(3,3) ! Temporary 3x4 for orientation calcs - REAL(BDKi) :: ThetaYXZabs(3) ! Tait-Bryan absolute values for Cant, Toe, Twist angles - REAL(BDKi) :: ThetaYXZrd(3) ! Tait-Bryan reltative change in Cant, Toe, Twist angles REAL(BDKi) :: WM_ParamRD(3) ! Wiener Milenkovic parameters for current node, in Global coordinates REAL(BDKi) :: temp_vec(3) ! temporary vector for orientation info. diff --git a/modules/elastodyn/src/ElastoDyn.f90 b/modules/elastodyn/src/ElastoDyn.f90 index eaebe4e176..30bb724ebd 100644 --- a/modules/elastodyn/src/ElastoDyn.f90 +++ b/modules/elastodyn/src/ElastoDyn.f90 @@ -95,7 +95,7 @@ SUBROUTINE ED_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut TYPE(ED_InputFile) :: InputFileData ! Data stored in the module's input file INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation - INTEGER(IntKi) :: i, K ! loop counters + INTEGER(IntKi) :: i ! loop counters LOGICAL, PARAMETER :: GetAdamsVals = .FALSE. ! Determines if we should read Adams values and create (update) an Adams model CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None diff --git a/modules/moordyn/src/MoorDyn_IO.f90 b/modules/moordyn/src/MoorDyn_IO.f90 index 800413804a..b2776b6876 100644 --- a/modules/moordyn/src/MoorDyn_IO.f90 +++ b/modules/moordyn/src/MoorDyn_IO.f90 @@ -908,7 +908,7 @@ SUBROUTINE MDIO_OpenOutput( OutRootName, p, m, InitOut, ErrStat, ErrMsg ) INTEGER :: I ! Generic loop counter INTEGER :: J ! Generic loop counter CHARACTER(1024) :: OutFileName ! The name of the output file including the full path. - INTEGER :: L ! counter for index in LineWrOutput +! INTEGER :: L ! counter for index in LineWrOutput INTEGER :: LineNumOuts ! number of entries in LineWrOutput for each line CHARACTER(200) :: Frmt ! a string to hold a format statement INTEGER :: ErrStat2 diff --git a/modules/openfast-library/src/FAST_Solver.f90 b/modules/openfast-library/src/FAST_Solver.f90 index 46249f2d64..d01651baed 100644 --- a/modules/openfast-library/src/FAST_Solver.f90 +++ b/modules/openfast-library/src/FAST_Solver.f90 @@ -1445,7 +1445,6 @@ SUBROUTINE ED_HD_InputOutputSolve( this_time, p_FAST, calcJacobian & #ifdef OUTPUT_JACOBIAN INTEGER :: UnJac #endif - 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... @@ -1505,8 +1504,8 @@ SUBROUTINE ED_HD_InputOutputSolve( this_time, p_FAST, calcJacobian & ! Calculate outputs at this_time, based on inputs at this_time !------------------------------------------------------------------------------------------------- - CALL ED_CalcOutput( this_time, u_ED, p_ED, x_ED, xd_ED, z_ED, OtherSt_ED, y_ED, m_ED, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CalcOutput( this_time, u_ED, p_ED, x_ED, xd_ED, z_ED, OtherSt_ED, y_ED, m_ED, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL HydroDyn_CalcOutput( this_time, u_HD, p_HD, x_HD, xd_HD, z_HD, OtherSt_HD, y_HD, m_HD, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -4803,7 +4802,6 @@ SUBROUTINE SolveOption2a_Inp2BD(this_time, this_state, p_FAST, m_FAST, ED, BD, A CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None LOGICAL , INTENT(IN ) :: WriteThisStep !< Will we print the WriteOutput values this step? - INTEGER(IntKi) :: k INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMSg2 @@ -4927,7 +4925,6 @@ SUBROUTINE SolveOption2c_Inp2AD_SrvD(this_time, this_state, p_FAST, m_FAST, ED, CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None LOGICAL , INTENT(IN ) :: WriteThisStep !< Will we print the WriteOutput values this step? - INTEGER(IntKi) :: k INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMSg2 @@ -5005,7 +5002,6 @@ SUBROUTINE SolveOption2(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None LOGICAL , INTENT(IN ) :: WriteThisStep !< Will we print the WriteOutput values this step? - INTEGER(IntKi) :: k INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMSg2 @@ -5078,13 +5074,12 @@ SUBROUTINE SolveOption2(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, END SUBROUTINE SolveOption2 !---------------------------------------------------------------------------------------------------------------------------------- !> This routines advances the states of each module -SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, & +SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, & MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg, WriteThisStep ) REAL(DbKi), INTENT(IN ) :: t_initial !< initial simulation time (almost always 0) INTEGER(IntKi), INTENT(IN ) :: n_t_global !< integer time step 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 diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 4607336f47..e76137d64c 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -4563,7 +4563,7 @@ SUBROUTINE FAST_Solution(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, !! STATE_PRED values contain values at t_global_next. !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - CALL FAST_AdvanceStates( t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, & + CALL FAST_AdvanceStates( t_initial, n_t_global, p_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, & MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2, WriteThisStep ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (ErrStat >= AbortErrLev) RETURN From 204da80048c0c3774028fe34fee2caafa684dbd3 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Tue, 10 Dec 2019 13:45:54 -0700 Subject: [PATCH 20/72] docs: update NREL 5MW damping in BD input file --- docs/source/user/beamdyn/examples/nrel_5mw_blade.inp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/source/user/beamdyn/examples/nrel_5mw_blade.inp b/docs/source/user/beamdyn/examples/nrel_5mw_blade.inp index 6dce8bcaf4..24e2192f2a 100644 --- a/docs/source/user/beamdyn/examples/nrel_5mw_blade.inp +++ b/docs/source/user/beamdyn/examples/nrel_5mw_blade.inp @@ -6,7 +6,7 @@ ---------------------- DAMPING COEFFICIENT------------------------------------ mu1 mu2 mu3 mu4 mu5 mu6 (-) (-) (-) (-) (-) (-) -1.0E-03 1.0E-03 1.0E-03 1.0E-03 1.0E-03 1.0E-03 +1.0E-03 1.0E-03 1.0E-03 0.0014 0.0022 0.0022 ---------------------- DISTRIBUTED PROPERTIES--------------------------------- 0.000000 9.729480E+08 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 From 132444c8d2c35ba6a1d0e65988b9664e7fac9f77 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Tue, 10 Dec 2019 13:46:14 -0700 Subject: [PATCH 21/72] removed more unused variables --- modules/beamdyn/src/BeamDyn.f90 | 5 ----- 1 file changed, 5 deletions(-) diff --git a/modules/beamdyn/src/BeamDyn.f90 b/modules/beamdyn/src/BeamDyn.f90 index a2ba1d44bd..7af5c177a2 100644 --- a/modules/beamdyn/src/BeamDyn.f90 +++ b/modules/beamdyn/src/BeamDyn.f90 @@ -509,10 +509,8 @@ subroutine InitializeNodalLocations(InputFileData,p,GLL_nodes,InitOut,ErrStat, E ! local variables INTEGER(IntKi) :: i ! do-loop counter INTEGER(IntKi) :: j ! do-loop counter - INTEGER(IntKi) :: idx_qp !< index of current quadrature point in loop INTEGER(IntKi) :: member_first_kp INTEGER(IntKi) :: member_last_kp - INTEGER(IntKi) :: temp_id2 REAL(BDKi) :: eta REAL(BDKi) :: temp_POS(3) REAL(BDKi) :: temp_CRV(3) @@ -2983,7 +2981,6 @@ SUBROUTINE BD_DissipativeForce( nelem, p, m,fact ) REAL(BDKi) :: b11(3,3) REAL(BDKi) :: b12(3,3) REAL(BDKi) :: alpha(3,3) - INTEGER(IntKi) :: i, j INTEGER(IntKi) :: idx_qp !< index of current quadrature point @@ -3613,7 +3610,6 @@ SUBROUTINE BD_Static(t,u,utimes,p,x,OtherState,m,ErrStat,ErrMsg) TYPE(BD_InputType) :: u_interp ! temporary copy of inputs, transferred to BD local system REAL(BDKi) :: ScaleFactor ! Factor for scaling applied loads at each step - INTEGER(IntKi) :: i INTEGER(IntKi) :: j ! Generic counters INTEGER(IntKi) :: piter REAL(BDKi) :: gravity_temp(3) @@ -3856,7 +3852,6 @@ SUBROUTINE BD_FD_Stat( x, gravity, p, m ) ! local variables INTEGER(IntKi) :: i INTEGER(IntKi) :: idx_dof - REAL(BDKi), allocatable :: RHS_m(:,:), RHS_p(:,:) CHARACTER(*), PARAMETER :: RoutineName = 'BD_FD_Stat' ! zero out the local matrices. From ee37085a9fb0fb3cc614787a2d361ce76d2c5e46 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Wed, 11 Dec 2019 11:29:22 -0700 Subject: [PATCH 22/72] Updates to python scripts for regression tests - Added `WP_Baseline` to list of directories to copy - Replaced `is` and `is not` with `==` and `!=` when comparing with a string literal (else they would always return false) --- reg_tests/executeOpenfastRegressionCase.py | 4 ++-- reg_tests/manualRegressionTest.py | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/reg_tests/executeOpenfastRegressionCase.py b/reg_tests/executeOpenfastRegressionCase.py index fbdc6071d5..f28411130f 100644 --- a/reg_tests/executeOpenfastRegressionCase.py +++ b/reg_tests/executeOpenfastRegressionCase.py @@ -119,7 +119,7 @@ def ignoreBaselineItems(directory, contents): # create the local output directory if it does not already exist # and initialize it with input files for all test cases -for data in ["AOC", "AWT27", "SWRT", "UAE_VI"]: +for data in ["AOC", "AWT27", "SWRT", "UAE_VI", "WP_Baseline"]: dataDir = os.path.join(buildDirectory, data) if not os.path.isdir(dataDir): shutil.copytree(os.path.join(moduleDirectory, data), dataDir) @@ -132,7 +132,7 @@ def ignoreBaselineItems(directory, contents): else: names = os.listdir(src) for name in names: - if name is "ServoData": + if name == "ServoData": continue srcname = os.path.join(src, name) dstname = os.path.join(dst, name) diff --git a/reg_tests/manualRegressionTest.py b/reg_tests/manualRegressionTest.py index 5223db78f1..601ada4233 100644 --- a/reg_tests/manualRegressionTest.py +++ b/reg_tests/manualRegressionTest.py @@ -60,7 +60,7 @@ def strFormat(string): outstd = sys.stdout if verbose else open(os.devnull, 'w') pythonCommand = sys.executable -if case is not "": +if case != "": caselist = [case] else: with open(os.path.join("r-test", "glue-codes", "openfast", "CaseList.md")) as listfile: From 63692827cc839964e386cedf7bf4c9bf8024822a Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Wed, 11 Dec 2019 14:30:47 -0700 Subject: [PATCH 23/72] NWTC Library: removed OutParmFFType This should be unnecessary after changing the length of the rest of the output channels. **However, it may cause some grief in the FAST.Farm code.** --- modules/nwtc-library/src/ModMesh_Mapping.f90 | 528 +++++++++-------- .../nwtc-library/src/NWTC_Library_Types.f90 | 534 +++++------------- .../src/Registry_NWTC_Library.txt | 7 +- .../Registry_NWTC_Library_typedef_mesh.txt | 6 +- .../Registry_NWTC_Library_typedef_nomesh.txt | 4 - 5 files changed, 415 insertions(+), 664 deletions(-) diff --git a/modules/nwtc-library/src/ModMesh_Mapping.f90 b/modules/nwtc-library/src/ModMesh_Mapping.f90 index eb17f74235..bdde696bf5 100644 --- a/modules/nwtc-library/src/ModMesh_Mapping.f90 +++ b/modules/nwtc-library/src/ModMesh_Mapping.f90 @@ -59,13 +59,13 @@ MODULE ModMesh_Mapping REAL(R8Ki), ALLOCATABLE :: M_uS(:,:) !< block matrix of moment that is multiplied by Source u (translationDisp) [-] REAL(R8Ki), ALLOCATABLE :: M_uD(:,:) !< block matrix of moment that is multiplied by Destination u (translationDisp) [-] REAL(R8Ki), ALLOCATABLE :: M_f(:,:) !< block matrix of moment that is multiplied by force [-] - END TYPE + END TYPE MeshMapLinearizationType !> data structures to determine full mapping between fields on different meshes TYPE, PUBLIC :: MeshMapType - TYPE(MapType), ALLOCATABLE :: MapLoads(:) !< mapping for load fields - TYPE(MapType), ALLOCATABLE :: MapMotions(:) !< mapping for motion fields + TYPE(MapType), ALLOCATABLE :: MapLoads(:) !< mapping data structure for loads on the mesh + TYPE(MapType), ALLOCATABLE :: MapMotions(:) !< mapping data structure for motions and/or scalars on the mesh [-] TYPE(MapType), ALLOCATABLE :: MapSrcToAugmt(:) !< for source line2 loads, we map between source and an augmented source mesh, then between augmented source and destination TYPE(MeshType) :: Augmented_Ln2_Src !< the augmented source mesh needed for some mapping types TYPE(MeshType) :: Lumped_Points_Src !< a lumped mesh needed for some mapping types, stored here for efficiency @@ -73,7 +73,7 @@ MODULE ModMesh_Mapping TYPE(MeshType) :: Lumped_Points_Dest #endif INTEGER, ALLOCATABLE :: LoadLn2_A_Mat_Piv(:) !< The pivot values for the factorization of LoadLn2_A_Mat - REAL(R8Ki), ALLOCATABLE :: DisplacedPosition(:,:,:) !< couple_arm +Scr%Disp - Dest%Disp for each mapped node (stored here for efficiency.) + REAL(R8Ki), ALLOCATABLE :: DisplacedPosition(:,:,:) !< couple_arm +Scr%Disp - Dest%Disp for each mapped node (stored here for efficiency) REAL(R8Ki), ALLOCATABLE :: LoadLn2_A_Mat(:,:) !< The n-by-n (n=3xNNodes) matrix that makes up the diagonal of the [A 0; B A] matrix in the point-to-line load mapping REAL(R8Ki), ALLOCATABLE :: LoadLn2_F(:,:) !< The 3-components of the forces for each node of an element in the point-to-line load mapping (for each element) REAL(R8Ki), ALLOCATABLE :: LoadLn2_M(:,:) !< The 3-components of the moments for each node of an element in the point-to-line load mapping (for each element) @@ -5880,14 +5880,18 @@ SUBROUTINE NWTC_Library_PackMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%OtherMesh_Element - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%distance - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%couple_arm))-1 ) = PACK(InData%couple_arm,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%couple_arm) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%shape_fn))-1 ) = PACK(InData%shape_fn,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%shape_fn) + IntKiBuf(Int_Xferred) = InData%OtherMesh_Element + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%distance + Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(InData%couple_arm,1), UBOUND(InData%couple_arm,1) + DbKiBuf(Db_Xferred) = InData%couple_arm(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%shape_fn,1), UBOUND(InData%shape_fn,1) + DbKiBuf(Db_Xferred) = InData%shape_fn(i1) + Db_Xferred = Db_Xferred + 1 + END DO END SUBROUTINE NWTC_Library_PackMapType SUBROUTINE NWTC_Library_UnPackMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -5903,12 +5907,6 @@ SUBROUTINE NWTC_Library_UnPackMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -5925,32 +5923,22 @@ SUBROUTINE NWTC_Library_UnPackMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%OtherMesh_Element = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%distance = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 + OutData%OtherMesh_Element = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%distance = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 i1_l = LBOUND(OutData%couple_arm,1) i1_u = UBOUND(OutData%couple_arm,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%couple_arm = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%couple_arm))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%couple_arm) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%couple_arm,1), UBOUND(OutData%couple_arm,1) + OutData%couple_arm(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%shape_fn,1) i1_u = UBOUND(OutData%shape_fn,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%shape_fn = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%shape_fn))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%shape_fn) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%shape_fn,1), UBOUND(OutData%shape_fn,1) + OutData%shape_fn(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO END SUBROUTINE NWTC_Library_UnPackMapType SUBROUTINE NWTC_Library_CopyMeshMapLinearizationType( SrcMeshMapLinearizationTypeData, DstMeshMapLinearizationTypeData, CtrlCode, ErrStat, ErrMsg ) @@ -6299,8 +6287,12 @@ SUBROUTINE NWTC_Library_PackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiBuf IntKiBuf( Int_Xferred + 1) = UBOUND(InData%mi,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%mi)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%mi))-1 ) = PACK(InData%mi,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%mi) + DO i2 = LBOUND(InData%mi,2), UBOUND(InData%mi,2) + DO i1 = LBOUND(InData%mi,1), UBOUND(InData%mi,1) + DbKiBuf(Db_Xferred) = InData%mi(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%fx_p) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6315,8 +6307,12 @@ SUBROUTINE NWTC_Library_PackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiBuf IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fx_p,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%fx_p)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%fx_p))-1 ) = PACK(InData%fx_p,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%fx_p) + DO i2 = LBOUND(InData%fx_p,2), UBOUND(InData%fx_p,2) + DO i1 = LBOUND(InData%fx_p,1), UBOUND(InData%fx_p,1) + DbKiBuf(Db_Xferred) = InData%fx_p(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%tv_uD) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6331,8 +6327,12 @@ SUBROUTINE NWTC_Library_PackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiBuf IntKiBuf( Int_Xferred + 1) = UBOUND(InData%tv_uD,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%tv_uD)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%tv_uD))-1 ) = PACK(InData%tv_uD,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%tv_uD) + DO i2 = LBOUND(InData%tv_uD,2), UBOUND(InData%tv_uD,2) + DO i1 = LBOUND(InData%tv_uD,1), UBOUND(InData%tv_uD,1) + DbKiBuf(Db_Xferred) = InData%tv_uD(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%tv_uS) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6347,8 +6347,12 @@ SUBROUTINE NWTC_Library_PackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiBuf IntKiBuf( Int_Xferred + 1) = UBOUND(InData%tv_uS,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%tv_uS)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%tv_uS))-1 ) = PACK(InData%tv_uS,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%tv_uS) + DO i2 = LBOUND(InData%tv_uS,2), UBOUND(InData%tv_uS,2) + DO i1 = LBOUND(InData%tv_uS,1), UBOUND(InData%tv_uS,1) + DbKiBuf(Db_Xferred) = InData%tv_uS(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%ta_uD) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6363,8 +6367,12 @@ SUBROUTINE NWTC_Library_PackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiBuf IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ta_uD,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ta_uD)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%ta_uD))-1 ) = PACK(InData%ta_uD,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%ta_uD) + DO i2 = LBOUND(InData%ta_uD,2), UBOUND(InData%ta_uD,2) + DO i1 = LBOUND(InData%ta_uD,1), UBOUND(InData%ta_uD,1) + DbKiBuf(Db_Xferred) = InData%ta_uD(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%ta_uS) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6379,8 +6387,12 @@ SUBROUTINE NWTC_Library_PackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiBuf IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ta_uS,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ta_uS)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%ta_uS))-1 ) = PACK(InData%ta_uS,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%ta_uS) + DO i2 = LBOUND(InData%ta_uS,2), UBOUND(InData%ta_uS,2) + DO i1 = LBOUND(InData%ta_uS,1), UBOUND(InData%ta_uS,1) + DbKiBuf(Db_Xferred) = InData%ta_uS(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%ta_rv) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6395,8 +6407,12 @@ SUBROUTINE NWTC_Library_PackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiBuf IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ta_rv,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ta_rv)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%ta_rv))-1 ) = PACK(InData%ta_rv,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%ta_rv) + DO i2 = LBOUND(InData%ta_rv,2), UBOUND(InData%ta_rv,2) + DO i1 = LBOUND(InData%ta_rv,1), UBOUND(InData%ta_rv,1) + DbKiBuf(Db_Xferred) = InData%ta_rv(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%li) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6411,8 +6427,12 @@ SUBROUTINE NWTC_Library_PackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiBuf IntKiBuf( Int_Xferred + 1) = UBOUND(InData%li,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%li)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%li))-1 ) = PACK(InData%li,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%li) + DO i2 = LBOUND(InData%li,2), UBOUND(InData%li,2) + DO i1 = LBOUND(InData%li,1), UBOUND(InData%li,1) + DbKiBuf(Db_Xferred) = InData%li(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%M_uS) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6427,8 +6447,12 @@ SUBROUTINE NWTC_Library_PackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiBuf IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M_uS,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%M_uS)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%M_uS))-1 ) = PACK(InData%M_uS,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%M_uS) + DO i2 = LBOUND(InData%M_uS,2), UBOUND(InData%M_uS,2) + DO i1 = LBOUND(InData%M_uS,1), UBOUND(InData%M_uS,1) + DbKiBuf(Db_Xferred) = InData%M_uS(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%M_uD) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6443,8 +6467,12 @@ SUBROUTINE NWTC_Library_PackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiBuf IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M_uD,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%M_uD)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%M_uD))-1 ) = PACK(InData%M_uD,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%M_uD) + DO i2 = LBOUND(InData%M_uD,2), UBOUND(InData%M_uD,2) + DO i1 = LBOUND(InData%M_uD,1), UBOUND(InData%M_uD,1) + DbKiBuf(Db_Xferred) = InData%M_uD(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%M_f) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6459,8 +6487,12 @@ SUBROUTINE NWTC_Library_PackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiBuf IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M_f,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%M_f)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%M_f))-1 ) = PACK(InData%M_f,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%M_f) + DO i2 = LBOUND(InData%M_f,2), UBOUND(InData%M_f,2) + DO i1 = LBOUND(InData%M_f,1), UBOUND(InData%M_f,1) + DbKiBuf(Db_Xferred) = InData%M_f(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF END SUBROUTINE NWTC_Library_PackMeshMapLinearizationType @@ -6477,12 +6509,6 @@ SUBROUTINE NWTC_Library_UnPackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiB INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -6514,15 +6540,12 @@ SUBROUTINE NWTC_Library_UnPackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiB CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%mi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%mi)>0) OutData%mi = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%mi))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%mi) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%mi,2), UBOUND(OutData%mi,2) + DO i1 = LBOUND(OutData%mi,1), UBOUND(OutData%mi,1) + OutData%mi(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fx_p not allocated Int_Xferred = Int_Xferred + 1 @@ -6540,15 +6563,12 @@ SUBROUTINE NWTC_Library_UnPackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiB CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fx_p.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%fx_p)>0) OutData%fx_p = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%fx_p))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%fx_p) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%fx_p,2), UBOUND(OutData%fx_p,2) + DO i1 = LBOUND(OutData%fx_p,1), UBOUND(OutData%fx_p,1) + OutData%fx_p(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! tv_uD not allocated Int_Xferred = Int_Xferred + 1 @@ -6566,15 +6586,12 @@ SUBROUTINE NWTC_Library_UnPackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiB CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%tv_uD.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%tv_uD)>0) OutData%tv_uD = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%tv_uD))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%tv_uD) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%tv_uD,2), UBOUND(OutData%tv_uD,2) + DO i1 = LBOUND(OutData%tv_uD,1), UBOUND(OutData%tv_uD,1) + OutData%tv_uD(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! tv_uS not allocated Int_Xferred = Int_Xferred + 1 @@ -6592,15 +6609,12 @@ SUBROUTINE NWTC_Library_UnPackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiB CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%tv_uS.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%tv_uS)>0) OutData%tv_uS = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%tv_uS))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%tv_uS) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%tv_uS,2), UBOUND(OutData%tv_uS,2) + DO i1 = LBOUND(OutData%tv_uS,1), UBOUND(OutData%tv_uS,1) + OutData%tv_uS(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ta_uD not allocated Int_Xferred = Int_Xferred + 1 @@ -6618,15 +6632,12 @@ SUBROUTINE NWTC_Library_UnPackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiB CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ta_uD.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%ta_uD)>0) OutData%ta_uD = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%ta_uD))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%ta_uD) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%ta_uD,2), UBOUND(OutData%ta_uD,2) + DO i1 = LBOUND(OutData%ta_uD,1), UBOUND(OutData%ta_uD,1) + OutData%ta_uD(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ta_uS not allocated Int_Xferred = Int_Xferred + 1 @@ -6644,15 +6655,12 @@ SUBROUTINE NWTC_Library_UnPackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiB CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ta_uS.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%ta_uS)>0) OutData%ta_uS = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%ta_uS))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%ta_uS) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%ta_uS,2), UBOUND(OutData%ta_uS,2) + DO i1 = LBOUND(OutData%ta_uS,1), UBOUND(OutData%ta_uS,1) + OutData%ta_uS(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ta_rv not allocated Int_Xferred = Int_Xferred + 1 @@ -6670,15 +6678,12 @@ SUBROUTINE NWTC_Library_UnPackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiB CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ta_rv.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%ta_rv)>0) OutData%ta_rv = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%ta_rv))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%ta_rv) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%ta_rv,2), UBOUND(OutData%ta_rv,2) + DO i1 = LBOUND(OutData%ta_rv,1), UBOUND(OutData%ta_rv,1) + OutData%ta_rv(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! li not allocated Int_Xferred = Int_Xferred + 1 @@ -6696,15 +6701,12 @@ SUBROUTINE NWTC_Library_UnPackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiB CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%li.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%li)>0) OutData%li = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%li))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%li) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%li,2), UBOUND(OutData%li,2) + DO i1 = LBOUND(OutData%li,1), UBOUND(OutData%li,1) + OutData%li(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! M_uS not allocated Int_Xferred = Int_Xferred + 1 @@ -6722,15 +6724,12 @@ SUBROUTINE NWTC_Library_UnPackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiB CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%M_uS.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%M_uS)>0) OutData%M_uS = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%M_uS))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%M_uS) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%M_uS,2), UBOUND(OutData%M_uS,2) + DO i1 = LBOUND(OutData%M_uS,1), UBOUND(OutData%M_uS,1) + OutData%M_uS(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! M_uD not allocated Int_Xferred = Int_Xferred + 1 @@ -6748,15 +6747,12 @@ SUBROUTINE NWTC_Library_UnPackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiB CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%M_uD.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%M_uD)>0) OutData%M_uD = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%M_uD))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%M_uD) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%M_uD,2), UBOUND(OutData%M_uD,2) + DO i1 = LBOUND(OutData%M_uD,1), UBOUND(OutData%M_uD,1) + OutData%M_uD(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! M_f not allocated Int_Xferred = Int_Xferred + 1 @@ -6774,15 +6770,12 @@ SUBROUTINE NWTC_Library_UnPackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiB CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%M_f.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%M_f)>0) OutData%M_f = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%M_f))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%M_f) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%M_f,2), UBOUND(OutData%M_f,2) + DO i1 = LBOUND(OutData%M_f,1), UBOUND(OutData%M_f,1) + OutData%M_f(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF END SUBROUTINE NWTC_Library_UnPackMeshMapLinearizationType @@ -6885,20 +6878,6 @@ SUBROUTINE NWTC_Library_CopyMeshMapType( SrcMeshMapTypeData, DstMeshMapTypeData, END IF DstMeshMapTypeData%DisplacedPosition = SrcMeshMapTypeData%DisplacedPosition ENDIF -IF (ALLOCATED(SrcMeshMapTypeData%LoadLn2_F)) THEN - i1_l = LBOUND(SrcMeshMapTypeData%LoadLn2_F,1) - i1_u = UBOUND(SrcMeshMapTypeData%LoadLn2_F,1) - i2_l = LBOUND(SrcMeshMapTypeData%LoadLn2_F,2) - i2_u = UBOUND(SrcMeshMapTypeData%LoadLn2_F,2) - IF (.NOT. ALLOCATED(DstMeshMapTypeData%LoadLn2_F)) THEN - ALLOCATE(DstMeshMapTypeData%LoadLn2_F(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapTypeData%LoadLn2_F.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMeshMapTypeData%LoadLn2_F = SrcMeshMapTypeData%LoadLn2_F -ENDIF IF (ALLOCATED(SrcMeshMapTypeData%LoadLn2_A_Mat)) THEN i1_l = LBOUND(SrcMeshMapTypeData%LoadLn2_A_Mat,1) i1_u = UBOUND(SrcMeshMapTypeData%LoadLn2_A_Mat,1) @@ -6913,6 +6892,20 @@ SUBROUTINE NWTC_Library_CopyMeshMapType( SrcMeshMapTypeData, DstMeshMapTypeData, END IF DstMeshMapTypeData%LoadLn2_A_Mat = SrcMeshMapTypeData%LoadLn2_A_Mat ENDIF +IF (ALLOCATED(SrcMeshMapTypeData%LoadLn2_F)) THEN + i1_l = LBOUND(SrcMeshMapTypeData%LoadLn2_F,1) + i1_u = UBOUND(SrcMeshMapTypeData%LoadLn2_F,1) + i2_l = LBOUND(SrcMeshMapTypeData%LoadLn2_F,2) + i2_u = UBOUND(SrcMeshMapTypeData%LoadLn2_F,2) + IF (.NOT. ALLOCATED(DstMeshMapTypeData%LoadLn2_F)) THEN + ALLOCATE(DstMeshMapTypeData%LoadLn2_F(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapTypeData%LoadLn2_F.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMeshMapTypeData%LoadLn2_F = SrcMeshMapTypeData%LoadLn2_F +ENDIF IF (ALLOCATED(SrcMeshMapTypeData%LoadLn2_M)) THEN i1_l = LBOUND(SrcMeshMapTypeData%LoadLn2_M,1) i1_u = UBOUND(SrcMeshMapTypeData%LoadLn2_M,1) @@ -6967,12 +6960,12 @@ SUBROUTINE NWTC_Library_DestroyMeshMapType( MeshMapTypeData, ErrStat, ErrMsg ) IF (ALLOCATED(MeshMapTypeData%DisplacedPosition)) THEN DEALLOCATE(MeshMapTypeData%DisplacedPosition) ENDIF -IF (ALLOCATED(MeshMapTypeData%LoadLn2_F)) THEN - DEALLOCATE(MeshMapTypeData%LoadLn2_F) -ENDIF IF (ALLOCATED(MeshMapTypeData%LoadLn2_A_Mat)) THEN DEALLOCATE(MeshMapTypeData%LoadLn2_A_Mat) ENDIF +IF (ALLOCATED(MeshMapTypeData%LoadLn2_F)) THEN + DEALLOCATE(MeshMapTypeData%LoadLn2_F) +ENDIF IF (ALLOCATED(MeshMapTypeData%LoadLn2_M)) THEN DEALLOCATE(MeshMapTypeData%LoadLn2_M) ENDIF @@ -7128,16 +7121,16 @@ SUBROUTINE NWTC_Library_PackMeshMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Err Int_BufSz = Int_BufSz + 2*3 ! DisplacedPosition upper/lower bounds for each dimension Db_BufSz = Db_BufSz + SIZE(InData%DisplacedPosition) ! DisplacedPosition END IF - Int_BufSz = Int_BufSz + 1 ! LoadLn2_F allocated yes/no - IF ( ALLOCATED(InData%LoadLn2_F) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! LoadLn2_F upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%LoadLn2_F) ! LoadLn2_F - END IF Int_BufSz = Int_BufSz + 1 ! LoadLn2_A_Mat allocated yes/no IF ( ALLOCATED(InData%LoadLn2_A_Mat) ) THEN Int_BufSz = Int_BufSz + 2*2 ! LoadLn2_A_Mat upper/lower bounds for each dimension Db_BufSz = Db_BufSz + SIZE(InData%LoadLn2_A_Mat) ! LoadLn2_A_Mat END IF + Int_BufSz = Int_BufSz + 1 ! LoadLn2_F allocated yes/no + IF ( ALLOCATED(InData%LoadLn2_F) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! LoadLn2_F upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%LoadLn2_F) ! LoadLn2_F + END IF Int_BufSz = Int_BufSz + 1 ! LoadLn2_M allocated yes/no IF ( ALLOCATED(InData%LoadLn2_M) ) THEN Int_BufSz = Int_BufSz + 2*2 ! LoadLn2_M upper/lower bounds for each dimension @@ -7376,8 +7369,10 @@ SUBROUTINE NWTC_Library_PackMeshMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LoadLn2_A_Mat_Piv,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LoadLn2_A_Mat_Piv)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%LoadLn2_A_Mat_Piv))-1 ) = PACK(InData%LoadLn2_A_Mat_Piv,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%LoadLn2_A_Mat_Piv) + DO i1 = LBOUND(InData%LoadLn2_A_Mat_Piv,1), UBOUND(InData%LoadLn2_A_Mat_Piv,1) + IntKiBuf(Int_Xferred) = InData%LoadLn2_A_Mat_Piv(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%DisplacedPosition) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7395,40 +7390,54 @@ SUBROUTINE NWTC_Library_PackMeshMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DisplacedPosition,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DisplacedPosition)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%DisplacedPosition))-1 ) = PACK(InData%DisplacedPosition,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%DisplacedPosition) + DO i3 = LBOUND(InData%DisplacedPosition,3), UBOUND(InData%DisplacedPosition,3) + DO i2 = LBOUND(InData%DisplacedPosition,2), UBOUND(InData%DisplacedPosition,2) + DO i1 = LBOUND(InData%DisplacedPosition,1), UBOUND(InData%DisplacedPosition,1) + DbKiBuf(Db_Xferred) = InData%DisplacedPosition(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF - IF ( .NOT. ALLOCATED(InData%LoadLn2_F) ) THEN + IF ( .NOT. ALLOCATED(InData%LoadLn2_A_Mat) ) 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%LoadLn2_F,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LoadLn2_F,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%LoadLn2_A_Mat,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LoadLn2_A_Mat,1) Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LoadLn2_F,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LoadLn2_F,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%LoadLn2_A_Mat,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LoadLn2_A_Mat,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LoadLn2_F)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%LoadLn2_F))-1 ) = PACK(InData%LoadLn2_F,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%LoadLn2_F) + DO i2 = LBOUND(InData%LoadLn2_A_Mat,2), UBOUND(InData%LoadLn2_A_Mat,2) + DO i1 = LBOUND(InData%LoadLn2_A_Mat,1), UBOUND(InData%LoadLn2_A_Mat,1) + DbKiBuf(Db_Xferred) = InData%LoadLn2_A_Mat(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF - IF ( .NOT. ALLOCATED(InData%LoadLn2_A_Mat) ) THEN + IF ( .NOT. ALLOCATED(InData%LoadLn2_F) ) 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%LoadLn2_A_Mat,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LoadLn2_A_Mat,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%LoadLn2_F,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LoadLn2_F,1) Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LoadLn2_A_Mat,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LoadLn2_A_Mat,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%LoadLn2_F,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LoadLn2_F,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LoadLn2_A_Mat)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%LoadLn2_A_Mat))-1 ) = PACK(InData%LoadLn2_A_Mat,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%LoadLn2_A_Mat) + DO i2 = LBOUND(InData%LoadLn2_F,2), UBOUND(InData%LoadLn2_F,2) + DO i1 = LBOUND(InData%LoadLn2_F,1), UBOUND(InData%LoadLn2_F,1) + DbKiBuf(Db_Xferred) = InData%LoadLn2_F(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%LoadLn2_M) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7443,8 +7452,12 @@ SUBROUTINE NWTC_Library_PackMeshMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LoadLn2_M,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LoadLn2_M)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%LoadLn2_M))-1 ) = PACK(InData%LoadLn2_M,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%LoadLn2_M) + DO i2 = LBOUND(InData%LoadLn2_M,2), UBOUND(InData%LoadLn2_M,2) + DO i1 = LBOUND(InData%LoadLn2_M,1), UBOUND(InData%LoadLn2_M,1) + DbKiBuf(Db_Xferred) = InData%LoadLn2_M(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF CALL NWTC_Library_Packmeshmaplinearizationtype( Re_Buf, Db_Buf, Int_Buf, InData%dM, ErrStat2, ErrMsg2, OnlySize ) ! dM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -7489,12 +7502,6 @@ SUBROUTINE NWTC_Library_UnPackMeshMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 @@ -7772,15 +7779,10 @@ SUBROUTINE NWTC_Library_UnPackMeshMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LoadLn2_A_Mat_Piv.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LoadLn2_A_Mat_Piv)>0) OutData%LoadLn2_A_Mat_Piv = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%LoadLn2_A_Mat_Piv))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%LoadLn2_A_Mat_Piv) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LoadLn2_A_Mat_Piv,1), UBOUND(OutData%LoadLn2_A_Mat_Piv,1) + OutData%LoadLn2_A_Mat_Piv(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DisplacedPosition not allocated Int_Xferred = Int_Xferred + 1 @@ -7801,17 +7803,16 @@ SUBROUTINE NWTC_Library_UnPackMeshMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DisplacedPosition.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%DisplacedPosition)>0) OutData%DisplacedPosition = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%DisplacedPosition))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%DisplacedPosition) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%DisplacedPosition,3), UBOUND(OutData%DisplacedPosition,3) + DO i2 = LBOUND(OutData%DisplacedPosition,2), UBOUND(OutData%DisplacedPosition,2) + DO i1 = LBOUND(OutData%DisplacedPosition,1), UBOUND(OutData%DisplacedPosition,1) + OutData%DisplacedPosition(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LoadLn2_F not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LoadLn2_A_Mat not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -7821,23 +7822,20 @@ SUBROUTINE NWTC_Library_UnPackMeshMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, i2_l = IntKiBuf( Int_Xferred ) i2_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LoadLn2_F)) DEALLOCATE(OutData%LoadLn2_F) - ALLOCATE(OutData%LoadLn2_F(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LoadLn2_F.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%LoadLn2_A_Mat)) DEALLOCATE(OutData%LoadLn2_A_Mat) + ALLOCATE(OutData%LoadLn2_A_Mat(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LoadLn2_A_Mat.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask2 = .TRUE. - IF (SIZE(OutData%LoadLn2_F)>0) OutData%LoadLn2_F = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%LoadLn2_F))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%LoadLn2_F) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%LoadLn2_A_Mat,2), UBOUND(OutData%LoadLn2_A_Mat,2) + DO i1 = LBOUND(OutData%LoadLn2_A_Mat,1), UBOUND(OutData%LoadLn2_A_Mat,1) + OutData%LoadLn2_A_Mat(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LoadLn2_A_Mat not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LoadLn2_F not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -7847,21 +7845,18 @@ SUBROUTINE NWTC_Library_UnPackMeshMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, i2_l = IntKiBuf( Int_Xferred ) i2_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LoadLn2_A_Mat)) DEALLOCATE(OutData%LoadLn2_A_Mat) - ALLOCATE(OutData%LoadLn2_A_Mat(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LoadLn2_A_Mat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%LoadLn2_F)) DEALLOCATE(OutData%LoadLn2_F) + ALLOCATE(OutData%LoadLn2_F(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LoadLn2_F.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask2 = .TRUE. - IF (SIZE(OutData%LoadLn2_A_Mat)>0) OutData%LoadLn2_A_Mat = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%LoadLn2_A_Mat))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%LoadLn2_A_Mat) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%LoadLn2_F,2), UBOUND(OutData%LoadLn2_F,2) + DO i1 = LBOUND(OutData%LoadLn2_F,1), UBOUND(OutData%LoadLn2_F,1) + OutData%LoadLn2_F(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LoadLn2_M not allocated Int_Xferred = Int_Xferred + 1 @@ -7879,15 +7874,12 @@ SUBROUTINE NWTC_Library_UnPackMeshMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LoadLn2_M.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%LoadLn2_M)>0) OutData%LoadLn2_M = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%LoadLn2_M))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%LoadLn2_M) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%LoadLn2_M,2), UBOUND(OutData%LoadLn2_M,2) + DO i1 = LBOUND(OutData%LoadLn2_M,1), UBOUND(OutData%LoadLn2_M,1) + OutData%LoadLn2_M(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 diff --git a/modules/nwtc-library/src/NWTC_Library_Types.f90 b/modules/nwtc-library/src/NWTC_Library_Types.f90 index eb6d34fb0b..68b8fe90f1 100644 --- a/modules/nwtc-library/src/NWTC_Library_Types.f90 +++ b/modules/nwtc-library/src/NWTC_Library_Types.f90 @@ -3,7 +3,7 @@ ! WARNING This file is generated automatically by the FAST registry. ! Do not edit. Your changes to this file will be lost. ! -! FAST Registry (v3.02.00, 23-Jul-2016) +! FAST Registry !********************************************************************************************************************************* ! NWTC_Library_Types !................................................................................................................................. @@ -26,9 +26,8 @@ ! ! bjj: modifications made !********************************************************************************************************************************* -!> This module contains many of the user-defined types used in NWTC_Library. It also contains copy, destroy, pack, and -!! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry, but -!! was modified for the specific needs of NWTC Library. +!> This module contains the user-defined types needed in NWTC_Library. 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 NWTC_Library_Types !--------------------------------------------------------------------------------------------------------------------------------- USE SysSubs @@ -60,14 +59,6 @@ MODULE NWTC_Library_Types INTEGER(IntKi) :: SignM !< Multiplier for output channel; usually -1 (minus) or 0 (invalid channel) [-] END TYPE OutParmType ! ======================= -! ========= OutParmFFType ======= - TYPE, PUBLIC :: OutParmFFType - INTEGER(IntKi) :: Indx !< An index into AllOuts array where this channel is computed/stored [-] - CHARACTER(ChanLenFF) :: Name !< Name of the output channel [-] - CHARACTER(ChanLenFF) :: Units !< Units this channel is specified in [-] - INTEGER(IntKi) :: SignM !< Multiplier for output channel; usually -1 (minus) or 0 (invalid channel) [-] - END TYPE OutParmFFType -! ======================= ! ========= FileInfoType ======= TYPE, PUBLIC :: FileInfoType INTEGER(IntKi) :: NumLines @@ -214,18 +205,18 @@ SUBROUTINE NWTC_Library_PackProgDesc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%Name) - IntKiBuf(Int_Xferred) = ICHAR(InData%Name(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%Ver) - IntKiBuf(Int_Xferred) = ICHAR(InData%Ver(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%Date) - IntKiBuf(Int_Xferred) = ICHAR(InData%Date(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(InData%Name) + IntKiBuf(Int_Xferred) = ICHAR(InData%Name(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%Ver) + IntKiBuf(Int_Xferred) = ICHAR(InData%Ver(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%Date) + IntKiBuf(Int_Xferred) = ICHAR(InData%Date(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE NWTC_Library_PackProgDesc SUBROUTINE NWTC_Library_UnPackProgDesc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -241,12 +232,6 @@ SUBROUTINE NWTC_Library_UnPackProgDesc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -262,18 +247,18 @@ SUBROUTINE NWTC_Library_UnPackProgDesc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%Name) - OutData%Name(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Ver) - OutData%Ver(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Date) - OutData%Date(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%Name) + OutData%Name(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%Ver) + OutData%Ver(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%Date) + OutData%Date(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE NWTC_Library_UnPackProgDesc SUBROUTINE NWTC_Library_CopyFASTdataType( SrcFASTdataTypeData, DstFASTdataTypeData, CtrlCode, ErrStat, ErrMsg ) @@ -439,20 +424,20 @@ SUBROUTINE NWTC_Library_PackFASTdataType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Er Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%File) - IntKiBuf(Int_Xferred) = ICHAR(InData%File(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%Descr) - IntKiBuf(Int_Xferred) = ICHAR(InData%Descr(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumChans - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumRecs - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TimeStep - Db_Xferred = Db_Xferred + 1 + DO I = 1, LEN(InData%File) + IntKiBuf(Int_Xferred) = ICHAR(InData%File(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%Descr) + IntKiBuf(Int_Xferred) = ICHAR(InData%Descr(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%NumChans + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumRecs + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%TimeStep + Db_Xferred = Db_Xferred + 1 IF ( .NOT. ALLOCATED(InData%ChanNames) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -463,12 +448,12 @@ SUBROUTINE NWTC_Library_PackFASTdataType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ChanNames,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%ChanNames,1), UBOUND(InData%ChanNames,1) + DO i1 = LBOUND(InData%ChanNames,1), UBOUND(InData%ChanNames,1) DO I = 1, LEN(InData%ChanNames) IntKiBuf(Int_Xferred) = ICHAR(InData%ChanNames(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%ChanUnits) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -480,12 +465,12 @@ SUBROUTINE NWTC_Library_PackFASTdataType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ChanUnits,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%ChanUnits,1), UBOUND(InData%ChanUnits,1) + DO i1 = LBOUND(InData%ChanUnits,1), UBOUND(InData%ChanUnits,1) DO I = 1, LEN(InData%ChanUnits) IntKiBuf(Int_Xferred) = ICHAR(InData%ChanUnits(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%Data) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -500,8 +485,12 @@ SUBROUTINE NWTC_Library_PackFASTdataType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Data,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Data)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Data))-1 ) = PACK(InData%Data,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Data) + DO i2 = LBOUND(InData%Data,2), UBOUND(InData%Data,2) + DO i1 = LBOUND(InData%Data,1), UBOUND(InData%Data,1) + ReKiBuf(Re_Xferred) = InData%Data(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE NWTC_Library_PackFASTdataType @@ -518,12 +507,6 @@ SUBROUTINE NWTC_Library_UnPackFASTdataType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -539,20 +522,20 @@ SUBROUTINE NWTC_Library_UnPackFASTdataType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%File) - OutData%File(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Descr) - OutData%Descr(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%NumChans = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumRecs = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TimeStep = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + DO I = 1, LEN(OutData%File) + OutData%File(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%Descr) + OutData%Descr(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%NumChans = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumRecs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TimeStep = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ChanNames not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -566,19 +549,12 @@ SUBROUTINE NWTC_Library_UnPackFASTdataType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ChanNames.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%ChanNames,1), UBOUND(OutData%ChanNames,1) + DO i1 = LBOUND(OutData%ChanNames,1), UBOUND(OutData%ChanNames,1) DO I = 1, LEN(OutData%ChanNames) OutData%ChanNames(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ChanUnits not allocated Int_Xferred = Int_Xferred + 1 @@ -593,19 +569,12 @@ SUBROUTINE NWTC_Library_UnPackFASTdataType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ChanUnits.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%ChanUnits,1), UBOUND(OutData%ChanUnits,1) + DO i1 = LBOUND(OutData%ChanUnits,1), UBOUND(OutData%ChanUnits,1) DO I = 1, LEN(OutData%ChanUnits) OutData%ChanUnits(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Data not allocated Int_Xferred = Int_Xferred + 1 @@ -623,15 +592,12 @@ SUBROUTINE NWTC_Library_UnPackFASTdataType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Data.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Data)>0) OutData%Data = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Data))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Data) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Data,2), UBOUND(OutData%Data,2) + DO i1 = LBOUND(OutData%Data,1), UBOUND(OutData%Data,1) + OutData%Data(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE NWTC_Library_UnPackFASTdataType @@ -732,18 +698,18 @@ SUBROUTINE NWTC_Library_PackOutParmType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Err Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Indx - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%Name) - IntKiBuf(Int_Xferred) = ICHAR(InData%Name(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%Units) - IntKiBuf(Int_Xferred) = ICHAR(InData%Units(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%SignM - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Indx + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%Name) + IntKiBuf(Int_Xferred) = ICHAR(InData%Name(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%Units) + IntKiBuf(Int_Xferred) = ICHAR(InData%Units(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%SignM + Int_Xferred = Int_Xferred + 1 END SUBROUTINE NWTC_Library_PackOutParmType SUBROUTINE NWTC_Library_UnPackOutParmType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -759,12 +725,6 @@ SUBROUTINE NWTC_Library_UnPackOutParmType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_UnPackOutParmType' @@ -778,177 +738,20 @@ SUBROUTINE NWTC_Library_UnPackOutParmType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%Indx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%Name) - OutData%Name(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Units) - OutData%Units(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%SignM = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%Indx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%Name) + OutData%Name(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%Units) + OutData%Units(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%SignM = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE NWTC_Library_UnPackOutParmType - SUBROUTINE NWTC_Library_CopyOutParmFFType( SrcOutParmTypeData, DstOutParmTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(OutParmFFType), INTENT(IN) :: SrcOutParmTypeData - TYPE(OutParmFFType), INTENT(INOUT) :: DstOutParmTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_CopyOutParmFFType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstOutParmTypeData%Indx = SrcOutParmTypeData%Indx - DstOutParmTypeData%Name = SrcOutParmTypeData%Name - DstOutParmTypeData%Units = SrcOutParmTypeData%Units - DstOutParmTypeData%SignM = SrcOutParmTypeData%SignM - END SUBROUTINE NWTC_Library_CopyOutParmFFType - - SUBROUTINE NWTC_Library_DestroyOutParmFFType( OutParmTypeData, ErrStat, ErrMsg ) - TYPE(OutParmFFType), INTENT(INOUT) :: OutParmTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_DestroyOutParmFFType' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE NWTC_Library_DestroyOutParmFFType - - SUBROUTINE NWTC_Library_PackOutParmFFType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(OutParmFFType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_PackOutParmFFType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! Indx - Int_BufSz = Int_BufSz + 1*LEN(InData%Name) ! Name - Int_BufSz = Int_BufSz + 1*LEN(InData%Units) ! Units - Int_BufSz = Int_BufSz + 1 ! SignM - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Indx - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%Name) - IntKiBuf(Int_Xferred) = ICHAR(InData%Name(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%Units) - IntKiBuf(Int_Xferred) = ICHAR(InData%Units(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%SignM - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE NWTC_Library_PackOutParmFFType - - SUBROUTINE NWTC_Library_UnPackOutParmFFType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(OutParmFFType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_UnPackOutParmFFType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%Indx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%Name) - OutData%Name(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Units) - OutData%Units(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%SignM = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE NWTC_Library_UnPackOutParmFFType - SUBROUTINE NWTC_Library_CopyFileInfoType( SrcFileInfoTypeData, DstFileInfoTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(FileInfoType), INTENT(IN) :: SrcFileInfoTypeData TYPE(FileInfoType), INTENT(INOUT) :: DstFileInfoTypeData @@ -1123,10 +926,10 @@ SUBROUTINE NWTC_Library_PackFileInfoType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Er Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumLines - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumFiles - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumLines + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumFiles + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%FileLine) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1137,8 +940,10 @@ SUBROUTINE NWTC_Library_PackFileInfoType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FileLine,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FileLine)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%FileLine))-1 ) = PACK(InData%FileLine,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%FileLine) + DO i1 = LBOUND(InData%FileLine,1), UBOUND(InData%FileLine,1) + IntKiBuf(Int_Xferred) = InData%FileLine(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%FileIndx) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1150,8 +955,10 @@ SUBROUTINE NWTC_Library_PackFileInfoType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FileIndx,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FileIndx)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%FileIndx))-1 ) = PACK(InData%FileIndx,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%FileIndx) + DO i1 = LBOUND(InData%FileIndx,1), UBOUND(InData%FileIndx,1) + IntKiBuf(Int_Xferred) = InData%FileIndx(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%FileList) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1163,12 +970,12 @@ SUBROUTINE NWTC_Library_PackFileInfoType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FileList,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%FileList,1), UBOUND(InData%FileList,1) + DO i1 = LBOUND(InData%FileList,1), UBOUND(InData%FileList,1) DO I = 1, LEN(InData%FileList) IntKiBuf(Int_Xferred) = ICHAR(InData%FileList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%Lines) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1180,12 +987,12 @@ SUBROUTINE NWTC_Library_PackFileInfoType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Lines,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%Lines,1), UBOUND(InData%Lines,1) + DO i1 = LBOUND(InData%Lines,1), UBOUND(InData%Lines,1) DO I = 1, LEN(InData%Lines) IntKiBuf(Int_Xferred) = ICHAR(InData%Lines(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF END SUBROUTINE NWTC_Library_PackFileInfoType @@ -1202,12 +1009,6 @@ SUBROUTINE NWTC_Library_UnPackFileInfoType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1222,10 +1023,10 @@ SUBROUTINE NWTC_Library_UnPackFileInfoType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%NumLines = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumFiles = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NumLines = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumFiles = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FileLine not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1239,15 +1040,10 @@ SUBROUTINE NWTC_Library_UnPackFileInfoType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FileLine.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%FileLine)>0) OutData%FileLine = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%FileLine))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%FileLine) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FileLine,1), UBOUND(OutData%FileLine,1) + OutData%FileLine(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FileIndx not allocated Int_Xferred = Int_Xferred + 1 @@ -1262,15 +1058,10 @@ SUBROUTINE NWTC_Library_UnPackFileInfoType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FileIndx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%FileIndx)>0) OutData%FileIndx = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%FileIndx))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%FileIndx) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FileIndx,1), UBOUND(OutData%FileIndx,1) + OutData%FileIndx(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FileList not allocated Int_Xferred = Int_Xferred + 1 @@ -1285,19 +1076,12 @@ SUBROUTINE NWTC_Library_UnPackFileInfoType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FileList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%FileList,1), UBOUND(OutData%FileList,1) + DO i1 = LBOUND(OutData%FileList,1), UBOUND(OutData%FileList,1) DO I = 1, LEN(OutData%FileList) OutData%FileList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Lines not allocated Int_Xferred = Int_Xferred + 1 @@ -1312,19 +1096,12 @@ SUBROUTINE NWTC_Library_UnPackFileInfoType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Lines.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%Lines,1), UBOUND(OutData%Lines,1) + DO i1 = LBOUND(OutData%Lines,1), UBOUND(OutData%Lines,1) DO I = 1, LEN(OutData%Lines) OutData%Lines(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF END SUBROUTINE NWTC_Library_UnPackFileInfoType @@ -1422,10 +1199,12 @@ SUBROUTINE NWTC_Library_PackQuaternion( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrS Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%q0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%v))-1 ) = PACK(InData%v,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%v) + ReKiBuf(Re_Xferred) = InData%q0 + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%v,1), UBOUND(InData%v,1) + ReKiBuf(Re_Xferred) = InData%v(i1) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE NWTC_Library_PackQuaternion SUBROUTINE NWTC_Library_UnPackQuaternion( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1441,12 +1220,6 @@ SUBROUTINE NWTC_Library_UnPackQuaternion( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1461,19 +1234,14 @@ SUBROUTINE NWTC_Library_UnPackQuaternion( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%q0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%q0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%v,1) i1_u = UBOUND(OutData%v,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%v = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%v))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%v) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%v,1), UBOUND(OutData%v,1) + OutData%v(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE NWTC_Library_UnPackQuaternion END MODULE NWTC_Library_Types diff --git a/modules/nwtc-library/src/Registry_NWTC_Library.txt b/modules/nwtc-library/src/Registry_NWTC_Library.txt index b9eda5344b..a723a870d8 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library.txt @@ -24,11 +24,6 @@ usefrom ^ ^ CHARACTER(ChanLen) Name usefrom ^ ^ CHARACTER(ChanLen) Units usefrom ^ ^ IntKi SignM -usefrom NWTC_Library OutParmFFType IntKi Indx -usefrom ^ ^ CHARACTER(ChanLenFF) Name -usefrom ^ ^ CHARACTER(ChanLenFF) Units -usefrom ^ ^ IntKi SignM - usefrom NWTC_Library FileInfoType IntKi NumLines usefrom ^ ^ IntKi NumFiles usefrom ^ ^ IntKi FileLine {:} @@ -64,8 +59,8 @@ usefrom ^ ^ MeshType Augmented_L usefrom ^ ^ MeshType Lumped_Points_Src - usefrom ^ ^ INTEGER LoadLn2_A_Mat_Piv {:} usefrom ^ ^ R8Ki DisplacedPosition {:}{:}{:} -usefrom ^ ^ R8Ki LoadLn2_F {:}{:} usefrom ^ ^ R8Ki LoadLn2_A_Mat {:}{:} +usefrom ^ ^ R8Ki LoadLn2_F {:}{:} usefrom ^ ^ R8Ki LoadLn2_M {:}{:} usefrom ^ ^ MeshMapLinearizationType dM diff --git a/modules/nwtc-library/src/Registry_NWTC_Library_typedef_mesh.txt b/modules/nwtc-library/src/Registry_NWTC_Library_typedef_mesh.txt index 8dd68da34d..bb2096f1fd 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library_typedef_mesh.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library_typedef_mesh.txt @@ -27,13 +27,13 @@ typedef ^ ^ R8Ki M_f { typedef NWTC_Library MeshMapType MapType MapLoads {:} - - "mapping data structure for loads on the mesh" typedef ^ ^ MapType MapMotions {:} - - "mapping data structure for motions and/or scalars on the mesh" -typedef ^ ^ MapType MapSrcToAugmt {:} - - "for source line2 loads, we map between source and an augmented source mesh, then betwee augmented source and destination" +typedef ^ ^ MapType MapSrcToAugmt {:} - - "for source line2 loads, we map between source and an augmented source mesh, then between augmented source and destination" typedef ^ ^ MeshType Augmented_Ln2_Src - - - "temporary mesh for storing augmented line2 source values" typedef ^ ^ MeshType Lumped_Points_Src - - - "temporary mesh for lumping lines to points, stored here for efficiency" -typedef ^ ^ INTEGER LoadLn2_A_Mat_Piv {:} - - "The pivot values for the factorizatioin of LoadLn2_A_Mat" +typedef ^ ^ INTEGER LoadLn2_A_Mat_Piv {:} - - "The pivot values for the factorization of LoadLn2_A_Mat" typedef ^ ^ R8Ki DisplacedPosition {:}{:}{:} - - "couple_arm +Scr%Disp - Dest%Disp for each mapped node (stored here for efficiency)" -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_A_Mat {:}{:} - - "The 3-components of the forces for each node of an element in the point-to-line load mapping (for each element)" +typedef ^ ^ R8Ki LoadLn2_F {:}{:} - - "The 6-by-6 matrix that makes up the diagonal of the [A 0; B A] matrix in the point-to-line load mapping" typedef ^ ^ R8Ki LoadLn2_M {:}{:} - - "The 3-components of the moments for each node of an element in the point-to-line load mapping (for each element)" typedef ^ ^ MeshMapLinearizationType dM #typedef ^ ^ MeshType Lumped_Points_Dest - - - "temporary mesh for debugging the lumped values in the line2-to-line2" diff --git a/modules/nwtc-library/src/Registry_NWTC_Library_typedef_nomesh.txt b/modules/nwtc-library/src/Registry_NWTC_Library_typedef_nomesh.txt index d0c0abe726..b69bd3831b 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library_typedef_nomesh.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library_typedef_nomesh.txt @@ -24,10 +24,6 @@ typedef ^ ^ CHARACTER(ChanLen) Name - - 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 OutParmFFType IntKi Indx - - - "An index into AllOuts array where this channel is computed/stored" -typedef ^ ^ CHARACTER(ChanLenFF) Name - - - "Name of the output channel" -typedef ^ ^ CHARACTER(ChanLenFF) 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 From eeace1e72e50f90e066d0ffba12d3c85103b4546 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Wed, 11 Dec 2019 21:42:49 -0700 Subject: [PATCH 24/72] Allow channel lengths up to 20 characters - also modifies the binary output file --- modules/moordyn/src/MoorDyn_Registry.txt | 4 ++-- modules/moordyn/src/MoorDyn_Types.f90 | 4 ++-- modules/nwtc-library/src/NWTC_Base.f90 | 4 ++-- modules/nwtc-library/src/NWTC_IO.f90 | 26 ++++++++++++++++++---- modules/openfast-library/src/FAST_Subs.f90 | 12 +++++----- modules/subdyn/src/SubDyn_Output.f90 | 3 ++- modules/subdyn/src/SubDyn_Registry.txt | 6 ++--- modules/subdyn/src/SubDyn_Types.f90 | 6 ++--- reg_tests/lib/fast_io.py | 12 +++++++--- 9 files changed, 51 insertions(+), 26 deletions(-) diff --git a/modules/moordyn/src/MoorDyn_Registry.txt b/modules/moordyn/src/MoorDyn_Registry.txt index 1649418de8..35e63e8cfd 100644 --- a/modules/moordyn/src/MoorDyn_Registry.txt +++ b/modules/moordyn/src/MoorDyn_Registry.txt @@ -98,8 +98,8 @@ typedef ^ ^ ReKi LineWrOutput {:} # this is the MDOutParmType - a less literal alternative of the NWTC OutParmType for MoorDyn (to avoid huge lists of possible output channel permutations) -typedef ^ MD_OutParmType CHARACTER(10) Name - - - "name of output channel" -typedef ^ ^ CHARACTER(10) Units - - - "units string" +typedef ^ MD_OutParmType CHARACTER(ChanLen) Name - - - "name of output channel" +typedef ^ ^ CHARACTER(ChanLen) Units - - - "units string" typedef ^ ^ IntKi QType - - - "type of quantity - 0=tension, 1=x, 2=y, 3=z..." typedef ^ ^ IntKi OType - - - "type of object - 0=line, 1=connect" typedef ^ ^ IntKi NodeID - - - "node number if OType=0. 0=anchor, -1=N=Fairlead" diff --git a/modules/moordyn/src/MoorDyn_Types.f90 b/modules/moordyn/src/MoorDyn_Types.f90 index 9f16aba61b..d9e507a624 100644 --- a/modules/moordyn/src/MoorDyn_Types.f90 +++ b/modules/moordyn/src/MoorDyn_Types.f90 @@ -122,8 +122,8 @@ MODULE MoorDyn_Types ! ======================= ! ========= MD_OutParmType ======= TYPE, PUBLIC :: MD_OutParmType - CHARACTER(10) :: Name !< name of output channel [-] - CHARACTER(10) :: Units !< units string [-] + CHARACTER(ChanLen) :: Name !< name of output channel [-] + CHARACTER(ChanLen) :: Units !< units string [-] INTEGER(IntKi) :: QType !< type of quantity - 0=tension, 1=x, 2=y, 3=z... [-] INTEGER(IntKi) :: OType !< type of object - 0=line, 1=connect [-] INTEGER(IntKi) :: NodeID !< node number if OType=0. 0=anchor, -1=N=Fairlead [-] diff --git a/modules/nwtc-library/src/NWTC_Base.f90 b/modules/nwtc-library/src/NWTC_Base.f90 index f59e9b97ae..bd3ff35b4f 100644 --- a/modules/nwtc-library/src/NWTC_Base.f90 +++ b/modules/nwtc-library/src/NWTC_Base.f90 @@ -35,8 +35,8 @@ MODULE NWTC_Base INTEGER, PARAMETER :: BITS_IN_ADDR = C_INTPTR_T*8 !< The number of bits in an address (32-bit or 64-bit). INTEGER, PARAMETER :: ErrMsgLen = 1024 !< The maximum number of characters in an error message in the FAST framework - INTEGER(IntKi), PARAMETER :: ChanLen = 10 !< The allowable length of channel names (i.e., width of output columns) in the FAST framework - INTEGER(IntKi), PARAMETER :: ChanLenFF = 14 !< The allowable length of channel names (i.e., width of output columns) in the FAST.Farm software + INTEGER(IntKi), PARAMETER :: ChanLen = 20 !< The maximum allowable length of channel names (i.e., width of output columns) in the FAST framework + 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 :: NWTC_Verbose = 10 !< The maximum level of verbosity diff --git a/modules/nwtc-library/src/NWTC_IO.f90 b/modules/nwtc-library/src/NWTC_IO.f90 index ab726213d5..90a2051232 100644 --- a/modules/nwtc-library/src/NWTC_IO.f90 +++ b/modules/nwtc-library/src/NWTC_IO.f90 @@ -6743,8 +6743,6 @@ SUBROUTINE WrBinFAST(FileName, FileID, DescStr, ChanName, ChanUnit, TimeData, Al IMPLICIT NONE - INTEGER(IntKi), PARAMETER :: LenName = ChanLen ! Number of characters allowed in a channel name - ! Passed data (sorted by element size, then alphabetical) REAL(DbKi), INTENT(IN) :: TimeData(:) !< The time being output to the file (if using FileFmtID_WithoutTime: element 1 is the first output time, element 2 is the delta t) @@ -6752,8 +6750,8 @@ SUBROUTINE WrBinFAST(FileName, FileID, DescStr, ChanName, ChanUnit, TimeData, Al INTEGER(IntKi), INTENT(OUT):: ErrStat !< Indicates whether an error occurred (see NWTC_Library) INTEGER(B2Ki), INTENT(IN) :: FileID !< File ID, used to determine format of output file (use FileFmtID_WithTime or FileFmtID_WithoutTime) - CHARACTER(LenName),INTENT(IN) :: ChanName(:) !< The output channel names (including Time) - CHARACTER(LenName),INTENT(IN) :: ChanUnit(:) !< The output channel units (including Time) + CHARACTER(ChanLen),INTENT(IN) :: ChanName(:) !< The output channel names (including Time) + CHARACTER(ChanLen),INTENT(IN) :: ChanUnit(:) !< The output channel units (including Time) CHARACTER(*), INTENT(IN) :: DescStr !< Description to write to the binary file (e.g., program version, date, & time) CHARACTER(*), INTENT(OUT):: ErrMsg !< Error message associated with the ErrStat CHARACTER(*), INTENT(IN) :: FileName !< Name of the file to write the output in @@ -6801,6 +6799,8 @@ SUBROUTINE WrBinFAST(FileName, FileID, DescStr, ChanName, ChanUnit, TimeData, Al INTEGER(B1Ki), ALLOCATABLE :: ChanNameASCII(:) ! The ASCII equivalent of ChanName INTEGER(B1Ki), ALLOCATABLE :: ChanUnitASCII(:) ! The ASCII equivalent of ChanUnit + INTEGER(IntKi) :: LenName ! Max number of characters in a channel name + CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary error message CHARACTER(*), PARAMETER :: RoutineName = 'WrBinFAST' @@ -6834,6 +6834,15 @@ SUBROUTINE WrBinFAST(FileName, FileID, DescStr, ChanName, ChanUnit, TimeData, Al !............................................................................................................................... ! Allocate arrays !............................................................................................................................... + IF (FileID==FileFmtID_ChanLen_In) THEN + LenName = 1 + DO IC = 1,NumOutChans+1 + LenName = MAX(LenName,LEN_TRIM(ChanName(IC))) + LenName = MAX(LenName,LEN_TRIM(ChanUnit(IC))) + END DO + ELSE + LenName = 10 + END IF CALL AllocAry( ChanNameASCII, (1+NumOutChans)*LenName , 'temporary channel name array (ChanNameASCII)', ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -6998,6 +7007,15 @@ SUBROUTINE WrBinFAST(FileName, FileID, DescStr, ChanName, ChanUnit, TimeData, Al RETURN END IF + IF (FileID==FileFmtID_ChanLen_In) THEN + WRITE (UnIn, IOSTAT=ErrStat2) INT( LenName , B2Ki ) ! Length of channel names + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat( ErrID_Fatal, 'Error writing ChanLen to the FAST binary file.', ErrStat, ErrMsg, RoutineName ) + CALL Cleanup( ) + RETURN + END IF + END IF + WRITE (UnIn, IOSTAT=ErrStat2) INT( NumOutChans , B4Ki ) ! The number of output channels IF ( ErrStat2 /= 0 ) THEN CALL SetErrStat( ErrID_Fatal, 'Error writing NumOutChans to the FAST binary file.', ErrStat, ErrMsg, RoutineName ) diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index e76137d64c..794e1a1aba 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -1670,9 +1670,9 @@ SUBROUTINE FAST_Init( p, m_FAST, y_FAST, t_initial, InputFile, ErrStat, ErrMsg, p%n_TMax_m1 = CEILING( ( (p%TMax - t_initial) / p%DT ) ) - 1 ! We're going to go from step 0 to n_TMax (thus the -1 here) if (p%TMax < 1.0_DbKi) then ! log10(0) gives floating point divide-by-zero error - p%TChanLen = ChanLen + p%TChanLen = MinChanLen else - p%TChanLen = max( ChanLen, int(log10(p%TMax))+7 ) + p%TChanLen = max( MinChanLen, int(log10(p%TMax))+7 ) end if p%OutFmt_t = 'F'//trim(num2lstr( p%TChanLen ))//'.4' ! 'F10.4' @@ -1734,8 +1734,8 @@ SUBROUTINE ValidateInputData(p, m_FAST, ErrStat, ErrMsg) CALL ChkRealFmtStr( p%OutFmt, 'OutFmt', p%FmtWidth, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF ( p%WrTxtOutFile .and. p%FmtWidth /= ChanLen ) CALL SetErrStat( ErrID_Warn, 'OutFmt produces a column width of '// & - TRIM(Num2LStr(p%FmtWidth))//' instead of '//TRIM(Num2LStr(ChanLen))//' characters.', ErrStat, ErrMsg, RoutineName ) + IF ( p%WrTxtOutFile .and. p%FmtWidth < MinChanLen ) CALL SetErrStat( ErrID_Warn, 'OutFmt produces a column width of '// & + TRIM(Num2LStr(p%FmtWidth))//'), which may be too small.', ErrStat, ErrMsg, RoutineName ) IF ( p%WrTxtOutFile .AND. p%TChanLen > ChanLen ) THEN ! ( p%TMax > 9999.999_DbKi ) CALL SetErrStat( ErrID_Warn, 'TMax is too large for a '//trim(num2lstr(ChanLen))//'-character time column in text tabular (time-marching) output files.'// & @@ -2140,7 +2140,7 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, InitOutData_ED, InitOutData_BD, Init IF (p_FAST%WrTxtOutFile) THEN - y_FAST%ActualChanLen = max( ChanLen, p_FAST%FmtWidth ) + y_FAST%ActualChanLen = max( MinChanLen, p_FAST%FmtWidth ) DO I=1,NumOuts y_FAST%ActualChanLen = max( y_FAST%ActualChanLen, LEN_TRIM(y_FAST%ChannelNames(I)) ) y_FAST%ActualChanLen = max( y_FAST%ActualChanLen, LEN_TRIM(y_FAST%ChannelUnits(I)) ) @@ -2823,7 +2823,7 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, m_FAST, OverrideAbortErrLev, ErrS p%WrBinOutFile = .true. p%WrBinMod = FileFmtID_NoCompressWithoutTime ! A format specifier for the binary output file format (3=don't include time channel and do not pack data) else - p%WrBinMod = FileFmtID_WithoutTime ! A format specifier for the binary output file format (1=include time channel as packed 32-bit binary; 2=don't include time channel;3=don't include time channel and do not pack data) + p%WrBinMod = FileFmtID_ChanLen_In ! A format specifier for the binary output file format (1=include time channel as packed 32-bit binary; 2=don't include time channel;3=don't include time channel and do not pack data) end if OutFileFmt = OutFileFmt / 2 ! integer division diff --git a/modules/subdyn/src/SubDyn_Output.f90 b/modules/subdyn/src/SubDyn_Output.f90 index 1a5e3c38a4..e0a0b00556 100644 --- a/modules/subdyn/src/SubDyn_Output.f90 +++ b/modules/subdyn/src/SubDyn_Output.f90 @@ -28,6 +28,7 @@ MODULE SubDyn_Output ! The maximum number of output channels which can be output by the code. INTEGER(IntKi),PUBLIC, PARAMETER :: MaxOutPts = 2265 + INTEGER(IntKi), PARAMETER :: OutStrLenM1 = ChanLen - 1 PRIVATE @@ -2771,7 +2772,7 @@ MODULE SubDyn_Output - CHARACTER(10), PARAMETER :: ValidParamAry(2265) = (/ & ! This lists the names of the allowed parameters, which must be sorted alphabetically + CHARACTER(OutStrLenM1), PARAMETER :: ValidParamAry(2265) = (/ & ! This lists the names of the allowed parameters, which must be sorted alphabetically "INTFFXSS ","INTFFYSS ","INTFFZSS ","INTFMXSS ","INTFMYSS ","INTFMZSS ","INTFRAXSS", & "INTFRAYSS","INTFRAZSS","INTFRDXSS","INTFRDYSS","INTFRDZSS","INTFTAXSS","INTFTAYSS", & "INTFTAZSS","INTFTDXSS","INTFTDYSS","INTFTDZSS","M1N1FKXE ","M1N1FKYE ","M1N1FKZE ", & diff --git a/modules/subdyn/src/SubDyn_Registry.txt b/modules/subdyn/src/SubDyn_Registry.txt index b69c6c3c8a..248ce4ba22 100644 --- a/modules/subdyn/src/SubDyn_Registry.txt +++ b/modules/subdyn/src/SubDyn_Registry.txt @@ -18,8 +18,8 @@ typedef ^ InitInputType ReKi TP_RefPoint {3} - - "global position of transitio typedef ^ InitInputType ReKi SubRotateZ - - - "Rotation angle in degrees about global Z" # ============================== Define Initialization outputs here: ============================================================================================================================================ -typedef ^ InitOutputType CHARACTER(10) WriteOutputHdr {:} - - "Names of the output-to-file channels" - -typedef ^ InitOutputType CHARACTER(10) WriteOutputUnt {:} - - "Units of the output-to-file channels" - +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" - # ============================== Define Internal data types here: ============================================================================================================================================ @@ -87,7 +87,7 @@ typedef ^ ^ ReKi CMass {:}{:} - - "Concentrated mass information" typedef ^ ^ ReKi JDampings {:} - - "Damping coefficients for internal modes" typedef ^ ^ INTEGER Members {:}{:} - - "Member joints connection" typedef ^ ^ INTEGER Interf {:}{:} - - "Interface degree of freedoms" -typedef ^ ^ CHARACTER(10) SSOutList {:} - - "List of Output Channels" +typedef ^ ^ CHARACTER(ChanLen) SSOutList {:} - - "List of Output Channels" typedef ^ ^ LOGICAL OutCOSM - - - "Output Cos-matrices Flag" typedef ^ ^ LOGICAL TabDelim - - - "Generate a tab-delimited output file in OutJckF-Flag" #-------------------------- arrays and variables used in the module ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------ diff --git a/modules/subdyn/src/SubDyn_Types.f90 b/modules/subdyn/src/SubDyn_Types.f90 index bcdd051039..31efd0db7d 100644 --- a/modules/subdyn/src/SubDyn_Types.f90 +++ b/modules/subdyn/src/SubDyn_Types.f90 @@ -45,8 +45,8 @@ MODULE SubDyn_Types ! ======================= ! ========= SD_InitOutputType ======= TYPE, PUBLIC :: SD_InitOutputType - CHARACTER(10) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< Names of the output-to-file channels [-] - CHARACTER(10) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< Units of the output-to-file channels [-] + 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 [-] END TYPE SD_InitOutputType ! ======================= @@ -126,7 +126,7 @@ MODULE SubDyn_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: JDampings !< Damping coefficients for internal modes [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Members !< Member joints connection [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Interf !< Interface degree of freedoms [-] - CHARACTER(10) , DIMENSION(:), ALLOCATABLE :: SSOutList !< List of Output Channels [-] + CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: SSOutList !< List of Output Channels [-] LOGICAL :: OutCOSM !< Output Cos-matrices Flag [-] LOGICAL :: TabDelim !< Generate a tab-delimited output file in OutJckF-Flag [-] INTEGER(IntKi) :: NNode !< Total number of nodes [-] diff --git a/reg_tests/lib/fast_io.py b/reg_tests/lib/fast_io.py index 07b7d74255..c5d9ccfb99 100644 --- a/reg_tests/lib/fast_io.py +++ b/reg_tests/lib/fast_io.py @@ -86,11 +86,17 @@ def fread(fid, n, type): FileFmtID_WithTime = 1 # File identifiers used in FAST FileFmtID_WithoutTime = 2 FileFmtID_NoCompressWithoutTime = 3 - LenName = 10 # number of characters per channel name - LenUnit = 10 # number of characters per unit name + FileFmtID_ChanLen_In = 4 with open(filename, 'rb') as fid: FileID = fread(fid, 1, 'int16')[0] # FAST output file format, INT(2) + + if FileID == FileFmtID_ChanLen_In: + LenName = fread(fid, 1, 'int16')[0] # Number of characters in channel names and units + else: + LenName = 10 # default number of characters per channel name + end + NumOutChans = fread(fid, 1, 'int32')[0] # The number of output channels, INT(4) NT = fread(fid, 1, 'int32')[0] # The number of time steps, INT(4) @@ -116,7 +122,7 @@ def fread(fid, n, type): ChanUnit = [] # initialize the ChanUnit cell array for iChan in range(NumOutChans + 1): - ChanUnitASCII = fread(fid, LenUnit, 'uint8') # ChanUnit converted to numeric ASCII + ChanUnitASCII = fread(fid, LenName, 'uint8') # ChanUnit converted to numeric ASCII ChanUnit.append("".join(map(chr, ChanUnitASCII)).strip()[1:-1]) # get the channel time series From 7cfafbf8564c9e9bfb96ff4cd77c9cbcbf3b9153 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Thu, 12 Dec 2019 11:26:02 -0700 Subject: [PATCH 25/72] Sync FAST_Prog - also fix issues in new code found in debugging - WE SHOULD CHECK THAT LINEARIZATION IS OFF when using FAST.Farm, Simulink, CFD interface, and any other cases where we are modeling more than one turbine --- glue-codes/openfast/src/FAST_Prog.f90 | 35 +++++++++++++++------- modules/openfast-library/src/FAST_Subs.f90 | 4 +-- reg_tests/lib/fast_io.py | 2 +- 3 files changed, 27 insertions(+), 14 deletions(-) diff --git a/glue-codes/openfast/src/FAST_Prog.f90 b/glue-codes/openfast/src/FAST_Prog.f90 index 8e9b04ef20..f8dcde93e5 100644 --- a/glue-codes/openfast/src/FAST_Prog.f90 +++ b/glue-codes/openfast/src/FAST_Prog.f90 @@ -37,7 +37,7 @@ PROGRAM FAST ! Local parameters: REAL(DbKi), PARAMETER :: t_initial = 0.0_DbKi ! Initial time -INTEGER(IntKi), PARAMETER :: NumTurbines = 1 +INTEGER(IntKi), PARAMETER :: NumTurbines = 1 ! Note that CalcSteady linearization analysis and WrVTK_Modes should be performed with only 1 turbine ! Other/Misc variables TYPE(FAST_TurbineType) :: Turbine(NumTurbines) ! Data for each turbine instance @@ -45,25 +45,34 @@ PROGRAM FAST INTEGER(IntKi) :: i_turb ! current turbine number INTEGER(IntKi) :: n_t_global ! simulation time step, loop counter for global (FAST) simulation INTEGER(IntKi) :: ErrStat ! Error status -CHARACTER(1024) :: ErrMsg ! Error message +CHARACTER(ErrMsgLen) :: ErrMsg ! Error message ! data for restart: CHARACTER(1024) :: CheckpointRoot ! Rootname of the checkpoint file CHARACTER(20) :: FlagArg ! flag argument from command line INTEGER(IntKi) :: Restart_step ! step to start on (for restart) + !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ! determine if this is a restart from checkpoint !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ CALL NWTC_Init() ! open console for writing ProgName = 'OpenFAST' CheckpointRoot = "" - CALL CheckArgs( CheckpointRoot, ErrStat, Flag=FlagArg ) ! if ErrStat /= ErrID_None, we'll ignore and deal with the problem when we try to read the input file - + IF ( TRIM(FlagArg) == 'RESTART' ) THEN ! Restart from checkpoint file CALL FAST_RestoreFromCheckpoint_Tary(t_initial, Restart_step, Turbine, CheckpointRoot, ErrStat, ErrMsg ) - CALL CheckError( ErrStat, ErrMsg, 'during restore from checkpoint' ) + CALL CheckError( ErrStat, ErrMsg, 'during restore from checkpoint' ) + + ELSE IF ( TRIM(FlagArg) == 'VTKLIN' ) THEN ! Read checkpoint file to output linearization analysis, but don't continue time-marching + CALL FAST_RestoreForVTKModeShape_Tary(t_initial, Turbine, CheckpointRoot, ErrStat, ErrMsg ) + CALL CheckError( ErrStat, ErrMsg, 'during restore from checkpoint' ) + + ! Note that this works only when NumTurbines==1 (we don't have files for each of the turbines...) + Restart_step = Turbine(1)%p_FAST%n_TMax_m1 + 1 + CALL ExitThisProgram_T( Turbine(1), ErrID_None, .true., SkipRunTimeMsg = .TRUE. ) + ELSE Restart_step = 0 @@ -103,13 +112,13 @@ PROGRAM FAST ! Time Stepping: !............................................................................................................................... - DO n_t_global = Restart_step, Turbine(1)%p_FAST%n_TMax_m1 +TIME_STEP_LOOP: DO n_t_global = Restart_step, Turbine(1)%p_FAST%n_TMax_m1 ! bjj: we have to make sure the n_TMax_m1 and n_ChkptTime are the same for all turbines or have some different logic here ! write checkpoint file if requested - IF (mod(n_t_global, Turbine(1)%p_FAST%n_ChkptTime) == 0 .AND. Restart_step /= n_t_global) then + 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 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) @@ -123,7 +132,7 @@ PROGRAM FAST ! this takes data from n_t_global and gets values at n_t_global + 1 DO i_turb = 1,NumTurbines - + CALL FAST_Solution_T( t_initial, n_t_global, Turbine(i_turb), ErrStat, ErrMsg ) CALL CheckError( ErrStat, ErrMsg ) @@ -133,12 +142,16 @@ 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 END DO - - - END DO ! n_t_global + 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 + CALL CheckError( ErrID_Fatal, "Unable to find steady-state solution." ) + end if + END DO !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ! Write simulation times and stop diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 794e1a1aba..9a5009855b 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -267,7 +267,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, 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, ED%Output, and ED%InputTimes.",ErrStat,ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal,"Error allocating ED%Input and ED%InputTimes.",ErrStat,ErrMsg,RoutineName) CALL Cleanup() RETURN END IF @@ -3186,7 +3186,7 @@ SUBROUTINE SetVTKParameters(p_FAST, InitOutData_ED, InitOutData_AD, InitInData_H end if ! determine number of blades - NumBl = SIZE(ED%Output(1)%BladeRootMotion,1) + NumBl = InitOutData_ED%NumBl ! initialize the vtk data diff --git a/reg_tests/lib/fast_io.py b/reg_tests/lib/fast_io.py index c5d9ccfb99..c730f99373 100644 --- a/reg_tests/lib/fast_io.py +++ b/reg_tests/lib/fast_io.py @@ -95,7 +95,7 @@ def fread(fid, n, type): LenName = fread(fid, 1, 'int16')[0] # Number of characters in channel names and units else: LenName = 10 # default number of characters per channel name - end + NumOutChans = fread(fid, 1, 'int32')[0] # The number of output channels, INT(4) NT = fread(fid, 1, 'int32')[0] # The number of time steps, INT(4) From b6cf2d3d2107c9c7c557679eac454ba062276e6d Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Mon, 16 Dec 2019 13:58:39 -0700 Subject: [PATCH 26/72] regression test plots: fix syntax I was tired of seeing warnings about the deprecated "legend" keyword --- reg_tests/lib/errorPlotting.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/lib/errorPlotting.py b/reg_tests/lib/errorPlotting.py index 45e375efff..e4b2f77ad1 100644 --- a/reg_tests/lib/errorPlotting.py +++ b/reg_tests/lib/errorPlotting.py @@ -56,7 +56,7 @@ def _plotError(xseries, y1series, y2series, xlabel, title1, title2): p1.title.align = 'center' p1.grid.grid_line_alpha=0.3 p1.xaxis.axis_label = 'Time (s)' - p1.line(xseries, y1series, color='green', line_width=3, legend='Baseline') + p1.line(xseries, y1series, color='green', line_width=3, legend_label='Baseline') p1.line(xseries, y2series, color='red', line_width=1, legend_label='Local') p1.add_tools(HoverTool(tooltips=[('Time','$x'), ('Value', '$y')],mode='vline')) From 81c370f7ce898406df8e613c5125a4b292e845ab Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Tue, 17 Dec 2019 09:19:35 -0700 Subject: [PATCH 27/72] Add AllBldNdOuts for ElastoDyn also make nodal outputs for AD and BD allow 3 digits in the node number --- .../aerodyn/src/AeroDyn_AllBldNdOuts_IO.f90 | 12 +- modules/beamdyn/src/BeamDyn_BldNdOuts_IO.f90 | 14 +- modules/elastodyn/CMakeLists.txt | 1 + modules/elastodyn/src/ElastoDyn.f90 | 55 +- .../src/ElastoDyn_AllBldNdOuts_IO.f90 | 663 ++++++++++++++++++ modules/elastodyn/src/ElastoDyn_IO.f90 | 67 +- modules/elastodyn/src/ElastoDyn_Registry.txt | 13 + modules/elastodyn/src/ElastoDyn_Types.f90 | 247 +++++++ 8 files changed, 1049 insertions(+), 23 deletions(-) create mode 100644 modules/elastodyn/src/ElastoDyn_AllBldNdOuts_IO.f90 diff --git a/modules/aerodyn/src/AeroDyn_AllBldNdOuts_IO.f90 b/modules/aerodyn/src/AeroDyn_AllBldNdOuts_IO.f90 index 4d3d66300b..c374f9fbf3 100644 --- a/modules/aerodyn/src/AeroDyn_AllBldNdOuts_IO.f90 +++ b/modules/aerodyn/src/AeroDyn_AllBldNdOuts_IO.f90 @@ -19,7 +19,7 @@ MODULE AeroDyn_AllBldNdOuts_IO ! Parameters related to output length (number of characters allowed in the output data headers): - INTEGER(IntKi), PARAMETER :: OutStrLenM1 = ChanLen - 5 ! The NREL allowed channel name length is usually 10. We are making these of the form B#N##namesuffix + INTEGER(IntKi), PARAMETER :: OutStrLenM1 = ChanLen - 6 ! The NREL allowed channel name length is usually 20. We are making these of the form B#N##namesuffix ! =================================================================================================== @@ -102,8 +102,8 @@ SUBROUTINE AllBldNdOuts_InitOut( InitOut, p, InputFileData, ErrStat, ErrMsg ) INTEGER(IntKi) :: IdxBlade ! Counter to which blade we are on INTEGER(IntKi) :: IdxNode ! Counter to the blade node we ae on INTEGER(IntKi) :: IdxChan ! Counter to the channel we are outputting. - CHARACTER(16) :: ChanPrefix ! Name prefix (AeroB#_Z######y_) - CHARACTER(6) :: TmpChar ! Temporary char array to hold the node digits (2 places only!!!!) + CHARACTER(16) :: ChanPrefix ! Name prefix (B#N###) + CHARACTER(6) :: TmpChar ! Temporary char array to hold the node digits (3 places only!!!!) CHARACTER(*), PARAMETER :: RoutineName = ('AllBldNdOuts_InitOut') @@ -113,8 +113,8 @@ SUBROUTINE AllBldNdOuts_InitOut( InitOut, p, InputFileData, ErrStat, ErrMsg ) ! Warn if we will run into issues with more than 99 nodes. - IF (p%NumBlNds > 99 ) CALL SetErrStat(ErrID_Severe,'More than 99 blade nodes in use. Output channel headers will not '// & - 'correctly reflect blade stations beyond 99. Modifications to the variable ChanLen in FAST are required.',ErrStat,ErrMsg,RoutineName) + IF (p%NumBlNds > 999 ) CALL SetErrStat(ErrID_Severe,'More than 999 blade nodes in use. Output channel headers will not '// & + 'correctly reflect blade stations beyond 999. Modifications to the variable ChanLen in FAST are required.',ErrStat,ErrMsg,RoutineName) ! Populate the header an unit lines for all blades and nodes @@ -127,7 +127,7 @@ SUBROUTINE AllBldNdOuts_InitOut( InitOut, p, InputFileData, ErrStat, ErrMsg ) DO IdxNode=1,p%NumBlNds ! Create the name prefix: - WRITE (TmpChar,'(I2.2)') IdxNode ! 2 digit number + WRITE (TmpChar,'(I3.3)') IdxNode ! 3 digit number ChanPrefix = 'B' // TRIM(Num2LStr(IdxBlade)) // 'N' // TRIM(TmpChar) ! // '_' ! Now write to the header InitOut%WriteOutputHdr(INDX) = trim(ChanPrefix) // p%BldNd_OutParam(IdxChan)%Name diff --git a/modules/beamdyn/src/BeamDyn_BldNdOuts_IO.f90 b/modules/beamdyn/src/BeamDyn_BldNdOuts_IO.f90 index 94dd3d0bca..0eb1c40681 100644 --- a/modules/beamdyn/src/BeamDyn_BldNdOuts_IO.f90 +++ b/modules/beamdyn/src/BeamDyn_BldNdOuts_IO.f90 @@ -27,7 +27,7 @@ MODULE BeamDyn_BldNdOuts_IO ! Parameters related to output length (number of characters allowed in the output data headers): - INTEGER(IntKi), PARAMETER :: OutStrLenM1 = ChanLen-5 ! We are making these of the form B1_Z######y_quantity, but note that the glue code adds the "B1_" (turbine component) part + INTEGER(IntKi), PARAMETER :: OutStrLenM1 = ChanLen-6 ! We are making these of the form B1Z###quantity, but note that the glue code adds the "B1" (turbine component) part ! =================================================================================================== ! NOTE: The following lines of code were generated by a Matlab script called "Write_ChckOutLst.m" @@ -211,8 +211,8 @@ SUBROUTINE BldNdOuts_InitOut( InitOut, p, ErrStat, ErrMsg ) INTEGER(IntKi) :: IdxNode ! Counter to the blade node we ae on INTEGER(IntKi) :: IdxChan ! Counter to the channel we are outputting. CHARACTER(1) :: ChanPrefix ! Name prefix (B#_ -- note that the B# part is added in FAST, not here) - CHARACTER(3), ALLOCATABLE :: DistStr(:) ! Array of prefix (Z######y) - CHARACTER(2) :: TmpChar ! Temporary char array to hold the node digits (2 places only!!!!) + CHARACTER(4), ALLOCATABLE :: DistStr(:) ! Array of prefix (Z######y) + CHARACTER(3) :: TmpChar ! Temporary char array to hold the node digits (3 places only!!!!) CHARACTER(*), PARAMETER :: RoutineName = ('BldNdOuts_InitOut') @@ -232,13 +232,13 @@ SUBROUTINE BldNdOuts_InitOut( InitOut, p, ErrStat, ErrMsg ) return END IF - ! Warn if we will run into issues with more than 999999 nodes. - IF (p%node_total > 99 ) CALL SetErrStat(ErrID_Severe,'More than 99 blade nodes in use. Output channel headers will not '// & - 'correctly reflect blade stations beyond 99. Modifications to the variable ChanLen in FAST are required.',ErrStat,ErrMsg,RoutineName) + ! Warn if we will run into issues with more than 999 nodes. + IF (p%node_total > 999 ) CALL SetErrStat(ErrID_Severe,'More than 999 blade nodes in use. Output channel headers will not '// & + 'correctly reflect blade stations beyond 999. Modifications to the variable ChanLen in FAST are required.',ErrStat,ErrMsg,RoutineName) DO IdxNode=1,size(p%BldNd_BlOutNd) ! Create the name prefix: - WRITE (TmpChar,'(I2.2)') IdxNode + WRITE (TmpChar,'(I3.3)') IdxNode DistStr(IdxNode) = 'N' // TmpChar END DO diff --git a/modules/elastodyn/CMakeLists.txt b/modules/elastodyn/CMakeLists.txt index 8571acf72b..5610748e9c 100644 --- a/modules/elastodyn/CMakeLists.txt +++ b/modules/elastodyn/CMakeLists.txt @@ -21,6 +21,7 @@ endif() set(ED_SOURCES src/ElastoDyn.f90 src/ElastoDyn_IO.f90 + src/ElastoDyn_AllBldNdOuts_IO.f90 src/ED_UserSubs.f90 src/ElastoDyn_Types.f90 ) diff --git a/modules/elastodyn/src/ElastoDyn.f90 b/modules/elastodyn/src/ElastoDyn.f90 index 30bb724ebd..82f0d29546 100644 --- a/modules/elastodyn/src/ElastoDyn.f90 +++ b/modules/elastodyn/src/ElastoDyn.f90 @@ -28,6 +28,8 @@ MODULE ElastoDyn USE ED_UserSubs ! <- module not in the FAST Framework! + USE ElastoDyn_AllBldNdOuts_IO + IMPLICIT NONE PRIVATE @@ -214,10 +216,11 @@ SUBROUTINE ED_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut !............................................................................................ ! Define initialization-routine output here: !............................................................................................ - CALL AllocAry( InitOut%WriteOutputHdr, p%NumOuts, 'WriteOutputHdr', ErrStat2, ErrMsg2 ) + CALL AllocAry( InitOut%WriteOutputHdr, p%numOuts + p%BldNd_TotNumOuts, 'WriteOutputHdr', errStat2, errMsg2 ) CALL CheckError( ErrStat2, ErrMsg2 ) IF (ErrStat >= AbortErrLev) RETURN - CALL AllocAry( InitOut%WriteOutputUnt, p%NumOuts, 'WriteOutputUnt', ErrStat2, ErrMsg2 ) + + CALL AllocAry( InitOut%WriteOutputUnt, p%numOuts + p%BldNd_TotNumOuts, 'WriteOutputUnt', errStat2, errMsg2 ) CALL CheckError( ErrStat2, ErrMsg2 ) IF (ErrStat >= AbortErrLev) RETURN @@ -225,6 +228,11 @@ SUBROUTINE ED_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut InitOut%WriteOutputHdr(i) = p%OutParam(i)%Name InitOut%WriteOutputUnt(i) = p%OutParam(i)%Units end do + + ! Set the info in WriteOutputHdr and WriteOutputUnt + CALL AllBldNdOuts_InitOut( InitOut, p, ErrStat2, ErrMsg2 ) + CALL CheckError( ErrStat2, ErrMsg2 ) + IF (ErrStat >= AbortErrLev) RETURN InitOut%Ver = ED_Ver InitOut%NumBl = p%NumBl @@ -1289,7 +1297,15 @@ SUBROUTINE ED_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) ENDDO ! I - All selected output channels - + IF ( .NOT. p%BD4Blades ) THEN + y%WriteOutput(p%NumOuts+1:) = 0.0_ReKi + + ! Now we need to populate the blade node outputs here + call Calc_WriteAllBldNdOutput( p, u, m, y, LinAccES, ErrStat2, ErrMsg2 ) ! Call after normal writeoutput. Will just postpend data on here. + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'ED_CalcOutput') + ENDIF + + !............................................................................................................................... ! Outputs required for AeroDyn !............................................................................................................................... @@ -2008,8 +2024,12 @@ SUBROUTINE ED_SetParameters( InputFileData, p, ErrStat, ErrMsg ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN + CALL AllBldNdOuts_SetParameters( p, InputFileData, ErrStat2, ErrMsg2 ) + CALL CheckError( ErrStat2, ErrMsg2 ) + IF ( ErrStat >= AbortErrLev ) RETURN + !p%BldNd_NumOuts = 0_IntKi + !p%BldNd_TotNumOuts = 0_IntKi - CONTAINS !............................................................................................................................... SUBROUTINE CheckError(ErrID,Msg) @@ -8577,7 +8597,7 @@ SUBROUTINE ED_AllocOutput( p, m, u, y, ErrStat, ErrMsg ) ErrMsg = "" - CALL AllocAry( y%WriteOutput, p%NumOuts, 'WriteOutput', ErrStat2, ErrMsg2 ) + CALL AllocAry( y%WriteOutput, p%numOuts + p%BldNd_TotNumOuts, 'WriteOutput', errStat2, errMsg2 ) CALL CheckError( ErrStat2, ErrMsg2 ) IF (ErrStat >= AbortErrLev) RETURN @@ -10249,6 +10269,19 @@ SUBROUTINE ED_PrintSum( p, OtherState, GenerateAdamsModel, ErrStat, ErrMsg ) WRITE (UnSu,OutPFmt) I, p%OutParam(I)%Name, p%OutParam(I)%Units END DO + IF (.not. p%BD4Blades) THEN + WRITE (UnSu,'(2x,A)') + WRITE (UnSu,'(2x,A)') + WRITE (UnSu,'(2x,A)') 'Requested Output Channels at each blade station:' + WRITE (UnSu,OutPFmtS) "Col", TitleStr + WRITE (UnSu,OutPFmtS) "---", TitleStrLines + !WRITE (UnSu,'(2x,A)') 'Col Parameter Units' + !WRITE (UnSu,'(2x,A)') '---- -------------- ----------' + DO I = 1,p%BldNd_NumOuts + WRITE (UnSu,OutPFmt) I, p%BldNd_OutParam(I)%Name, p%BldNd_OutParam(I)%Units + END DO + ENDIF + CLOSE(UnSu) RETURN @@ -11074,7 +11107,7 @@ SUBROUTINE ED_Init_Jacobian_y( p, y, InitOut, ErrStat, ErrMsg) + 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 ! WriteOutput values + + p%NumOuts + p%BldNd_TotNumOuts ! WriteOutput values do i=1,p%NumBl p%Jac_ny = p%Jac_ny + y%BladeRootMotion(i)%NNodes * 18 ! 3 TranslationDisp, Orientation, TranslationVel, RotationVel, TranslationAcc, and RotationAcc at each (1) node on each blade @@ -11118,7 +11151,7 @@ SUBROUTINE ED_Init_Jacobian_y( p, y, InitOut, ErrStat, ErrMsg) 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 + 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 @@ -11179,6 +11212,10 @@ SUBROUTINE ED_Init_Jacobian_y( p, y, InitOut, ErrStat, ErrMsg) 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) @@ -11626,7 +11663,7 @@ SUBROUTINE Compute_dY(p, y_p, y_m, delta, dY) 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 + do k=1,p%NumOuts + p%BldNd_TotNumOuts dY(k+indx_first-1) = y_p%WriteOutput(k) - y_m%WriteOutput(k) end do @@ -11766,7 +11803,7 @@ SUBROUTINE ED_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op(index) = y%YawRate ; index = index + 1 y_op(index) = y%HSS_Spd - do i=1,p%NumOuts + do i=1,p%NumOuts + p%BldNd_TotNumOuts y_op(i+index) = y%WriteOutput(i) end do diff --git a/modules/elastodyn/src/ElastoDyn_AllBldNdOuts_IO.f90 b/modules/elastodyn/src/ElastoDyn_AllBldNdOuts_IO.f90 new file mode 100644 index 0000000000..a8c6608399 --- /dev/null +++ b/modules/elastodyn/src/ElastoDyn_AllBldNdOuts_IO.f90 @@ -0,0 +1,663 @@ +! This module is an add on to ElastoDyn to allow output of blade structural data at each blade node when BeamDyn is not used +! +! Copyright 2016 Envision Energy +! + +MODULE ElastoDyn_AllBldNdOuts_IO + + USE NWTC_Library + USE ElastoDyn_Types + + IMPLICIT NONE + + PRIVATE + + + PUBLIC :: AllBldNdOuts_InitOut + PUBLIC :: Calc_WriteAllBldNdOutput + PUBLIC :: AllBldNdOuts_SetParameters + + + ! Parameters related to output length (number of characters allowed in the output data headers): + + INTEGER(IntKi), PARAMETER :: OutStrLenM1 = ChanLen-6 ! The NREL allowed channel name length is usually 20. We are making these of the form B#N###namesuffix + + +! =================================================================================================== +! NOTE: The following lines of code were generated by a Matlab script called "Write_ChckOutLst.m" +! using the parameters listed in the "OutListParameters.xlsx" Excel file. Any changes to these +! lines should be modified in the Matlab script and/or Excel worksheet as necessary. +! =================================================================================================== +! This code was generated by Write_ChckOutLst.m at 14-Dec-2017 10:34:30. + + + ! Indices for computing output channels: + ! NOTES: + ! (1) These parameters are in the order stored in "OutListParameters.xlsx" + ! (2) Array AllOuts() must be dimensioned to the value of the largest output parameter + + + ! Local Span Motions: + + INTEGER(IntKi), PARAMETER :: BldNd_ALx = 1 + INTEGER(IntKi), PARAMETER :: BldNd_ALy = 2 + INTEGER(IntKi), PARAMETER :: BldNd_ALz = 3 + INTEGER(IntKi), PARAMETER :: BldNd_TDx = 4 + INTEGER(IntKi), PARAMETER :: BldNd_TDy = 5 + INTEGER(IntKi), PARAMETER :: BldNd_TDz = 6 + INTEGER(IntKi), PARAMETER :: BldNd_RDx = 7 + INTEGER(IntKi), PARAMETER :: BldNd_RDy = 8 + INTEGER(IntKi), PARAMETER :: BldNd_RDz = 9 + + + ! Local Span Loads: + + INTEGER(IntKi), PARAMETER :: BldNd_MLx = 10 + INTEGER(IntKi), PARAMETER :: BldNd_MLy = 11 + INTEGER(IntKi), PARAMETER :: BldNd_MLz = 12 + INTEGER(IntKi), PARAMETER :: BldNd_FLx = 13 + INTEGER(IntKi), PARAMETER :: BldNd_FLy = 14 + INTEGER(IntKi), PARAMETER :: BldNd_FLz = 15 + INTEGER(IntKi), PARAMETER :: BldNd_MLxNT = 16 + INTEGER(IntKi), PARAMETER :: BldNd_MlyNT = 17 + INTEGER(IntKi), PARAMETER :: BldNd_FLxNT = 18 + INTEGER(IntKi), PARAMETER :: BldNd_FlyNT = 19 + + + ! The maximum number of output channels which can be output by the code. + INTEGER(IntKi), PARAMETER, PUBLIC :: BldNd_MaxOutPts = 19 + +!End of code generated by Matlab script +! =================================================================================================== + + +CONTAINS +!---------------------------------------------------------------------------------------------------------------------------------- + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This subroutine populates the headers with the blade node outputs. The iteration cycle is blade:node:channel (channel iterated +!! fastest). If this iteration order is changed, it should be changed in the Calc_WriteAllBldNdOutput routine as well. +SUBROUTINE AllBldNdOuts_InitOut( InitOut, p, ErrStat, ErrMsg ) + + + TYPE(ED_InitOutputType), INTENT(INOUT) :: InitOut ! output data + TYPE(ED_ParameterType), INTENT(IN ) :: p ! The module parameters + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! The error status code + CHARACTER(*), INTENT( OUT) :: ErrMsg ! The error message, if an error occurred + + INTEGER(IntKi) :: INDX ! Index count within WriteOutput + INTEGER(IntKi) :: IdxBlade ! Counter to which blade we are on + INTEGER(IntKi) :: IdxNode ! Counter to the blade node we ae on + INTEGER(IntKi) :: IdxChan ! Counter to the channel we are outputting. + CHARACTER(62) :: ChanPrefix ! Name prefix (B#N###) + CHARACTER(6) :: TmpChar ! Temporary char array to hold the node digits (3 places only!!!!) + CHARACTER(*), PARAMETER :: RoutineName = ('AllBldNdOuts_InitOut') + + + ! Initialize some things + ErrMsg = '' + ErrStat = ErrID_None + + ! First set a counter so we know where in the output array we are in + INDX = p%NumOuts + 1 ! p%NumOuts is the number of outputs from the normal ElastoDyn output. The WriteOutput array is sized to p%NumOuts + num(AllBldNdOuts) + + ! Populate the header and unit lines for all blades and nodes +#ifndef OUTPUT_CHANNEL_NAMES_AS_DISTANCE + ! ! Warn if we will run into issues with more than 999 nodes. + IF (p%BldNodes > 999 ) CALL SetErrStat(ErrID_Severe,'More than 999 blade nodes in use. Output channel headers will not '// & + 'correctly reflect blade stations beyond 999. Modifications to the variable ChanLen in FAST are required.',ErrStat,ErrMsg,RoutineName) + + ! Populate the header an unit lines for all blades and nodes + ! Loop through all the outputs we requested here: + DO IdxChan=1,p%BldNd_NumOuts + + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + + ! 3 digit node number + WRITE (TmpChar,'(I3.3)') IdxNode + ChanPrefix = 'B' // TRIM(Num2LStr(IdxBlade)) // 'N' // TRIM(TmpChar) + + ! Now write to the header + InitOut%WriteOutputHdr(INDX) = TRIM(ChanPrefix) // TRIM(p%BldNd_OutParam(IdxChan)%Name) + InitOut%WriteOutputUnt(INDX) = p%BldNd_OutParam(IdxChan)%Units + + ! Increment the index to the Header arrays + INDX = INDX + 1 + ENDDO + + END DO + END DO + +#else + ! output format the name of the channel with the distance in cm from the root of the blade instead of by node number. + + ! Loop through all the outputs we requested here: + DO IdxChan=1,p%BldNd_NumOuts + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + + ! Node defined by distance along blade + WRITE (TmpChar,'(I6.6)') NINT( 1000.0_ReKi * p%RNodes( IdxNode ) ) + ChanPrefix = 'B' // TRIM(Num2LStr(IdxBlade)) // '_Z' // TRIM(TmpChar) //'_' + + + ! Now write to the header + InitOut%WriteOutputHdr(INDX) = TRIM(ChanPrefix) // TRIM(p%BldNd_OutParam(IdxChan)%Name) + InitOut%WriteOutputUnt(INDX) = p%BldNd_OutParam(IdxChan)%Units + + ! Increment the index to the Header arrays + INDX = INDX + 1 + ENDDO + + ENDDO + ENDDO + +#endif + + +END SUBROUTINE AllBldNdOuts_InitOut + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This subroutine populates the headers with the blade node outputs. The iteration cycle is blade:node:channel (channel iterated +!! fastest). If this iteration order is changed, it should be changed in the Calc_WriteAllBldNdOutput routine as well. +SUBROUTINE Calc_WriteAllBldNdOutput( p, u, m, y, LinAccES, ErrStat, ErrMsg ) + TYPE(ED_ParameterType), INTENT(IN ) :: p ! The module parameters + TYPE(ED_InputType), INTENT(IN ) :: u ! inputs + TYPE(ED_MiscVarType), INTENT(INOUT) :: m ! misc variables + TYPE(ED_OutputType), INTENT(INOUT) :: y ! outputs + REAL(ReKi), INTENT(IN ) :: LinAccES(:,0:,:) ! Total linear acceleration of a point on a blade (point S) in the inertia frame (body E for earth). NOTE: zero index start. + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! The error status code + CHARACTER(*), INTENT( OUT) :: ErrMsg ! The error message, if an error occurred + + ! local variables + + INTEGER(IntKi) :: OutIdx ! Index count within WriteOutput + INTEGER(IntKi) :: IdxBlade ! Counter to which blade we are on + INTEGER(IntKi) :: IdxNode ! Counter to the blade node we ae on + INTEGER(IntKi) :: J ! Generic counter for moment and force summation + INTEGER(IntKi) :: IdxChan ! Counter to the channel we are outputting. + CHARACTER(5) :: ChanPrefix ! Name prefix ( B#N### or B#D#### ) + CHARACTER(2) :: TmpChar ! Temporary char array to hold the node digits (2 places only!!!!) + CHARACTER(*), PARAMETER :: RoutineName = 'Calc_WriteAllBldNdOutput' +! REAL(ReKi) :: ct, st ! cosine, sine of theta +! REAL(ReKi) :: cp, sp ! cosine, sine of phi +! REAL(ReKi) :: Tmp(3) + REAL(ReKi) :: OutVal ! Temporary variable to hold the value to output to the channel. + + ! Variables used in the CalcOutput routine that are needed here for coordinate transforms + REAL(R8Ki) :: rSPS (3) ! Position vector from the undeflected blade node (point S prime) to the deflected node (point S) + REAL(R8Ki) :: TmpVec (3) ! A temporary vector used in various computations. + REAL(R8Ki) :: TmpVec2 (3) ! A temporary vector. + + + ! Initialize some things + ErrMsg = '' + ErrStat = ErrID_None + + + ! Populate the header an unit lines for all blades and nodes + ! First set a counter so we know where in the output array we are in + OutIdx = p%NumOuts + 1 ! p%NumOuts is the number of outputs from the normal ElastoDyn output. The WriteOutput array is sized to p%NumOuts + num(AllBldNdOuts) + + ! Loop through all the outputs we requested here: + DO IdxChan=1,p%BldNd_NumOuts + + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (0) ! Invalid channel + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + y%WriteOutput( OutIdx ) = 0.0_ReKi + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_ALx ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + y%WriteOutput( OutIdx ) = DOT_PRODUCT( LinAccES(:,IdxNode,IdxBlade), m%CoordSys%n1(IdxBlade,IdxNode,:) ) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_ALy ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + y%WriteOutput( OutIdx ) = DOT_PRODUCT( LinAccES(:,IdxNode,IdxBlade), m%CoordSys%n2(IdxBlade,IdxNode,:) ) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_ALz ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + y%WriteOutput( OutIdx ) = DOT_PRODUCT( LinAccES(:,IdxNode,IdxBlade), m%CoordSys%n3(IdxBlade,IdxNode,:) ) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_TDx ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + rSPS = m%RtHS%rS0S(:,IdxBlade,IdxNode) - p%RNodes(IdxNode)*m%CoordSys%j3(IdxBlade,:) + y%WriteOutput( OutIdx ) = DOT_PRODUCT( rSPS, m%CoordSys%j1(IdxBlade,:) ) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_TDy ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + rSPS = m%RtHS%rS0S(:,IdxBlade,IdxNode) - p%RNodes(IdxNode)*m%CoordSys%j3(IdxBlade,:) + y%WriteOutput( OutIdx ) = DOT_PRODUCT( rSPS, m%CoordSys%j2(IdxBlade,:) ) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_TDz ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + rSPS = m%RtHS%rS0S(:,IdxBlade,IdxNode) - p%RNodes(IdxNode)*m%CoordSys%j3(IdxBlade,:) + y%WriteOutput( OutIdx ) = DOT_PRODUCT( rSPS, m%CoordSys%j3(IdxBlade,:) ) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_RDx ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + y%WriteOutput( OutIdx ) = DOT_PRODUCT( m%RtHS%AngPosHM(:,IdxBlade,IdxNode), m%CoordSys%j1(IdxBlade,:) )*R2D + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_RDy ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + y%WriteOutput( OutIdx ) = DOT_PRODUCT( m%RtHS%AngPosHM(:,IdxBlade,IdxNode), m%CoordSys%j2(IdxBlade,:) )*R2D + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_RDz ) ! See note in ElastoDyn.f90 + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + ! y%WriteOutput( OutIdx ) = DOT_PRODUCT( m%RtHS%AngPosHM(:,IdxBlade,IdxNode), m%CoordSys%j3(IdxBlade,:) )*R2D ! this is always zero for FAST + y%WriteOutput( OutIdx ) = 0.0_Reki + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_FLx ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + y%WriteOutput( OutIdx ) = DOT_PRODUCT( FrcMGagB(), m%CoordSys%n1(IdxBlade,IdxNode,:) ) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_FLy ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + y%WriteOutput( OutIdx ) = DOT_PRODUCT( FrcMGagB(), m%CoordSys%n2(IdxBlade,IdxNode,:) ) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_FLz ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + y%WriteOutput( OutIdx ) = DOT_PRODUCT( FrcMGagB(), m%CoordSys%n3(IdxBlade,IdxNode,:) ) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_MLx ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + y%WriteOutput( OutIdx ) = DOT_PRODUCT( MomMGagB(), m%CoordSys%n1(IdxBlade,IdxNode,:) ) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_MLy ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + y%WriteOutput( OutIdx ) = DOT_PRODUCT( MomMGagB(), m%CoordSys%n2(IdxBlade,IdxNode,:) ) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_MLz ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + y%WriteOutput( OutIdx ) = DOT_PRODUCT( MomMGagB(), m%CoordSys%n3(IdxBlade,IdxNode,:) ) + OutIdx = OutIdx + 1 + END DO + END DO + + ! Output blade loads in the blade coordinate system. + CASE ( BldNd_FLxNT ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + y%WriteOutput( OutIdx ) = DOT_PRODUCT( FrcMGagB(), CoordSysNT1() ) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_FLyNT ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + y%WriteOutput( OutIdx ) = DOT_PRODUCT( FrcMGagB(), CoordSysNT2() ) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_MLxNT ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + y%WriteOutput( OutIdx ) = DOT_PRODUCT( MomMGagB(), CoordSysNT1() ) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_MLyNT ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + y%WriteOutput( OutIdx ) = DOT_PRODUCT( MomMGagB(), CoordSysNT2() ) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE DEFAULT + CALL SetErrStat( ErrID_Severe, "Coding error. Output channel not properly set.",ErrStat,ErrMsg,RoutineName ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + y%WriteOutput( OutIdx ) = 0.0_ReKi + OutIdx = OutIdx + 1 + END DO + END DO + + END SELECT + END DO + +contains +function CoordSysNT1() + REAL(ReKi) :: CoordSysNT1 (3) ! A temporary matrix for removing the structural twist from the local output forces and moments, dimension 1 + ! removed + CoordSysNT1(:) = p%CThetaS(IdxBlade,IdxNode)*m%CoordSys%n1(IdxBlade,IdxNode,:) + p%SThetaS(IdxBlade,IdxNode)*m%CoordSys%n2(IdxBlade,IdxNode,:) + +end function CoordSysNT1 + +function CoordSysNT2() + REAL(ReKi) :: CoordSysNT2 (3) ! A temporary matrix for removing the structural twist from the local output forces and moments, dimension 2 + + CoordSysNT2(:) = -p%SThetaS(IdxBlade,IdxNode)*m%CoordSys%n1(IdxBlade,IdxNode,:) + p%CThetaS(IdxBlade,IdxNode)*m%CoordSys%n2(IdxBlade,IdxNode,:) + +end function CoordSysNT2 + + +function FrcMGagB() + REAL(R8Ki) :: FrcMGagB (3) ! Total force at the blade element (body M) / blade strain gage location (point S) due to the blade above the strain gage. + + ! Initialize FrcMGagB using the tip brake effects: + + FrcMGagB = m%RtHS%FSTipDrag(:,IdxBlade) - p%TipMass(IdxBlade)*( p%Gravity*m%CoordSys%z2 + LinAccES(:,p%TipNode,IdxBlade) ) + + ! Integrate to find FrcMGagB and MomMGagB using all of the nodes / elements above the current strain gage location: + DO J = ( IdxNode + 1 ),p%BldNodes ! Loop through blade nodes / elements above strain gage node + + TmpVec2 = m%RtHS%FSAero(:,IdxBlade,J) - p%MassB(IdxBlade,J)*( p%Gravity*m%CoordSys%z2 + LinAccES(:,J,IdxBlade) ) ! Portion of FrcMGagB associated with element J + FrcMGagB = FrcMGagB + TmpVec2*p%DRNodes(J) + + ENDDO ! J - Blade nodes / elements above strain gage node + + ! Add the effects of 1/2 the strain gage element: + ! NOTE: for the radius in this calculation, assume that there is no + ! shortening effect (due to blade bending) within the element. Thus, + ! the moment arm for the force is 1/4 of p%DRNodes() and the element + ! length is 1/2 of p%DRNodes(). + + TmpVec2 = m%RtHS%FSAero(:,IdxBlade,IdxNode) - p%MassB(IdxBlade,IdxNode)* ( p%Gravity*m%CoordSys%z2 + LinAccES(:,IdxNode,IdxBlade) ) ! Portion of FrcMGagB associated with 1/2 of the strain gage element + FrcMGagB = FrcMGagB + TmpVec2 * 0.5 * p%DRNodes(IdxNode) ! Portion of FrcMGagB associated with 1/2 of the strain gage element + FrcMGagB = 0.001*FrcMGagB ! Convert the local force to kN + +end function FrcMGagB + +function MomMGagB() + REAL(ReKi) :: MomMGagB (3) ! Total moment at the blade element (body M) / blade strain gage location (point S) due to the blade above the strain gage. + + ! Initialize MomMGagB using the tip brake effects: + + TmpVec2 = m%RtHS%FSTipDrag(:,IdxBlade) - p%TipMass(IdxBlade)*( p%Gravity*m%CoordSys%z2 + LinAccES(:,p%TipNode,IdxBlade) ) ! Portion of FrcMGagB + MomMGagB = CROSS_PRODUCT( m%RtHS%rS0S(:,IdxBlade,p%TipNode) - m%RtHS%rS0S(:,IdxBlade,IdxNode), TmpVec2 ) + + ! Integrate to find FrcMGagB and MomMGagB using all of the nodes / elements above the current strain gage location: + DO J = ( IdxNode + 1 ),p%BldNodes ! Loop through blade nodes / elements above strain gage node + + TmpVec2 = m%RtHS%FSAero(:,IdxBlade,J) - p%MassB(IdxBlade,J)*( p%Gravity*m%CoordSys%z2 + LinAccES(:,J,IdxBlade) ) ! Portion of FrcMGagB associated with element J + TmpVec = CROSS_PRODUCT( m%RtHS%rS0S(:,IdxBlade,J) - m%RtHS%rS0S(:,IdxBlade,IdxNode), TmpVec2 ) ! Portion of MomMGagB associated with element J + MomMGagB = MomMGagB + ( TmpVec + m%RtHS%MMAero(:,IdxBlade,J) )*p%DRNodes(J) + + ENDDO ! J - Blade nodes / elements above strain gage node + + ! Add the effects of 1/2 the strain gage element: + ! NOTE: for the radius in this calculation, assume that there is no + ! shortening effect (due to blade bending) within the element. Thus, + ! the moment arm for the force is 1/4 of p%DRNodes() and the element + ! length is 1/2 of p%DRNodes(). + + TmpVec2 = m%RtHS%FSAero(:,IdxBlade,IdxNode) - p%MassB(IdxBlade,IdxNode)* ( p%Gravity*m%CoordSys%z2 + LinAccES(:,IdxNode,IdxBlade) ) ! Portion of FrcMGagB associated with 1/2 of the strain gage element + TmpVec = CROSS_PRODUCT( ( 0.25_R8Ki*p%DRNodes(IdxNode) )*m%CoordSys%j3(IdxBlade,:), TmpVec2 ) ! Portion of MomMGagB associated with 1/2 of the strain gage element + + MomMGagB = MomMGagB + ( TmpVec + m%RtHS%MMAero(:,IdxBlade,IdxNode) )* ( 0.5 *p%DRNodes(IdxNode) ) + MomMGagB = 0.001*MomMGagB ! Convert the local moment to kN-m + +end function MomMGagB + +END SUBROUTINE Calc_WriteAllBldNdOutput + + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine validates and sets the parameters for the nodal outputs. +SUBROUTINE AllBldNdOuts_SetParameters( p, InputFileData, ErrStat, ErrMsg ) +!.................................................................................................................................. + + + ! Passed variables: + + TYPE(ED_InputFile), INTENT(IN ) :: InputFileData !< Data stored in the module's input file + TYPE(ED_ParameterType), 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) :: k ! Blade number + integer(IntKi) :: j ! node number + character(*), parameter :: RoutineName = 'AllBldNdOuts_ValidateInputData' + + ErrStat = ErrID_None + ErrMsg = "" + + ! Check if the requested blades exist + IF ( (InputFileData%BldNd_BladesOut < 0_IntKi) .OR. (InputFileData%BldNd_BladesOut > p%NumBl) ) THEN + CALL SetErrStat( ErrID_Warn, " Number of blades to output data at all bladed nodes (BldNd_BladesOut) must be between 0 and "//TRIM(Num2LStr(p%NumBl))//".", ErrStat, ErrMsg, RoutineName) + p%BldNd_BladesOut = 0_IntKi + ELSE + p%BldNd_BladesOut = InputFileData%BldNd_BladesOut + ENDIF + + + ! Check if the requested blade nodes are valid + ! InputFileData%BldNd_BlOutNd + + + + ! Set the parameter to store number of requested Blade Node output sets + IF ( p%BD4Blades .and. InputFileData%BldNd_NumOuts > 0 ) THEN + p%BldNd_NumOuts = 0_IntKi + CALL SetErrStat( ErrID_Warn,' AllBldNdOuts option not available in ElastoDyn when BeamDyn is used. Turning off these outputs.',ErrStat,ErrMsg,"SetPrimaryParameters" ) + ELSE + p%BldNd_NumOuts = InputFileData%BldNd_NumOuts + ENDIF + + ! Set the total number of outputs ( requested channel groups * number requested nodes * number requested blades ) + p%BldNd_TotNumOuts = p%BldNodes*p%BldNd_BladesOut*p%BldNd_NumOuts !p%BldNd_NumOuts * size(p%BldNd_BlOutNd) * size(p%BldNd_BladesOut) + +! ! Check if the blade node array to output is valid: p%BldNd_BlOutNd +! ! TODO: this value is not read in by the input file reading yet, so setting to all blade nodes +! ! -- check if list handed in is of nodes that exist (not sure this is ever checked) +! ! -- copy values over +! +! ! Temporary workaround here: +! ALLOCATE ( p%BldNd_BlOutNd(1:p%BldNodes) , STAT=ErrStat2 ) +! IF ( ErrStat2 /= 0_IntKi ) THEN +! CALL SetErrStat( ErrID_Fatal,"Error allocating memory for the ElastoDyn OutParam array.", ErrStat, ErrMsg, RoutineName ) +! RETURN +! ENDIF +! DO I=1,p%BldNodes ! put all nodes in the list +! p%BldNd_BlOutNd(i) = i +! ENDDO + + +! ! Check if the requested blades are actually in use: +! ! TODO: this value is not read in by the input file reading yet, so setting to all blades +! ! -- check if list handed in is of blades that exist (not sure this is ever checked) +! ! -- copy values over +! ALLOCATE ( p%BldNd_BladesOut(1:p%NumBl), STAT=ErrStat2 ) +! IF ( ErrStat2 /= 0_IntKi ) THEN +! CALL SetErrStat( ErrID_Fatal,"Error allocating memory for the ElastoDyn OutParam array.", ErrStat, ErrMsg, RoutineName ) +! RETURN +! ENDIF +! DO I=1,p%NumBl ! put all blades in the list +! p%BldNd_BladesOut(i) = i +! ENDDO + + if (p%BldNd_TotNumOuts > 0) then + call BldNdOuts_SetOutParam(InputFileData%BldNd_OutList, p, ErrStat, ErrMsg ) + if (ErrStat >= AbortErrLev) return + end if + + +END SUBROUTINE AllBldNdOuts_SetParameters + + +!********************************************************************************************************************************** +! NOTE: The following lines of code were generated by a Matlab script called "Write_ChckOutLst.m" +! using the parameters listed in the "OutListParameters.xlsx" Excel file. Any changes to these +! lines should be modified in the Matlab script and/or Excel worksheet as necessary. +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine checks to see if any requested output channel names (stored in the OutList(:)) are invalid. It returns a +!! warning if any of the channels are not available outputs from the module. +!! It assigns the settings for OutParam(:) (i.e, the index, name, and units of the output channels, WriteOutput(:)). +!! the sign is set to 0 if the channel is invalid. +!! It sets assumes the value p%NumOuts has been set before this routine has been called, and it sets the values of p%OutParam here. +!! +!! This routine was generated by Write_ChckOutLst.m using the parameters listed in OutListParameters.xlsx at 14-Dec-2017 10:34:30. +SUBROUTINE BldNdOuts_SetOutParam(BldNd_OutList, p, ErrStat, ErrMsg ) +!.................................................................................................................................. + + IMPLICIT NONE + + ! Passed variables + + CHARACTER(ChanLen), INTENT(IN) :: BldNd_OutList(:) !< The list out user-requested outputs + TYPE(ED_ParameterType), INTENT(INOUT) :: p !< The module parameters + INTEGER(IntKi), INTENT(OUT) :: ErrStat !< The error status code + CHARACTER(*), INTENT(OUT) :: ErrMsg !< The error message, if an error occurred + + ! Local variables + + INTEGER :: ErrStat2 ! temporary (local) error status + INTEGER :: I ! Generic loop-counting index + INTEGER :: J ! Generic loop-counting index + INTEGER :: INDX ! Index for valid arrays + + LOGICAL :: InvalidOutput(1:BldNd_MaxOutPts) ! This array determines if the output channel is valid for this configuration + CHARACTER(ChanLen) :: OutListTmp ! A string to temporarily hold OutList(I) + CHARACTER(*), PARAMETER :: RoutineName = "BldNdOuts_SetOutParam" + + CHARACTER(OutStrLenM1), PARAMETER :: ValidParamAry(42) = (/ & ! This lists the names of the allowed parameters, which must be sorted alphabetically + "ALX ","ALY ","ALZ ","AX ","AY ","AZ ","FLX ","FLXNT","FLY ","FLYNT", & + "FLZ ","FLZNT","FX ","FXL ","FY ","FYL ","FZ ","FZL ","MLX ","MLXNT", & + "MLY ","MLYNT","MLZ ","MLZNT","MX ","MXL ","MY ","MYL ","MZ ","MZL ", & + "RDX ","RDY ","RDZ ","RX ","RY ","RZ ","TDX ","TDY ","TDZ ","UXB ", & + "UYB ","UZB "/) + INTEGER(IntKi), PARAMETER :: ParamIndxAry(42) = (/ & ! This lists the index into AllOuts(:) of the allowed parameters ValidParamAry(:) + BldNd_ALx , BldNd_ALy , BldNd_ALz , BldNd_ALx , BldNd_ALy , BldNd_ALz , BldNd_FLx , BldNd_FLxNT , BldNd_FLy , BldNd_FlyNT , & + BldNd_FLz , BldNd_FLz , BldNd_FLx , BldNd_FLxNT , BldNd_FLy , BldNd_FlyNT , BldNd_FLz , BldNd_FLz , BldNd_MLx , BldNd_MLxNT , & + BldNd_MLy , BldNd_MlyNT , BldNd_MLz , BldNd_MLz , BldNd_MLx , BldNd_MLxNT , BldNd_MLy , BldNd_MlyNT , BldNd_MLz , BldNd_MLz , & + BldNd_RDx , BldNd_RDy , BldNd_RDz , BldNd_RDx , BldNd_RDy , BldNd_RDz , BldNd_TDx , BldNd_TDy , BldNd_TDz , BldNd_TDx , & + BldNd_TDy , BldNd_TDz /) + CHARACTER(ChanLen), PARAMETER :: ParamUnitsAry(42) = (/ & ! This lists the units corresponding to the allowed parameters + "(m/s^2)","(m/s^2)","(m/s^2)","(m/s^2)","(m/s^2)","(m/s^2)","(kN) ","(kN) ","(kN) ","(kN) ", & + "(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN-m) ","(kN-m) ", & + "(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ", & + "(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(m) ","(m) ","(m) ","(m) ", & + "(m) ","(m) "/) + + + ! Initialize values + ErrStat = ErrID_None + ErrMsg = "" + InvalidOutput = .FALSE. + + +! ..... Developer must add checking for invalid inputs here: ..... + +! ................. End of validity checking ................. + + + !------------------------------------------------------------------------------------------------- + ! Allocate and set index, name, and units for the output channels + ! If a selected output channel is not available in this module, set error flag. + !------------------------------------------------------------------------------------------------- + + ALLOCATE ( p%BldNd_OutParam(1:p%BldNd_NumOuts) , STAT=ErrStat2 ) + IF ( ErrStat2 /= 0_IntKi ) THEN + CALL SetErrStat( ErrID_Fatal,"Error allocating memory for the ElastoDyn BldNd_OutParam array.", ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + + + ! Set index, name, and units for all of the output channels. + ! If a selected output channel is not available by this module set ErrStat = ErrID_Warn. + + DO I = 1,p%BldNd_NumOuts + + p%BldNd_OutParam(I)%Name = BldNd_OutList(I) + OutListTmp = BldNd_OutList(I) + p%BldNd_OutParam(I)%SignM = 1 ! this won't be used + + CALL Conv2UC( OutListTmp ) ! Convert OutListTmp to upper case + + + Indx = IndexCharAry( OutListTmp(1:OutStrLenM1), ValidParamAry ) + + IF ( Indx > 0 ) THEN ! we found the channel name + IF ( InvalidOutput( ParamIndxAry(Indx) ) ) THEN ! but, it isn't valid for these settings + p%BldNd_OutParam(I)%Indx = 0 ! pick any valid channel (I just picked "Time=0" here because it's universal) + p%BldNd_OutParam(I)%Units = "INVALID" + p%BldNd_OutParam(I)%SignM = 0 + ELSE + p%BldNd_OutParam(I)%Indx = ParamIndxAry(Indx) + p%BldNd_OutParam(I)%Units = ParamUnitsAry(Indx) ! it's a valid output + END IF + ELSE ! this channel isn't valid + p%BldNd_OutParam(I)%Indx = 0 ! pick any valid channel (I just picked "Time=0" here because it's universal) + p%BldNd_OutParam(I)%Units = "INVALID" + p%BldNd_OutParam(I)%SignM = 0 ! multiply all results by zero + + CALL SetErrStat(ErrID_Fatal, TRIM(p%BldNd_OutParam(I)%Name)//" is not an available output channel.",ErrStat,ErrMsg,RoutineName) + END IF + + END DO + + RETURN +END SUBROUTINE BldNdOuts_SetOutParam +!---------------------------------------------------------------------------------------------------------------------------------- +!End of code generated by Matlab script +!********************************************************************************************************************************** + +END MODULE ElastoDyn_AllBldNdOuts_IO diff --git a/modules/elastodyn/src/ElastoDyn_IO.f90 b/modules/elastodyn/src/ElastoDyn_IO.f90 index 2d1018fdcc..42ba43f83b 100644 --- a/modules/elastodyn/src/ElastoDyn_IO.f90 +++ b/modules/elastodyn/src/ElastoDyn_IO.f90 @@ -26,6 +26,8 @@ MODULE ElastoDyn_Parameters USE NWTC_Library + USE ElastoDyn_AllBldNdOuts_IO + TYPE(ProgDesc), PARAMETER :: ED_Ver = ProgDesc( 'ElastoDyn', '', '' ) REAL(ReKi), PARAMETER :: SmallAngleLimit_Deg = 15.0 ! Largest input angle considered "small" (used as a check on input data), degrees @@ -3247,12 +3249,15 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, BldFile, FurlFile, TwrFile INTEGER(IntKi) :: ErrStat2 ! Temporary Error status LOGICAL :: Echo ! Determines if an echo file should be written CHARACTER(ErrMsgLen) :: ErrMsg2 ! Temporary Error message + CHARACTER(ErrMsgLen) :: ErrMsg_NoAllBldNdOuts ! Temporary Error message CHARACTER(*), PARAMETER :: RoutineName = 'ReadPrimaryFile' CHARACTER(1024) :: PriPath ! Path name of the primary file CHARACTER(1024) :: FTitle ! "File Title": the 2nd line of the input file, which contains a description of its contents CHARACTER(200) :: Line ! Temporary storage of a line from the input file (to compare with "default") - + ! Initialize some variables: + ErrStat = ErrID_None + ErrMsg = "" Echo = .FALSE. UnEc = -1 ! Echo file not opened, yet CALL GetPath( InputFile, PriPath ) ! Input files will be relative to the path where the primary input file is located. @@ -3303,6 +3308,10 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, BldFile, FurlFile, TwrFile RETURN END IF + ! Allocate array for holding the list of node outputs + CALL AllocAry( InputFileData%BldNd_OutList, BldNd_MaxOutPts, "BldNd_Outlist", ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! Read the lines up/including to the "Echo" simulation control variable ! If echo is FALSE, don't write these lines to the echo file. @@ -4320,6 +4329,62 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, BldFile, FurlFile, TwrFile RETURN END IF + + !----------- OUTLIST ----------------------------------------------------------- + ! In case there is something ill-formed in the additional nodal outputs section, we will simply ignore it and assume that it is an NREL compatable input file. + ErrMsg_NoAllBldNdOuts='AllBldNd section of ElastoDyn input file not found or improperly formatted. Therefore assuming no nodal outputs.' + + !----------- OUTLIST for BldNd ----------------------------------------------------------- + CALL ReadCom( UnIn, InputFile, 'Section Header: OutList for Blade node channels', ErrStat2, ErrMsg2, UnEc ) + IF ( ErrStat2 >= AbortErrLev ) THEN + InputFileData%BldNd_NumOuts = 0 + call wrscr( trim(ErrMsg_NoAllBldNdOuts)//' --> '//trim(ErrMsg2) ) + CALL Cleanup() + RETURN + ENDIF + + + ! Number of blade nodes to output: will modify this at some point for arrays + ! TODO: In a future release, allow this to be an array of N blade numbers (change BldNd_BladesOut to an array if we do that). + ! Will likely require reading this line in as a string (BldNd_BladesOut_Str) and parsing it + CALL ReadVar( UnIn, InputFile, InputFileData%BldNd_BladesOut, 'BldNd_BladesOut', 'Which blades to output node data on.'//TRIM(Num2Lstr(I)), ErrStat2, ErrMsg2, UnEc ) + IF ( ErrStat2 >= AbortErrLev ) THEN + InputFileData%BldNd_NumOuts = 0 + call wrscr( trim(ErrMsg_NoAllBldNdOuts)//' --> '//trim(ErrMsg2) ) + CALL Cleanup() + RETURN + ENDIF + + + ! Which blades to output for: will add this at some point + ! TODO: Parse this string into an array of nodes to output at (one idea is to set an array of boolean to T/F for which nodes to output). At present, we ignore it entirely. + CALL ReadVar( UnIn, InputFile, InputFileData%BldNd_BlOutNd_Str, 'BldNd_BlOutNd_Str', 'Which nodes to output node data on.'//TRIM(Num2Lstr(I)), ErrStat2, ErrMsg2, UnEc ) + IF ( ErrStat2 >= AbortErrLev ) THEN + InputFileData%BldNd_NumOuts = 0 + call wrscr( trim(ErrMsg_NoAllBldNdOuts)//' --> '//trim(ErrMsg2) ) + CALL Cleanup() + RETURN + ENDIF + + + ! Section header for outlist + CALL ReadCom( UnIn, InputFile, 'Section Header: OutList', ErrStat2, ErrMsg2, UnEc ) + IF ( ErrStat2 >= AbortErrLev ) THEN + InputFileData%BldNd_NumOuts = 0 + call wrscr( trim(ErrMsg_NoAllBldNdOuts)//' --> '//trim(ErrMsg2) ) + CALL Cleanup() + RETURN + ENDIF + + + ! OutList - List of user-requested output channels at each node(-): + CALL ReadOutputList ( UnIn, InputFile, InputFileData%BldNd_OutList, InputFileData%BldNd_NumOuts, 'BldNd_OutList', "List of user-requested output channels", ErrStat2, ErrMsg2, UnEc ) ! Routine in NWTC Subroutine Library + IF ( ErrStat2 >= AbortErrLev ) THEN + InputFileData%BldNd_NumOuts = 0 + call wrscr( trim(ErrMsg_NoAllBldNdOuts)//' --> '//trim(ErrMsg2) ) + CALL Cleanup() + RETURN + ENDIF !---------------------- END OF FILE ----------------------------------------- call cleanup() diff --git a/modules/elastodyn/src/ElastoDyn_Registry.txt b/modules/elastodyn/src/ElastoDyn_Registry.txt index ef2fc56d52..2fdc4e37f5 100644 --- a/modules/elastodyn/src/ElastoDyn_Registry.txt +++ b/modules/elastodyn/src/ElastoDyn_Registry.txt @@ -272,6 +272,12 @@ typedef ^ ED_InputFile ReKi TFrlUSDmp - - - "Tail-furl up-stop damping constant" typedef ^ ED_InputFile ReKi TFrlDSDmp - - - "Tail-furl down-stop damping constant" N-m/(rad/s) typedef ^ ED_InputFile IntKi method - - - "Identifier for integration method (1 [RK4], 2 [AB4], or 3 [ABM4])" - +# ..... ED_AllBldNdOuts compile option ............................................................................................ +typedef ^ ED_InputFile IntKi BldNd_NumOuts - - - "Number of requested output channels per blade node (ED_AllBldNdOuts)" - +typedef ^ ED_InputFile CHARACTER(ChanLen) BldNd_OutList {:} - - "List of user-requested output channels (ED_AllBldNdOuts)" - +#typedef ^ ED_InputFile IntKi BldNd_BlOutNd {:} - - "The blade nodes to actually output (ED_AllBldNdOuts)" - +typedef ^ ED_InputFile CHARACTER(1024) BldNd_BlOutNd_Str - - - "String to parse for the blade nodes to actually output (ED_AllBldNdOuts)" - +typedef ^ ED_InputFile IntKi BldNd_BladesOut - - - "The blades to output (ED_AllBldNdOuts)" - # ..... Internal data types ....................................................................................................... @@ -798,6 +804,13 @@ typedef ^ ParameterType ReKi PtfmCMxt - - - "Downwind distance from the ground [ typedef ^ ParameterType ReKi PtfmCMyt - - - "Lateral distance from the ground [onshore] or MSL [offshore] to the platform CM" meters typedef ^ ParameterType LOGICAL BD4Blades - - - "flag to determine if BeamDyn is computing blade loads (true) or ElastoDyn is (false)" - typedef ^ ParameterType LOGICAL UseAD14 - - - "flag to determine if AeroDyn14 is being used. Will remove this later when we've replaced AD14." - +# .... ED_AllBlNds option ........................................................................................................ +typedef ^ ParameterType IntKi BldNd_NumOuts - - - "Number of requested output channels per blade node (ED_AllBldNdOuts)" - +typedef ^ ParameterType IntKi BldNd_TotNumOuts - - - "Total number of requested output channels of blade node information (BldNd_NumOuts * BldNd_BlOutNd * BldNd_BladesOut -- ED_AllBldNdOuts)" - +typedef ^ ParameterType OutParmType BldNd_OutParam {:} - - "Names and units (and other characteristics) of all requested output parameters" - +#typedef ^ ParameterType IntKi BldNd_BlOutNd {:} - - "The blade nodes to actually output (ED_AllBldNdOuts)" - +typedef ^ ParameterType IntKi BldNd_BladesOut - - - "The blades to output (ED_AllBldNdOuts)" - + typedef ^ ParameterType Integer Jac_u_indx {:}{:} - - "matrix to help fill/pack the u vector in computing the jacobian" - typedef ^ ParameterType R8Ki du {:} - - "vector that determines size of perturbation for u (inputs)" typedef ^ ParameterType R8Ki dx {:} - - "vector that determines size of perturbation for x (continuous states)" diff --git a/modules/elastodyn/src/ElastoDyn_Types.f90 b/modules/elastodyn/src/ElastoDyn_Types.f90 index 4342da070b..bda884a9b0 100644 --- a/modules/elastodyn/src/ElastoDyn_Types.f90 +++ b/modules/elastodyn/src/ElastoDyn_Types.f90 @@ -288,6 +288,10 @@ MODULE ElastoDyn_Types REAL(ReKi) :: TFrlUSDmp !< Tail-furl up-stop damping constant [N-m/(rad/s)] REAL(ReKi) :: TFrlDSDmp !< Tail-furl down-stop damping constant [N-m/(rad/s)] INTEGER(IntKi) :: method !< Identifier for integration method (1 [RK4], 2 [AB4], or 3 [ABM4]) [-] + INTEGER(IntKi) :: BldNd_NumOuts !< Number of requested output channels per blade node (ED_AllBldNdOuts) [-] + CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: BldNd_OutList !< List of user-requested output channels (ED_AllBldNdOuts) [-] + CHARACTER(1024) :: BldNd_BlOutNd_Str !< String to parse for the blade nodes to actually output (ED_AllBldNdOuts) [-] + INTEGER(IntKi) :: BldNd_BladesOut !< The blades to output (ED_AllBldNdOuts) [-] END TYPE ED_InputFile ! ======================= ! ========= ED_CoordSys ======= @@ -802,6 +806,10 @@ MODULE ElastoDyn_Types REAL(ReKi) :: PtfmCMyt !< Lateral distance from the ground [onshore] or MSL [offshore] to the platform CM [meters] LOGICAL :: BD4Blades !< flag to determine if BeamDyn is computing blade loads (true) or ElastoDyn is (false) [-] LOGICAL :: UseAD14 !< flag to determine if AeroDyn14 is being used. Will remove this later when we've replaced AD14. [-] + INTEGER(IntKi) :: BldNd_NumOuts !< Number of requested output channels per blade node (ED_AllBldNdOuts) [-] + INTEGER(IntKi) :: BldNd_TotNumOuts !< 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 !< The blades to output (ED_AllBldNdOuts) [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_u_indx !< matrix to help fill/pack the u vector in computing the jacobian [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: du !< vector that determines size of perturbation for u (inputs) [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: dx !< vector that determines size of perturbation for x (continuous states) [-] @@ -3962,6 +3970,21 @@ SUBROUTINE ED_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrSt DstInputFileData%TFrlUSDmp = SrcInputFileData%TFrlUSDmp DstInputFileData%TFrlDSDmp = SrcInputFileData%TFrlDSDmp DstInputFileData%method = SrcInputFileData%method + DstInputFileData%BldNd_NumOuts = SrcInputFileData%BldNd_NumOuts +IF (ALLOCATED(SrcInputFileData%BldNd_OutList)) THEN + i1_l = LBOUND(SrcInputFileData%BldNd_OutList,1) + i1_u = UBOUND(SrcInputFileData%BldNd_OutList,1) + IF (.NOT. ALLOCATED(DstInputFileData%BldNd_OutList)) THEN + ALLOCATE(DstInputFileData%BldNd_OutList(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%BldNd_OutList.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInputFileData%BldNd_OutList = SrcInputFileData%BldNd_OutList +ENDIF + DstInputFileData%BldNd_BlOutNd_Str = SrcInputFileData%BldNd_BlOutNd_Str + DstInputFileData%BldNd_BladesOut = SrcInputFileData%BldNd_BladesOut END SUBROUTINE ED_CopyInputFile SUBROUTINE ED_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) @@ -4038,6 +4061,9 @@ SUBROUTINE ED_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) ENDIF IF (ALLOCATED(InputFileData%TwSScgOf)) THEN DEALLOCATE(InputFileData%TwSScgOf) +ENDIF +IF (ALLOCATED(InputFileData%BldNd_OutList)) THEN + DEALLOCATE(InputFileData%BldNd_OutList) ENDIF END SUBROUTINE ED_DestroyInputFile @@ -4371,6 +4397,14 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Re_BufSz = Re_BufSz + 1 ! TFrlUSDmp Re_BufSz = Re_BufSz + 1 ! TFrlDSDmp Int_BufSz = Int_BufSz + 1 ! method + Int_BufSz = Int_BufSz + 1 ! BldNd_NumOuts + Int_BufSz = Int_BufSz + 1 ! BldNd_OutList allocated yes/no + IF ( ALLOCATED(InData%BldNd_OutList) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! BldNd_OutList upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%BldNd_OutList)*LEN(InData%BldNd_OutList) ! BldNd_OutList + END IF + Int_BufSz = Int_BufSz + 1*LEN(InData%BldNd_BlOutNd_Str) ! BldNd_BlOutNd_Str + Int_BufSz = Int_BufSz + 1 ! BldNd_BladesOut IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -5082,6 +5116,31 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Re_Xferred = Re_Xferred + 1 IntKiBuf(Int_Xferred) = InData%method Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%BldNd_NumOuts + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%BldNd_OutList) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BldNd_OutList,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldNd_OutList,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%BldNd_OutList,1), UBOUND(InData%BldNd_OutList,1) + DO I = 1, LEN(InData%BldNd_OutList) + IntKiBuf(Int_Xferred) = ICHAR(InData%BldNd_OutList(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + DO I = 1, LEN(InData%BldNd_BlOutNd_Str) + IntKiBuf(Int_Xferred) = ICHAR(InData%BldNd_BlOutNd_Str(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%BldNd_BladesOut + Int_Xferred = Int_Xferred + 1 END SUBROUTINE ED_PackInputFile SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -5891,6 +5950,34 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = Re_Xferred + 1 OutData%method = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 + OutData%BldNd_NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldNd_OutList not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BldNd_OutList)) DEALLOCATE(OutData%BldNd_OutList) + ALLOCATE(OutData%BldNd_OutList(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutList.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%BldNd_OutList,1), UBOUND(OutData%BldNd_OutList,1) + DO I = 1, LEN(OutData%BldNd_OutList) + OutData%BldNd_OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + DO I = 1, LEN(OutData%BldNd_BlOutNd_Str) + OutData%BldNd_BlOutNd_Str(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%BldNd_BladesOut = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE ED_UnPackInputFile SUBROUTINE ED_CopyCoordSys( SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, ErrMsg ) @@ -17219,6 +17306,25 @@ SUBROUTINE ED_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) DstParamData%PtfmCMyt = SrcParamData%PtfmCMyt DstParamData%BD4Blades = SrcParamData%BD4Blades DstParamData%UseAD14 = SrcParamData%UseAD14 + DstParamData%BldNd_NumOuts = SrcParamData%BldNd_NumOuts + DstParamData%BldNd_TotNumOuts = SrcParamData%BldNd_TotNumOuts +IF (ALLOCATED(SrcParamData%BldNd_OutParam)) THEN + i1_l = LBOUND(SrcParamData%BldNd_OutParam,1) + i1_u = UBOUND(SrcParamData%BldNd_OutParam,1) + IF (.NOT. ALLOCATED(DstParamData%BldNd_OutParam)) THEN + ALLOCATE(DstParamData%BldNd_OutParam(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldNd_OutParam.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcParamData%BldNd_OutParam,1), UBOUND(SrcParamData%BldNd_OutParam,1) + CALL NWTC_Library_Copyoutparmtype( SrcParamData%BldNd_OutParam(i1), DstParamData%BldNd_OutParam(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + DstParamData%BldNd_BladesOut = SrcParamData%BldNd_BladesOut IF (ALLOCATED(SrcParamData%Jac_u_indx)) THEN i1_l = LBOUND(SrcParamData%Jac_u_indx,1) i1_u = UBOUND(SrcParamData%Jac_u_indx,1) @@ -17486,6 +17592,12 @@ SUBROUTINE ED_DestroyParam( ParamData, ErrStat, ErrMsg ) IF (ALLOCATED(ParamData%TElmntMass)) THEN DEALLOCATE(ParamData%TElmntMass) ENDIF +IF (ALLOCATED(ParamData%BldNd_OutParam)) THEN +DO i1 = LBOUND(ParamData%BldNd_OutParam,1), UBOUND(ParamData%BldNd_OutParam,1) + CALL NWTC_Library_Destroyoutparmtype( ParamData%BldNd_OutParam(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(ParamData%BldNd_OutParam) +ENDIF IF (ALLOCATED(ParamData%Jac_u_indx)) THEN DEALLOCATE(ParamData%Jac_u_indx) ENDIF @@ -18092,6 +18204,32 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Re_BufSz = Re_BufSz + 1 ! PtfmCMyt Int_BufSz = Int_BufSz + 1 ! BD4Blades Int_BufSz = Int_BufSz + 1 ! UseAD14 + Int_BufSz = Int_BufSz + 1 ! BldNd_NumOuts + Int_BufSz = Int_BufSz + 1 ! BldNd_TotNumOuts + Int_BufSz = Int_BufSz + 1 ! BldNd_OutParam allocated yes/no + IF ( ALLOCATED(InData%BldNd_OutParam) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! BldNd_OutParam upper/lower bounds for each dimension + DO i1 = LBOUND(InData%BldNd_OutParam,1), UBOUND(InData%BldNd_OutParam,1) + Int_BufSz = Int_BufSz + 3 ! BldNd_OutParam: size of buffers for each call to pack subtype + CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%BldNd_OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BldNd_OutParam + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! BldNd_OutParam + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! BldNd_OutParam + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! BldNd_OutParam + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! BldNd_BladesOut Int_BufSz = Int_BufSz + 1 ! Jac_u_indx allocated yes/no IF ( ALLOCATED(InData%Jac_u_indx) ) THEN Int_BufSz = Int_BufSz + 2*2 ! Jac_u_indx upper/lower bounds for each dimension @@ -19903,6 +20041,53 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = TRANSFER(InData%UseAD14, IntKiBuf(1)) Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%BldNd_NumOuts + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%BldNd_TotNumOuts + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%BldNd_OutParam) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BldNd_OutParam,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldNd_OutParam,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%BldNd_OutParam,1), UBOUND(InData%BldNd_OutParam,1) + CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%BldNd_OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! BldNd_OutParam + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IntKiBuf(Int_Xferred) = InData%BldNd_BladesOut + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%Jac_u_indx) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -22021,6 +22206,68 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Xferred = Int_Xferred + 1 OutData%UseAD14 = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseAD14) Int_Xferred = Int_Xferred + 1 + OutData%BldNd_NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%BldNd_TotNumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldNd_OutParam not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BldNd_OutParam)) DEALLOCATE(OutData%BldNd_OutParam) + ALLOCATE(OutData%BldNd_OutParam(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutParam.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%BldNd_OutParam,1), UBOUND(OutData%BldNd_OutParam,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackoutparmtype( Re_Buf, Db_Buf, Int_Buf, OutData%BldNd_OutParam(i1), ErrStat2, ErrMsg2 ) ! BldNd_OutParam + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + OutData%BldNd_BladesOut = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_u_indx not allocated Int_Xferred = Int_Xferred + 1 ELSE From b64b54cd0c6450932d30b5b05f1deb4d268e2d99 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Tue, 17 Dec 2019 09:58:04 -0700 Subject: [PATCH 28/72] Update documentation for nodal outputs --- .../aerodyn/examples/ad_primary_example.inp | 4 +- docs/source/user/beamdyn/appendix.rst | 5 +- .../examples/bd_driver_dynamic_nrel_5mw.inp | 2 +- .../examples/bd_driver_static_nrel_5mw.inp | 2 +- ...mw_dynamic.inp => bd_primary_nrel_5mw.inp} | 4 +- .../examples/bd_primary_nrel_5mw_static.inp | 96 ------------------- 6 files changed, 8 insertions(+), 105 deletions(-) rename docs/source/user/beamdyn/examples/{bd_primary_nrel_5mw_dynamic.inp => bd_primary_nrel_5mw.inp} (97%) delete mode 100644 docs/source/user/beamdyn/examples/bd_primary_nrel_5mw_static.inp diff --git a/docs/source/user/aerodyn/examples/ad_primary_example.inp b/docs/source/user/aerodyn/examples/ad_primary_example.inp index 590e71eacf..8c0f03cc0c 100644 --- a/docs/source/user/aerodyn/examples/ad_primary_example.inp +++ b/docs/source/user/aerodyn/examples/ad_primary_example.inp @@ -82,7 +82,7 @@ True SumPrint - Generate a summary file listing input option "B1N1AxInd, B1N2AxInd, B1N3AxInd" "B1N1Alpha, B1N2Alpha, B1N3Alpha" "B1N1Theta, B1N2Theta, B1N3Theta" -END of input file (the word "END" must appear in the first 3 columns of this last OutList line) +END of OutList section (the word "END" must appear in the first 3 columns of the last OutList line) ====== Outputs for all blade stations (same ending as above for B1N1.... =========================== [optional section] 1 BldNd_BladesOut - Number of blades to output all node information at. Up to number of blades on turbine. (-) "All" BldNd_BlOutNd - Future feature will allow selecting a portion of the nodes to output. Not implemented yet. (-) @@ -97,4 +97,4 @@ Phi Vindx Vindy Alpha -END (of optional nodal output section) +END (the word "END" must appear in the first 3 columns of this last OutList line in the optional nodal output section) diff --git a/docs/source/user/beamdyn/appendix.rst b/docs/source/user/beamdyn/appendix.rst index 5412962c4b..41f3023cb6 100644 --- a/docs/source/user/beamdyn/appendix.rst +++ b/docs/source/user/beamdyn/appendix.rst @@ -13,8 +13,7 @@ In this appendix we describe the BeamDyn input-file structure and provide exampl OpenFAST+BeamDyn and stand-alone BeamDyn (static and dynamic) simulations all require two files: 1) BeamDyn primary input file -:download:`(NREL 5MW dynamic example) `, -:download:`(NREL 5MW static example) `: This file includes information on the analysis type (static vs. dynamic), numerical-solution parameters (e.g., numerical damping, quadrature rules), and the geometric definition of the beam reference line via "members" and "key points". This file also specifies the "blade input file." +:download:`(NREL 5MW static example) `: This file includes information on the numerical-solution parameters (e.g., numerical damping, quadrature rules), and the geometric definition of the beam reference line via "members" and "key points". This file also specifies the "blade input file." 2) BeamDyn blade input file :download:`(NREL 5MW example) `: @@ -22,7 +21,7 @@ Stand-alone BeamDyn simulation also require a driver input file; we list here ex 3a) BeamDyn driver for dynamic simulations :download:`(NREL 5MW example) `: This file specifies the inputs for a single blade (e.g., forces, orientations, root velocity) and specifies the BeamDyn primary input file. -3b) BeamDyn driver for static simulations :download:`(NREL 5MW example) `: Same as above but calls the appropriate inputs and primary input file (i.e., here one for static analysis). +3b) BeamDyn driver for static simulations :download:`(NREL 5MW example) `: Same as above but for static analysis. .. _app-output-channel: diff --git a/docs/source/user/beamdyn/examples/bd_driver_dynamic_nrel_5mw.inp b/docs/source/user/beamdyn/examples/bd_driver_dynamic_nrel_5mw.inp index 2e36b3eb7c..4ce490dc66 100644 --- a/docs/source/user/beamdyn/examples/bd_driver_dynamic_nrel_5mw.inp +++ b/docs/source/user/beamdyn/examples/bd_driver_dynamic_nrel_5mw.inp @@ -40,5 +40,5 @@ True GlbRotBladeT0 - Reference orientation for BeamDyn calculations is Non-dim blade-span eta Fx Fy Fz Mx My Mz (-) (N) (N) (N) (N-m) (N-m) (N-m) ---------------------- PRIMARY INPUT FILE -------------------------------------- -"bd_primary_nrel_5mw_dynamic.inp" InputFile - Name of the primary BeamDyn input file +"bd_primary_nrel_5mw.inp" InputFile - Name of the primary BeamDyn input file diff --git a/docs/source/user/beamdyn/examples/bd_driver_static_nrel_5mw.inp b/docs/source/user/beamdyn/examples/bd_driver_static_nrel_5mw.inp index 6d1cb4f53c..3986048ac2 100644 --- a/docs/source/user/beamdyn/examples/bd_driver_static_nrel_5mw.inp +++ b/docs/source/user/beamdyn/examples/bd_driver_static_nrel_5mw.inp @@ -40,5 +40,5 @@ True GlbRotBladeT0 - Reference orientation for BeamDyn calculations is Non-dim blade-span eta Fx Fy Fz Mx My Mz (-) (N) (N) (N) (N-m) (N-m) (N-m) ---------------------- PRIMARY INPUT FILE -------------------------------------- -"bd_primary_nrel_5mw_static.inp" InputFile - Name of the primary BeamDyn input file +"bd_primary_nrel_5mw.inp" InputFile - Name of the primary BeamDyn input file diff --git a/docs/source/user/beamdyn/examples/bd_primary_nrel_5mw_dynamic.inp b/docs/source/user/beamdyn/examples/bd_primary_nrel_5mw.inp similarity index 97% rename from docs/source/user/beamdyn/examples/bd_primary_nrel_5mw_dynamic.inp rename to docs/source/user/beamdyn/examples/bd_primary_nrel_5mw.inp index 375e860f26..704cede55c 100644 --- a/docs/source/user/beamdyn/examples/bd_primary_nrel_5mw_dynamic.inp +++ b/docs/source/user/beamdyn/examples/bd_primary_nrel_5mw.inp @@ -92,7 +92,7 @@ True SumPrint - Print summary data to ".sum" (flag) "N1Mxl,N1Myl,N1Mzl" "TipTDxr, TipTDyr, TipTDzr" "TipRDxr, TipRDyr, TipRDzr" -END of input file (the word "END" must appear in the first 3 columns of this last OutList line) +END of input file (the word "END" must appear in the first 3 columns of the last OutList line) ====== Outputs for all blade stations (same ending as above for B1N1.... =========================== (optional section) "All" BldNd_BlOutNd - Future feature will allow selecting a portion of the nodes to output. Not implemented yet. (-) OutList - The next line(s) contains a list of output parameters. See OutListParameters.xlsx for a listing of available output channels, (-) @@ -103,4 +103,4 @@ END of input file (the word "END" must appear in the first 3 columns of this las "RVxr, RVyr, RVzr" "RAxr, RAyr, RAzr" "Fxr, Fyr, Fzr" -END of optional blade station output section +END (the word "END" must appear in the first 3 columns of this last OutList line in the optional nodal output section) diff --git a/docs/source/user/beamdyn/examples/bd_primary_nrel_5mw_static.inp b/docs/source/user/beamdyn/examples/bd_primary_nrel_5mw_static.inp deleted file mode 100644 index 680db38b10..0000000000 --- a/docs/source/user/beamdyn/examples/bd_primary_nrel_5mw_static.inp +++ /dev/null @@ -1,96 +0,0 @@ ---------- BEAMDYN with OpenFAST INPUT FILE ------------------------------------------- -NREL 5MW blade primary input file ----------------------- SIMULATION CONTROL -------------------------------------- -TRUE Echo - Echo input data to ".ech"? (flag) -False QuasiStaticInit - Use quasistatic pre-conditioning with centripetal accelerations in initialization? (flag) [dynamic solve only] - 0 rhoinf - Numerical damping parameter for generalized-alpha integrator - 2 quadrature - Quadrature method: 1=Gaussian; 2=Trapezoidal (switch) -"DEFAULT" refine - Refinement factor for trapezoidal quadrature (-) [DEFAULT = 1; used only when quadrature=2] -"DEFAULT" n_fact - Factorization frequency for the Jacobian in N-R iteration(-) [DEFAULT = 5] -"DEFAULT" DTBeam - Time step size (s) -"DEFAULT" load_retries - Number of factored load retries before quitting the aimulation [DEFAULT = 20] -"DEFAULT" NRMax - Max number of iterations in Newton-Raphson algorithm (-) [DEFAULT = 10] -"DEFAULT" stop_tol - Tolerance for stopping criterion (-) [DEFAULT = 1E-5] -FALSE tngt_stf_fd - Use finite differenced tangent stiffness matrix? (flag) -FALSE tngt_stf_comp - Compare analytical finite differenced tangent stiffness matrix? (flag) -"DEFAULT" tngt_stf_pert - Perturbation size for finite differencing (-) [DEFAULT = 1E-6] -"DEFAULT" tngt_stf_difftol - Maximum allowable relative difference between analytical and fd tangent stiffness (-); [DEFAULT = 0.1] -True RotStates - Orient states in the rotating frame during linearization? (flag) [used only when linearizing] ----------------------- GEOMETRY PARAMETER -------------------------------------- - 1 member_total - Total number of members (-) - 49 kp_total - Total number of key points (-) [must be at least 3] - 1 49 - Member number; Number of key points in this member - kp_xr kp_yr kp_zr initial_twist - (m) (m) (m) (deg) -0.0000000E+00 0.0000000E+00 0.0000000E+00 1.3308000E+01 -0.0000000E+00 0.0000000E+00 1.9987500E-01 1.3308000E+01 -0.0000000E+00 0.0000000E+00 1.1998650E+00 1.3308000E+01 -0.0000000E+00 0.0000000E+00 2.1998550E+00 1.3308000E+01 -0.0000000E+00 0.0000000E+00 3.1998450E+00 1.3308000E+01 -0.0000000E+00 0.0000000E+00 4.1998350E+00 1.3308000E+01 -0.0000000E+00 0.0000000E+00 5.1998250E+00 1.3308000E+01 -0.0000000E+00 0.0000000E+00 6.1998150E+00 1.3308000E+01 -0.0000000E+00 0.0000000E+00 7.1998050E+00 1.3308000E+01 -0.0000000E+00 0.0000000E+00 8.2010250E+00 1.3308000E+01 -0.0000000E+00 0.0000000E+00 9.1997850E+00 1.3308000E+01 -0.0000000E+00 0.0000000E+00 1.0199775E+01 1.3308000E+01 -0.0000000E+00 0.0000000E+00 1.1199765E+01 1.3181000E+01 -0.0000000E+00 0.0000000E+00 1.2199755E+01 1.2848000E+01 -0.0000000E+00 0.0000000E+00 1.3200975E+01 1.2192000E+01 -0.0000000E+00 0.0000000E+00 1.4199735E+01 1.1561000E+01 -0.0000000E+00 0.0000000E+00 1.5199725E+01 1.1072000E+01 -0.0000000E+00 0.0000000E+00 1.6199715E+01 1.0792000E+01 -0.0000000E+00 0.0000000E+00 1.8200925E+01 1.0232000E+01 -0.0000000E+00 0.0000000E+00 2.0200290E+01 9.6720000E+00 -0.0000000E+00 0.0000000E+00 2.2200270E+01 9.1100000E+00 -0.0000000E+00 0.0000000E+00 2.4200250E+01 8.5340000E+00 -0.0000000E+00 0.0000000E+00 2.6200230E+01 7.9320000E+00 -0.0000000E+00 0.0000000E+00 2.8200825E+01 7.3210000E+00 -0.0000000E+00 0.0000000E+00 3.0200190E+01 6.7110000E+00 -0.0000000E+00 0.0000000E+00 3.2200170E+01 6.1220000E+00 -0.0000000E+00 0.0000000E+00 3.4200150E+01 5.5460000E+00 -0.0000000E+00 0.0000000E+00 3.6200130E+01 4.9710000E+00 -0.0000000E+00 0.0000000E+00 3.8200725E+01 4.4010000E+00 -0.0000000E+00 0.0000000E+00 4.0200090E+01 3.8340000E+00 -0.0000000E+00 0.0000000E+00 4.2200070E+01 3.3320000E+00 -0.0000000E+00 0.0000000E+00 4.4200050E+01 2.8900000E+00 -0.0000000E+00 0.0000000E+00 4.6200030E+01 2.5030000E+00 -0.0000000E+00 0.0000000E+00 4.8201240E+01 2.1160000E+00 -0.0000000E+00 0.0000000E+00 5.0199990E+01 1.7300000E+00 -0.0000000E+00 0.0000000E+00 5.2199970E+01 1.3420000E+00 -0.0000000E+00 0.0000000E+00 5.4199950E+01 9.5400000E-01 -0.0000000E+00 0.0000000E+00 5.5199940E+01 7.6000000E-01 -0.0000000E+00 0.0000000E+00 5.6199930E+01 5.7400000E-01 -0.0000000E+00 0.0000000E+00 5.7199920E+01 4.0400000E-01 -0.0000000E+00 0.0000000E+00 5.7699915E+01 3.1900000E-01 -0.0000000E+00 0.0000000E+00 5.8201140E+01 2.5300000E-01 -0.0000000E+00 0.0000000E+00 5.8699905E+01 2.1600000E-01 -0.0000000E+00 0.0000000E+00 5.9199900E+01 1.7800000E-01 -0.0000000E+00 0.0000000E+00 5.9699895E+01 1.4000000E-01 -0.0000000E+00 0.0000000E+00 6.0199890E+01 1.0100000E-01 -0.0000000E+00 0.0000000E+00 6.0699885E+01 6.2000000E-02 -0.0000000E+00 0.0000000E+00 6.1199880E+01 2.3000000E-02 -0.0000000E+00 0.0000000E+00 6.1500000E+01 0.0000000E+00 ----------------------- MESH PARAMETER ------------------------------------------ - 5 order_elem - Order of interpolation (basis) function (-) ----------------------- MATERIAL PARAMETER -------------------------------------- -"nrel_5mw_blade.inp" BldFile - Name of file containing properties for blade (quoted string) ----------------------- PITCH ACTUATOR PARAMETERS ------------------------------- -False UsePitchAct - Whether a pitch actuator should be used (flag) - 200 PitchJ - Pitch actuator inertia (kg-m^2) [used only when UsePitchAct is true] - 2E+07 PitchK - Pitch actuator stiffness (kg-m^2/s^2) [used only when UsePitchAct is true] - 500000 PitchC - Pitch actuator damping (kg-m^2/s) [used only when UsePitchAct is true] ----------------------- OUTPUTS ------------------------------------------------- -True SumPrint - Print summary data to ".sum" (flag) -"ES10.3E2" OutFmt - Format used for text tabular output, excluding the time channel. - 2 NNodeOuts - Number of nodes to output to file [0 - 9] (-) - 1, 3 OutNd - Nodes whose values will be output (-) - OutList - The next line(s) contains a list of output parameters. See OutListParameters.xlsx for a listing of available output channels, (-) -"RootFxr, RootFyr, RootFzr" -"RootMxr, RootMyr, RootMzr" -"N1Fxl,N1Fyl,N1Fzl" -"N1Mxl,N1Myl,N1Mzl" -"TipTDxr, TipTDyr, TipTDzr" -"TipRDxr, TipRDyr, TipRDzr" -END of input file (the word "END" must appear in the first 3 columns of this last OutList line) ---------------------------------------------------------------------------------------- From cd7a15d800368ea4a8868eff2ae8493e310f1423 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Tue, 17 Dec 2019 10:37:45 -0700 Subject: [PATCH 29/72] sync OutListParameters.xlsx --- .../src/OutListParameters.xlsx | Bin 215167 -> 220233 bytes 1 file changed, 0 insertions(+), 0 deletions(-) diff --git a/modules/openfast-library/src/OutListParameters.xlsx b/modules/openfast-library/src/OutListParameters.xlsx index dbe2be3caee0168f0f109c28516059cf662449f6..c64fdd63c33a1757fe085f203a18b3aa1c72e402 100644 GIT binary patch literal 220233 zcmeFXWm}t3w=Rl11%gBIKyWL?-2+96OMzm=-Cc@nad&rjZEnf`WpgfRY4nL;r+^f8H_yP!(3^5Ugd>yRn2 zCXyzY6H?)XWQ`C;WXdIK8zC*L@A}f%aOkW$mh*tu*E}@r?PGg^yIpAZRs!Cf#S&BU zWK$gt=gqm3+o3?yACA?F15g?BP+=qYOI&qJaxj+Myk9}?xmOZ090F)WOUdMahbebO zu!VLDJ}s7C0k#($-I?Xk;QVMf%tP*v85plRiguS$^@L)VTgX$(2E6iAL5?!3gmP%~ zWd6?sMgV+NlWs`|p=!r)y6=tiu;c4X@g#h^#N?a3ih~)Mg#4r?5AmuaG4N;}NqdWP{Tz}kSbPTBTf^;UPVsqeOoy==zB_NEctrawMAR-% zhl=z+h5e0rZ<1i!UKOw7S1*`O`xOsPON_gD=icAoinsBNjI6;#oJRigy`3&Z{^8%!gN zT(7WDP_K|T#s5#{H>k2wT|vV66C|-wA(^jdZ*1wn!u497;57dqrkBUcDfGN$ zy!2D>;O)%H4@^;67ZK?;3Kef(@G?e2WFC-sr3>^PQ-$a|tdviO_tWsw3V-C`AjQol zM|n5^hmWe!r6MTl!OjVhp2j{=(yn}?7t49(dgdlYO2&=Wxg(msthqQxc4&=Ca_U^X z26K#Aod_Ab;C&FDK#HGMzntc(!CfWvjHvQSMNoAUSN37tSenmVV&MV0PzcYbfo7;r>>tiIC z9O!t~x)P~{)c@h~_wNrMMt6d(63s0r?S~hHrATDwkiy+W7cPZgFEEKRD|Y~Oa7F1c zew|b;FB^xqYs_3<+JE!-ObA1dAU-G!tA0&&YX=gJ@_9-Sv}@YN=p#pOF8o&aUkB;| zDC?%{naWJQC9``~QDE9k{KQ8kierlok6>+4r<4w(?jB2WOi*8}y<<9LXVeW#z`C@A zr{Co$uve#_X<&R;I2M7*ukiDP>Cjvo+DG6{3h&GDFreK$W!RL_brioAw)Bs{e&XvO zI~FhU&qk8(O=k9TBC{$x)sociXW}zuPS;VxKdz@1F%`?UWuSg~6g65${+X>}#^<1p z_Bb?mZFq?IkWivBr<6Vd7NrIwxRa6I2ffGtqJ!OMt}%|Yx;R)Pu+m<7;K@)Qz-SvY zj7V-@KuX`^Y}Hoe48vBb42J88jo^;!?)k1KG}5AUYdYk&u}E@XluoEko0~z>kp4%yyMI6F?ElnnyQo_v0avlP%o_Tq6?v7PiDqs0WDik%qYJ*anTa7O&6z-s_o2^ayJ*IX`a??y$St z2P_8ZSV27TPdKqb=^=fT!V~HvO&OUMfk9_2UOm^9prAcB>>d$jdy+C@EwwxJbgT~Y z-R2)7usZRFey6$Wx-08e*9e*-B5_m^RkIt0#g7XG?zeJ0&pN6a6F*WP%)54!93 z@TBlWbK?1F!U>g#PUxHH5}6>uVcdcPui;mT@~qcjiR+pSPpO#L%ONs6R`^?7m4xgp z8-4~x(X+w#S;uex18bex05q8e&)yenXt)m#{w>`j3jIto`I#dO53)pw7g4)-s}i2{A(O zH1K!a;~oEQe`qZ#*WSZM~;yoZh5g7Z)V!5@#^#YWDpdeA?cHV-yMY*gbTeZc?U6}z!5tOh$s8Kgpkf+B)Kf`$~k|B!J;`pd-@RIo`T^s5e07EkRu%Lg(Rwt$jW{ z*MCH)aC`xkr;%c3Nf?fr?>(UJ6`St^|{8P+vZnVX-}zMoXu z(*#qR+$i2X3^<%Iyk;%M8|SU}6_35EZ~N@;L+tU3sQW&DQf=LylbM3dSq-}?`FzQs zm!p=5jd}+zaI4+S7WzYg=N*cSxFrx6^C^HsdPq%Ru66>SehUz2MA#ymXcT8u`f5R=24S~7v^H}Z2EJ=uT_hN7{o~|^T{$#I!k<9_AH8! zZqSc4+HyMmICb6}jtR6M(>hQZpI`UR{ntv%^;pljS)kabnJfwG1VU;W+Hk&d&A8EC zNh(Rsr$e)@NBI9;z&hj)@rgpZvnu59O7Q=7X9rVbV@C&;e;;gbZMt23$$EPPZcqVaxYFKB^e%I}fTIyjJmN0aKBleyTCP5#1 z&eykSLMw2w-Fl~TZvUE{{@K5kN{k)E=ike*gj%5ECTm-BaDR6#n{W7P<4?gPRjr!OS?zz( z83iy)($IyUeUhn`M=tzD{V+mHu=v{C)`j>b^ufNYs^eJCg9C~3xcXuk!1#Vq;m^x& zkNS)WVbFLMmiAtM2esP`D(VghZ$Qzzo+%;QCcTT{j|qXZUrJr_J-sSp*hm=eq9MlU zu8+lsLsHK4$q=_LF77Gtb8s~b-lQ?3-ra)<-XDAb?sQNYz52sX=U?_@V3aBJstQFf zQdpQZH9(2ESnNb(XJwu+bC7e{#KmH?4vf=?-fk?&2N$MRTbD6Fg{9Z2=?4c(r6bD7 zVhM7BBL}9Z6~#t1o13KSeXRH1dk00eRt3eN4?LUAL=7vm-I^5Kf`U*CSlYMbqAlW< zPK(h+6e7pYv5K71jS5tyh0b+Lip*HZb{^FEQN#J+t^s)pT|W0G*9QY;pK2`PtRD22 z$zHF75#)<=XFh(JDl4QZ-gBnU)Z#B&ICe@cTG?OO=+8H~c>3LYm`uZy%@*i4=~R6@ zt&^2vV4q0+GsWJa9yHFmdEYbQc#{*Brww9N9jEzu3jH(n38trQ*f-h9x4a@^7R4{Q zEwA-psIt0>siHz#B%!01uj3?>aJ+0#i+Hfonxgc_K!f_nNm6&E7WKKD94nk95%&n( zWC}s$mDc;y@bgx%DM2zKaV1|1MWuPeX+g`{oZRdKsfgU!LniY~jXJ(MofenbP2UmC zpZ@tH)e2{mNt`_9F$uiA9+EUzL788neA5En&wu6l|&=C804lg-Ero~0J4CsF(r{DJU=3B@i9VmnZXYK~Gj3jH? zr|G9(u@&+gs-bh{q{{seO$ll4z6z!2Ze-<0rROnsii*)>KX1)0ISeP@Ph=y(LX+Xv za#r9D_}IuBsW9=GYJfV?)HLZppP0dY{lV&>lgIC1h)uq-xdT*XZ0XB!Bql^%*Jv$2Mf*{ zpEV=gFu2isKk@V0JZ<|aOH^YmzR;TwWsTzJr**d=ZELC)1@M=HP5^2 z=OQwpmxrRWwWqPy^NY5XG@DLOuiK;OGw+wHqhQF-TRll!uUEmZPg<O$u4B&m&nv zo_7y&^?#3&Aj9`Zb8DR*k2fQaLOyppD@is&&o>)$cU(eV4^Ja)Rp&lJuLmbdYl1$m zw_A7PEJ9s60s>a6FBhjc4|gv;8&i*6PZt|=RmxOZLQhYp7FVwj zQ7<>f)+b4~On;s)PA|J&cbe8ZUav-MCVC-iKb;>5^-HdKUXDDTy<97Fc|SazMhgY6 z`kV#1oORtl?%kcyzs!wQ5&AT7JztzZ?(D)M@?72M@D^m3mTC-QPW zRpcY|9PSf|FCanO)$w@U!}WT1*40-ZWY=}SdsMXcaul4^Dd=-|zo#6Yv(6kzGNH*HGC|B=1HeLu+c;Wffb z@Y&(&_N1lfUT7@ChfrV};)2Vq;H=f>oxQ5DEbo^!GM}f1y|cCBu9KjmKjzQhUesSt zrq*6Yf}?#NF2N~xPW2sU-cJJ?JxRA4XgL>66z^F)Uk~<71zw(ZlcGUY?+m?fZ_m%V z%trJ&U$%@^C-!cA?g5KM>MkWIC4K}&HGX$|AIF{cI(4+}wt`vo^d_bC%$OqdEty_2 zwTU}dD&~5=HKA81c`TI)guO&r^{$mf{yAKlv0kYdI5#(^TK(9FTOv?ace=VL{j{d>PS zy8`%Lt}!6R`*ChcHmg&7?B!b`03!69e>05bDHZZKUB~75V;(C+Jue5cb{>xs09oO3 z2e1fVG8TP!1UQ(9_n5D>2?zJUG!c7@b*GK&R?JiAyiHQ(`|Qhk6&NIxY;WqPEN5R+{kEB z_erPc#lWwxwMH+u2dv?!5pGOIlcI!}ffzf{Ft(;TlM|lM;YBHFHX|x||06)=qfu)V zaQY|~p{k655^AU3>cqxcd!^oK?`7hwfOrgCtXMp^gC1~`@#!~~_T)AC0}f{FMDIbI z1b!ewMNvi9xI2TF7irqdi(E-VPI*be7t^(cFKy$ka}87-l^P|bTCm~=YE7Uewx8J< zUZ+rBuD)$D*UzEfhcF%3#|4<1M{DdNVrrSR$<@$CW~J52IV#Ll^?dm2e8*ZWBp7W~ z2Hv-Z5%qwFm9hjU)c{qjbrYVqubv;xzX)(rc5C4u>;dB`EFO1~UzJ9q$YYPj%N!iX zZE!uPb0!s>T!1+uvn^C8L%g>zUZuaP_-BwVqN(7t2#}yF&niz&bH4<8)Qd6+q z;(O{C?{J?GpCFmW&sM=6Y*8TNPBp68h*4Z~dg{nwi3rbiSnUj&6nOCibCj^o8>vtZ zT;8=;qU@-_m|N3se*M;s^#|2c;W zrKAp&!zn>7ZcqHJl3cR3i5s_A^o?IVnmf@ShjS_k-;1OzxiL7KG8&D}kq3L`J^%BD#1 zQn8GbCS>N$q zBV(2lcT@V#Da*@rO~)ygR8&II<}*Nbj@AbzYdBfM!>fyWq(wn+Zv^0Y1Q)c;WWl_yZ#s2Yhj?Vo3wxuW2QSyUZFvVJjVNs0mYz< zG)ah{O|9JGSEs&pXx%sf=!5&!Jfgpys5icd3|g2Rk>#VK&xs8jm38?3!kSx?=ezn5 zHRXE;nK;m&{bQi>hCvR~K(Lz>9A{ubBRU9ux_^_QE!mCR{EX0S~cKXXEQy)gZk1HCXGb>K<=8s|5`%ArHL)P%@rS)++ zu2ZpCx+I>!Q}TMXU?0Dx`**^kJ;p3_2|5AG{e~_DDW^EYz!XuW zQ7dB8HQvv#{zUUV!;xC5vf^$kON5WiQHE<~`{+MYAE^ zCZJIwTGgdQSU~Bb?q7xQMpCOoM`+%1P|jrR32O;z3w2RqTTaz`4Y16}ctUc*x41a?2klKN9+DduSI34>GmD%T|b(7MpqeRAO3$NnA8_G!Q^e zu&DJufvmJgO_X6u@YZf|tn2(*f@cLStNHGmr4r+U{Pcg1Hkh>`$yPwiT3vgvASdkq zawg|a-AP>bFUVF9a|V>p+i-v2+4e%*)n<$+sa$!dg+JY0NldB`!iGPBLvk+K=q)b7H{n*bPYH=$DM3#XCTx zT9K#S8QsRemp!TL9=hAH|HOnVW`M=*N@6Oz&^wYO^KWmvYs6DJZxYV<>qJ>y)%bq(+Tz!qWl39ojqmh&d=DO;_W zxprLJ!4?Ql3a!Y_fX*gysjO@jhT7@mLEId2{;c=LMpV6 z>@Ip{f9kmgcpv}3afK6BQh)Dj#I#k18*#@Qoy?ly8jwj%rl;xNd-WwM*dX94ZsTeB z<8*w$1+%Xd)J-`xpb>_Fmn6F%pSTk^=FVZN{(hW~2Y&f`z=RX5J-sji(Jm_C z;ajAC_zla58i1;6|4{W8{bs+4mx=|9jAMNIaUlSsi{y^2Res=wueFS&HSI7J3{*X= zu*;_c`$^SzOYF}ojtFPSOcZ#`8OrZEk+SKx+DDHoTa0ZngbQpw$(~|mY|21f@R!-w zSn;7Dwtf-0-0})Zrswo3b78*m6pJX7+aCf-FFiV>c&ARPx3!IL-o;nIr7nP#HnGC+ zz$pB=@XVr3r77hZ-FN5AR9B=Icf*rZg?lp7M(_utV>)7T;C)_m8PNh`6#$UW zFCmh2qq$uB$jYy0zR@ipR|2AeZ*q|bTuxu=s!L8EZB&^$tC-E7MG)ONl0-Np1SVkc zbF{^nUR_$_E~^C$EI)mY!+n%dA~ffHRXWBZiiD+Gqsm6@lmh1bqB1utc-HwmcuuFo z@X_8?TFHPg3{PbEA5ySd<%e%biTS%)5pDvh-5Ioibhk*ZRJ8AGYf78D`_xac9+9UK zJbHDVdmxVRfcU&cO5?fi(qZoApC<|u7*uUJNjknO#lD=# zpiHhghAG>q+FGkNtKhe=G}%voD^$LGpBk7}V{VvX7h?GD+f$xr6Bh|ybQ+s>Co{_d}_5i53Y{5R#vcsmm zdTmRX*hS*DJ)uOps6X^e63jxl^10Aj04fmlG4hsp%886%nTP*Z;}KtBYmccTv*;2h zbeRLT5)I12S(Ie`JM+ZW26092wo(D%5gL#k0ls{0miEdNkVbyfA|N~_?vBqa5a_F^ zs)xB-=BswgA<}-aBz6WPIA#zS_emj9k4%f5?RReX7QIx6;n;VwF=38g%3MlZpyT)|#$+IxBXml9uX_tN8w zZ6}bKe?j+!;vYmOnalCJjm$d&dzTYVdEy_vMxb+Q1DFu5b-ebtL?xKC1dgv<_AInb zQX}%Brpi@*fpOds5gEO6NWy7&)2YO54WfX>@=_m>v}oH{LE>}L3Rx6{ILWesPL9l4n3L@(lY<_(lho9W$aIu9CblQkB zKs0SQ59>{sf^MHYj45_{KC%@|n#A?)ibjA=h^=l-9PkC%4)8Nu1oz`gmApd*kp))hb*8 zooxEU=`6$Eym(5~hSP%@6Q2_1p??NuU}go{UoM-F*-kas#%h&$vs{UG5kx69pm<|z zUce-fh|!rNM>~!;y4X_~OlgEK1r0+jmfxVs%&2zuVo3$JizL8{6FK+S!QP;DF-R&| z=xB=>Lz!o@|7?*-tR*(1!uwqdOWgq=tUJ!>?qF8fuw<49LeCLaB+NI5M{A3*G4LDq z9lWa5+dr1Ju(4DIHXw`yRg><2`q`z`YPFr5>}XxwF$GO60kn=^CZ=V5;$2@>>--&K z#)p&#kCtD0$sa3Se}tBfeO^$;3p>!Ki+YH7unpHIlhKgg~IcS`Ho`i2%FZZ7h_!>Z}4a|`Q5@irR1A8UAM+?8TgI!Z)JZ!1>UWw2sE|bwD)wEN+7Ti`Ss48nzq=f8>nq(+8=Z zLUXkgRI@ROg9 zUQ1x1#fZFO{*i(%w-IW|`j@`A_2;>JxUYEoXl`O1%@Cxyf6E&Dz^Pc0J7>*pEV?UmkSLyG5j9cZI^{~Vp{PZz zJ}Gq7FfaQpt$w;KG4m*KiM9=35K!_-CStOim+W|vR{FXmmyYkC9my+HyD96b7A2BH ziPiSu@K}>kp|=ne?qI{mRE@XA(Ls){ZL$3n*t#+I5nSrdSE1Y)(J1>oWvDf{^xdpG z3`=ngP$Qn1qj!9^JIK;qoB390|kPHLQxalTQ#T4kD1?m2l6wt;bUlcUr(|PbRO}AG)1Uz|A%xhGt=rsKjwJA zx!ah{#!b9&8mGX$tXc?uLS#q=P)*sy>%c)WCE25h_aq~K;8Mh&)Ij3_0de!eNHw9& zaov1i51DzjhORQ}PhVWgD!PzjPoI=P<3Ry82%KQFbU0m^L+rQO-(q|Y)to>pA_F?t z&H$G~`T%%X-hi#?GENho@Ri2TdYt=ndQBo3QHsE+Eg*#Jlz#yo4X96pz!_Q$m)^Su zUc{a+H)p{b==Z`w5^c@UJA{*r9bfIH35|*4$dTJ*E}F<1;DLz?{T$q|k<+mTOB<2@gy_V+m9>gjWY znrszid8*Js5{SSn*$iQ4z~WMd8iZn)iKdB%E2-;^?=oZ}xH!caF zW8b>`rTYSTO5p`U<>O_oN-sqDN%445ow7AGPg+%(ba7t{m#&!uBf85t>ScCHCBXNL z{7@ES>oT+i_2l)|M*`)-0S>t1Cf?8w#!Xz+;C#ByI4BAf9%SD?<^aolB2CDjVqosj zjCdOP_zXK_r%xG_E<%QprVvXq|5vmj|TXZNbZ7Kg-y5rqZ$S}t=M04xZ6vNr;^>!oH3|&BiT0XN5G9dQQ@1Qh*qB{N6aH*1TwP+$g~{k7^M9_r z-3lO=l!qa7QOpueQ@vjLaLU9fLg>;3d(z8LvzG6xz5&F8gNN``-vU;79Jq>|xDc-b zV`18@(_5+#ALFy&B;km3ID_nL0psPe#Sw|*S^H1DziOwbzHI=1*slp`nqt2typ{h0 z4kS<3GVN??kcXR(tdi%!yH^iOLQmeC&mB+ke4$v}F$6rw-AV+Y;pVvuu=wC4J2?*A zHR?z4p;|8cLTS?ZFj;vRHpTHw_EXgpimlc9ILyUq_l$pHh^4UqlPKHYN=k$-;_G+7 zM3x4Ya)-2MSFL>xo|YP!|0t64I(~0AICdJn8D8lc)wy>9BE(k2y~u^_9Z607ab#5} zWH_X#F9R;W(iDU677s*GnV7L_DeBe5NYbh`O!78d0Y43@*BmK`dZLMo=yr{@{VPlZZyfA zlWEIAa~BxEnUF^_?Lt7<7GAI%I@y<}Etk%G$uNRj%X|MnM2sE*N|f(x=gJVJ0C^et z$cca^S*EP|;bt8??xCw>8tjDVP1f+xINEt2n+w3bXy8V=RO`hq!LE(bF7|*&RWAhr z0vIBxeC{3}_%~z*sHDpm&lWP?z6vg!y-G7;ko|SZm`GyV{uJ*Mw?FfpDzqi;x6+&o zAhxt{N{z5-gc6iPP^>DQtd#_)@#v^0SoA24PtS+99JTsrJf%i;FM}{loTokIunSDJ z&+0RZRICR>NPOQ29eaZn-9XnfHNEAoVA!NF|Bu z5!L>xNkx1+0E>wyZ43<06$>` zNV0T-3mr7f+%QYboWm}TbRy3otEwufUjOW< zRW)&aqe9a;JKscE)Hs^pG%_M4f3TY39F0Csh5Bo=5@kFwJ@#uT=|}EQkuo1i`)Z_O zVMb_lvF8X2N_l1F9}-6~ucm(6?W4`OGBOA&eO>JR48seHG!iwQVA05)vOG!1JZEY| z?|37;wz|J5jbfRW3>G#Cxim)H6E|tmbdWWHQX(=%${-;>iF^*vA8e!mqwzvSH?|O^ z@YTX~Gi6YynW)beNfwlT-|>_Vvm^#|W`6*yIwekpH8}=3R_lanLZ1!l3Vkp@zoaEy z;LLXuF^Mhxa;0HhPlc{JO=BlA1i>Wz2NM!1R{^6DvSO!13-`7_#64sem;8N*|NrmH=nA&|7B zSOBY~>>0D76?5mh`>UAiLf;Rp(pUatUfdD1qNTji{Ddb*oa5%b#;!9w;Dko2OEd^= z65rl+&B9XW9Exw?zYKQAnH^zvXRG-kiNBB*BbnKyE=|T7owm)j{c!8hq*P=FI zI<8#+H;vgQQp(cs$ywN_J?$9+4fJr7bU@l@R5howw*kBgrO{GA^|pI2#vA!#>Cq2e z$U{mv+F0rd(-56Dj|Rdg!>vjmHRd%qIok=p36OmvD;U)(ag$)AP-_d$H(mKJYOYuwpSp)`T{Zx+@s{@YmMbKxH<|O4KG!$@~xxVg*>z4I^QqP z@yBYV8z{#}F%5wQ^_|B|#i%OfQHb$gxI<9TF`~J15QHz0L{V@cZt@<4f6|@a{pWnPzjjkz1iZny62;|(4k26;)AU@NG zGKj&DjfH%2Jx?5V(hwqAjIp;W?1fT3V=qjlFpx+8ryOt;%pGcM6bE6f*w)yf2?v`? zRC`GO67rUk7gelD6#pC+tMT$*zm<@ys-J2n6#Pvy zB$VlJQ5{wScb_1Y#w1zmq<|6GMI({1SxH+YN6rzwy_68lVE-WFK_lTO$0s& zXYCJVHDUUY^92<7%|9KK83w}}XA1~F!#WB*1OAmCCvEv$y11rl_AT%jX7HTyUKqKG|HK8YyrBFKwcvUf_p-T06VozzlV zCsjy3Wt!A1gF}{#Ep{4N6m*>c`v}S4So4w9<$;r0n9Ky)8~{(=9(uxj5P8FU*l-M{zHqkdwME?N^`i!830*pZgm3T z_ndh0?62`XObkt4ZvQc59<0P718ON>HAcDtYa=7dmWZTU$Y z*uc!0xUaW%ZRG&s@Hc-*Yd7-2ru{xKAUpl5q($}KO7}B_gCBLi8Bx~I&;zEK*Lb^0 zIt8j(KfYaCr4Y640N?2z-RD0x>!^iBO8o8xg!G=&HrOvgSZjJd9Ri9#TW&|Mu=WO? z-yg^kBBs%@BIqWpMd!a*>lX@!z-KkoW*zIfh-9re?F{XTif8`t9eL4ZX6=9GYy$b@ z_}Ue@)^8Z>+En5~dr#hY(t*)YQBvqXXbnZ`w{Z9>K4L9CLQY6wezUb^RC>b~zq}bJ zT^7uBAn>VeGBM=J8T3yP9P&j0uj%SFRl5YXRt>PRNg0Kf8ycOtAtdF^t{OC0mjQ2OU4rac9DamGA3N0T`svPQ}o{FN>O+j!aH9=PdjMu7PiaSbQ9 z_H7ysRuIPS=K`}zZk=>!RTIOq6O|D#sMDyW{#Y$)kN<|*I~5-emE(}KPR<#nYNrYmCO)a)%@LiRJ_a1FsdhuOrg#1$-yM7&)qLb#pIvuyt}^iJ}BM;!l_ z_e+T_;Clh&WH1RQtE_G8nKk1x)(1n?DBM|DzgKYO^!Hqt|m3$qFwm>%9SQ_i3mWsw9 zGGuwuT?lHmGmDF3413NkPw{6!Z~VKb?HNp4?52^Y;YK3^2nxObD#J{p`kR2ITyg~Y z$=(xo$de+EvS^MeapU*$6=fvyo44KH`vyeQ{$qi%cI06e=JHm$(Xa12T%ohGZx&u) zvf8yBKiLz7{FIN)xAu(lRT0QYgz#T`K$zc~r|sI3?+26)bCm33X{u8e=_~Rfr!P&_ z(_(KhBoHgo2;?{MhkL+`JMSP7DQAlPMq613Z|~E9{B~y7BjU3Fg>N$~CtnO>hs*R9 z74(s@3j+?52)l+C6crG?ZI+)DB4}H9uG}5j-@Evm@-VNO<}w$?<$H4Kn4cNrtmQr=7bJr+<8N{l$(HA$x-oWu03qhfhzqU!;+uIB6a7ZTGV^g7nEV()&hg(69k#n*H4L<8htXH)Y$U ziWs|n4qAlh7`yt$^CKkk2KCy}rvzR7TC(jxj|vNaNpeczH}9j!Ca&gLT#DWCVOx}vh$b1WJ# zT4k#GD4TFu87!+IGv}5#>6H1X%HuPST_8Qu&iCywQrOk}%kGMNacz9%B_s8k5KEnk zUp{*;<;$sG(~d?ynHgA;IZF1Eh+*|uol20zQ<33$+||bcxtbU~sd%s4U0MTV_d`3p zVL1mIDMPS%9*EX({eWMO8Z?c6MUFnqZCj&bXs%2EFH9(`<4(#RpCjg?YHXiBosC9; zMTb2LTY&fnt(#V0fMECzHP})X>%&Nn0_{{Q4$RfWqKSZ_$8jBY6_uNPGt@d2E7vcM zgfgvX>1sB^RCpQa!il8_9-E%w}a^5A}IfpfL^3B8q~5SX4*^eb|ST`8nogoO|G;Sz%I6qpsn ztFRt@r16wMic7*>De2tOc=FITg4G9c($D?<_4~Vw30o6aU-5_;@_S3+XqUV5dQY>1 z<1;6cJ!R?xWlh zk$=UkpvU%sk{GQyXycq3eb1Tmz^k&qgG!tq2C+Y1rbmDbRCWc&z#QlWd!}Z^g5aG@ zL!rRfhIXZ_b3P7q{^MbH=RG%bl|RyDDAn<#ye4#-)Oz1aIL8P>u@(goU2$@sGOY!> zm#ZhJ;@GgDu&?UPOzYriBH|HI>nU8n>PdAERZm<-<@}je!;*usN?iXQb3s0}E5DZF ze75W|o49<0-66Wcml#8rKdfT{_rzwh=AaX-E${{*UX7r)@hd=pCG zOpT#p{JA46InMW2R_UJKNx>Pq0kI}>Hp(ZZAncjpgX?Dop{B_feI!rVj+K-nKSYY@ zS}5)it9n|`Vt8DlLvtPL9;Q^LU|>h?gjm)-vQeXD4OC5}ng>P$If0V;QRlq40XD5a zulvPzi-OXQfj$M=4^d@!+uV=8#oUlmrxUtZf}lB|zvFSE?Ld2*&YUN^C86wm^!O90 zDY=K><9B!9Rr8Jq)50u{prQi@w*3 zkru}xA?ZFXFk+nYj$G2>EcVNYhP2*j^l~S7rRd>tXR!>i&ZNZPWQKhwryWsN)D1Q4 z`@EzWQOylAk8mvRrJk)=PEqW=d-a)HB7Fka_rkDO1qD14gqleE-44ZpQc%}pO+=@z zB6mTcjc2+D+p7qMW5A7WmU-Sz5e9I^iXTQI((L2j_=|f@nf)GN*(!@5*G!SY{SLix z=mU^Cyoz)$ihy4q3deFXzwg6MM*_)V$={baopb7%$W`=^1uei& zLe%jQ%Zy6zHFnkLva8f{G%DboA(uVa(lCkTTZw^w`B>unN~;W}vG#x?i)N;Ta+b*P z%Ef+H4T=_Yf{j=s1+@ilWEkm&ec82IT1wnTpIU}`zYt+2*s{OFIqpxUjDNj@v3Q4( zvKkjIT;*?#xO6>=H54SJy9@Ec$7CkfdB& zJbr*fF(7UW<=}D_bK9R+RM)kp{K%Z3C?zmFU3^JRr%8|Q=RYsWV$mUPWc+?ed-%JG z&OQI>RA-r(-!1Kw{_x{WVX~W8wjzSJ;q95bYr&;^t_mIzc3qcnYK(HH(=G*4UI@?c zRaoAfc8ZUfRCOR}LqUw0mEhKkr2TQq9g@59_g+O02L%g9&%X^Z42*7GWK!LJlrs4E zNrlI|lmkA(|2`(UbyOJc#2v=wubm+^uZg>W%B>wQNq(m0t(SHiR4hpgTHxbF*)Yd83)e}mT&$_vn80I?-g@NL{glo8BH~HNj989*~+XR^^A?3S;Zs`@mnzb>8PBUe>kj%xf+{N z1lV(rULRLhy#@(5cmmm=c>c<0oPg;^a1+V|R8?(4n3eq;1aiqBTTdB%rp0hsCRyrX z0K0L+tE#^U1|*rM?eWPh6Mw7&1r(hRE0VH%M4fCTHGI^crEy^ z(&tMhx9?5h(l001yVA4@`s{psNL9ccXvEnBA&T4`B$gQtmIRk9h;YV#t9x$#$|#Xy z>f#w=)pcQPh-_RodmE#YQt)^9;6qGssIw7u9k0o$eDXqKQDtT^SzWh^1=KY?v4&s` zn!OFRUa0(T*Ut)$-LO-ZG|4ni5jr?;frLQyqG5u)m@6=$Z%(GJNNbmAxF^FYGJ?## z)aYee8x5m(Jr2(zzU>0Dr;LFm;Wu%Oz%)wqBM;|gz~6X(`fr(-nH3P#H2zALzRAW2 z^BpKaR)+jaivMm0d1Jvm+G)UR7kOg_z^LhTK~2V~2*Y1#kbDvFmxGW1qIlg5X<1a; zg)eMfD%(>K1Pw;e`(Gp zc6{~8?5mZ@Ny@qaUH8gFOu?-i%<*;kat49v&w{2tD484$Wt4N=Q)1ZtopJ9`{vUC=U=IT$!!9?4@?y+VWfy1wGH2&FbY zMn-Fi6^z3CSsb9R<{cPReHo8jm&~7EZgx9JrG7gIe2hWqhIIY7k# zMx(z$shZ|hBR&J%=nYarmVgf=4X3kK6*{Rz z3<+31&)wxUwznC6Ph0AvK6LVqUu%w^(XB(&n+~6BNoSJqAZ=io*sCaiFWWT8{p+>r zU|ZFb?=6cOG5$!SeFYUwihXLOAS#o9)JmFnTv_pA-Sl4M&T3-QN^a@~I^Qf?Y;$88 zPcq-lC2KODduMUo?wsn3rkc-PMovWh?ghpY@rSP&+j;Gz<+;;426u8L7(lpod?FHD zD(PW)*FQHy%TntT*%Cyc<%i8saK1ffGNZ}#7}M-7itB7|L7PmG`m|a@76!W{rQG8#`BZ5!W@;CPn89Iq_MtU^@xP26Zud`>e8#qw&I;%=r#5+)<|QLOqrsd zc1LOh9829JO$DOZRH)UkX~k!tJf`H=dF2j~Dl59C!Doz;b*_p#IiKyL+JCO z+DQ?R(bd0_v??k59#Zk?o&w63Nt{xxX>ZkDv5f0ntr^?vGnP|mXQ|-1BRy_881dud zbaqX43Yb&2GV?m(N^-Q*!Ms#wX-4T+*>!?N2Nryb?}#r!WM#R?USI957E>gguHSIJ zAaP9s^2v79&lxtz$JsZ#uW3uI`fUj!bIn_O7zZrj?6!XysuIn}bo#4A&0Lz)rr0Fu z+?GHTdb zJ(?>|jxiFNYK%6$oN`9Nd}9K*n+5AnK<;he!Y*#Jc{bTGL2)}7zHI1>CX7CYwuT+S z3X2iJ>Y1LLjz`$nla-v#@yLPq1mR7Rj4mOaP)qffAwFu-nBrjFkXqr+imjQ%KIx9e zncu0j^^RXjCt8Izx0L6W*W>2a$Q`E+`{~t&@V%Agd-e;rISXk`zh6TB0N-^D1le_Q z2EOo?+-D^HsCEVn+2kUw*J*&~uPSG@uUP=Wk;mj4B0A||jbl1ALb)zVR4d`;ZBEPR z%-#J$BgJgnlWVtCAcd$lAoCs0lf&YBTm48o~y7Z5>3&tIJMEpW_!h> z?PL4$K4c-TaMA{m0JJ#Q}=}yT2^Jz@&?AS$Uykp z<`gdUfy^^^@FpfzBZx4Swwgx|n@XXbjP@<-t;%?44 z?(n#s>=R#Lb$JZp3d{hgv_;6&g%DkH2zxF#DpBa1NDhK%@={I*^!u z71x#mjZSQjb!n^p9Q|yi6b_(IO{JhP%&8Rv(+guI3?L7aFh5XAn!v$DX6V#6%Ay$a z0z!;=8VOKNQ%amhQcy;})kJ%y7(^ji71hil{|_Z#kR-it%hC(%qOrdXS?~XDlDn96 z%Wgu#>uF5QiEy0Wq@xm#nSV8;@^P57IwfuFR*|f36O(4*K%M)D z9JJxXl_RHsr|*FEudUL`{(sZ9<`LdfuzdDYQkEbo^rb@xriM-!lmpf%i6Z8Q&ByT_ zTZVDG@p*%sFH;-L2jDov>{#3%ABd=tOZ;<_%b^okl5uU81C+8=4d%acNfLAXhu;jN zjep5*JNA%E<87~VY14+|qx{y~AiUDiLY`{TfA`^yG^4n{gi*6lA?<46Y))jV;9;8!-jSobm69`vr!cv$vuHDc`!AJhsL*ugk`lJ z&1&I@7tSDB3<6D#rnzLEp0<*`taYM`12R~QOc5JfZWh*lLWUmJ+aTmfr#3k}cykRa zHN8!CIkqsXS~{3*Yid`ZK+*4+o&&e_wU_64$f2izMJ}DPU$?EPxM4w>=l4Tc27Q5{ z0d3TzALkbeeS%sB*nL0MH8gQVhr6%#E~Q;_mkd24#bBBA8E>RflX_k%6`7avVo}b6 zzMz4&m9MDo2U9LMBjGeV)Y(%B=+KjM{27>r*J;A1st}t<5QY`>=IeV1ninG}Z0% zow#^hK7(AWJjK8tzolC)dE0-Y+7;2t1ehel1N$h5-zU)n5PO?cTQ`X{q9x6hghT4xST`R5eF9GVk#^!WiB3e1)6nFNC z&nQ~h#16T=cTH7u7WMb*`FhUNyP?BYJ*?K+L+Vl^mg=HuiQk0-S~%~V3%w#f56Ax- zBNMEM(UzCoAn#{&G}ZSK-yNm+e&r*jd-F0(3FG3y!(KGt`iDn$;;kS3UI(guUnsR| z{2m&Wb$|&99$b!Dq~jni2RR zFBj6nOWYB`!(@M%=)|yKK{U}D!-~aGkJb5skq+T%?afrv#1TAhz~zX}9I&mL|27)l zQO>PM$O1^k$0;M^^`9Q9SR;rB|B$@=4=4jA(G4~7l2D2Z(Vx^HQ$%P2VBH*IOreO- zaRt3t2Vp=o_pr?0EAUQR@Qq$!(Wh1@)&1rlfHwnu-_3FISf_<5j=J;hA-=(RcX1%d z_sJ}~q}e3bCR*AkSnN)0+^)J%Ii?4|F#!8s2qZSx#;pjY)glt^4#$#37@nt#O)sV$ z(Vdu}N+39TnU0cDV(Rq@YC#Ex>Vammcg~f3#8ta5lmExdO#!K|>nbCTYbs5xdNFp( zAeNX;ct^a9k4n7m*VP_fr2ad80nZ+whNo4RO*@?!T%{*}-3xMs?BeVRwHBmSw|`4h@s-c!l2sb*9y%D*j_v>K?^v z^IVBoh4_>kn6H!5kko?J&^~^Jm7al`B*vNeGCdil<;8eLxq_%)&|g5E=Pw7%#f%cm zJJ4)=CZv=3Kvip$3zKetc`u8K6CQZjZHcGy~%?Bd4_D)3x`dEFS|H3#j{;> znWi2FR$y-vawd);Mu)ETTe=^ZvEHMV8Ze%Z!xpB}VB@Z(~F1!JA5iM81cbe<7w3i09^f45Y|u*0X&X*1tMCDB>)dUi2n0!KYsD zT;G4Yss2-<93s!|EV3h3q35OVSB5B!U9C^Ckp%~+riIa33qAMTbN-80F$}>_lU&qv z{93bI7^jaJ%)pN8;BpGtWe`Gy&(2EVy)LV#sKuCY$1`=Bq^uR2&ND(v$0! zNWO(1H3a$}3p$dU9#*bPl$jL}hT}Xjtq~&L-Xubm^q=dxmD~=51P1d5%~wfF+9r7G zFOkx%!`6Ly4eRJeQ*$y@CLD0WyLGF>`0D7+)7=pd+{JbZzvx>lW$+Td=*kg=F*7@^ z?{quGK#!OJ(dB??QCoO;N&!~Xwnc29lL=b#b5S4pn|Oldt6b)HZ*aEKZvZM+>8aCx zMoKT8u9tw_(!2E4ve^k6eVPs8b?(GT?O$3K4&8Xl?*si6BLOBpeXZwz(Z;J129R7u zuLIW13hjZ;pN=*AeN5JzG4o?rgpZ1X%qiI?N_%WKDj$PKM>upM55yuGCf7U7loYq^ zTNrX4A7n7gQ&&@S4pbDJuk?=nJ&()+{Q|^ ztT*Su_ze0@7UPDRz>Mg4sdi3sIG5=!yeZYVdhL%MnU9|A$>gt;)xTLE$o+0NWB;DqZQ2X?JW~Ju)9R1j5_9tW^UUb+ zPT2~#U*E6Pous7BmxpZAS>)FR$IYzV1ASCcf)zQsP4aVD2btS}z=uL+gLaK_>myJ6 z2)W|2S)0-yg{9)s^iTTxL9S@gbQcI42uY5k#mD7}J2bNl#*M@Y$`N;p{Q@4jqogKw zBhaZ)kCa;6?p6a^f!3J>)dohJYr^4MMD!$2kO+uvb7B9ez^M>LpY8L(a2Rr1!_^>> z&~UQ=+3XXxwU3AZh}-)>5a<2RE5Af5SG>2x+(AiT+*Y^-(~5QUvZn@a4cA9j@z-kS z~_yv@*)$UpkEU%1?%ajdnXALMzyY06fFl!Z#PS1zcf+y^ff(x z?nq(!OagOyoiCHl4Vsj29r8gyUvltgkOQ(c)kXN?lS{Un+nAO;cp;aE{%${`cr`yDUS>{t^ zKyzao^gW`-CQ(!yea=f?>FsWTwZ`9pe7}b<^XL~fzPv=I-Q0!m9J}~i#F;CYi zC{*tsiz+ZHFZn6+`NzCQQH&~0lH;q~eU7|Qxe_&T`y(pT#pLQ%RpoT0l#gOiG^Zqd88a(}*LTlzBUkniQ?5@r{ns>^P?&07IkjA= zzfne*Dq`cNNITiLkxF!0rHH=!>UNpYw4BJ)#8N;%QV}A@#+FpK63eeidIddhR7+ag z3`aJ7YhVP?DpkJf8WluwtEZSF+gM2_6rn1VR(1A(WY7yov*LBMe#JR5JMC`Lx=7yA z#{Hf_wpMMo@&0tKc-_#9qiLGK_!OnUfP+yPI_i?#Oc|BL8pCwyXiEp`5?(aYlLW|4 zt1G83(Z*}C1>pFM!6?G8QF0o#YSC9GsTN&JQ6-&$w78gz%wS*%_F1I&AA;s}8A?Y< zVGBl4(M-arLRmTT+{P@#k))>V#F27a%?=a?ZAAxu1a%WN34z(UOX&MrRdGo#bBx}v zEG-pm5tND$ATyp{xLs%AqumbKy(&~y;N$C0B2eEVKjPf4Qsc^rdXtR8+2E@_#G`|B zboaX`cW~&`*Ro7W40%ouSaRrYYR#?0%4N5I{J>tg^U9}1y67R9O46HHv%jwj?#xZZ|5CEu)1AVul@?_-?6wTMU;OEZC?c&_rvP# zDZeh18ov3G%F5qX<0`?2i2dO$70;iTH{%L!im7!B&~FdNhiTL_%O3_N7u4t-L_ALx z0?*;J>xM3XUd~MEkC_?9d9oi2li%ow>fOydRPGzs%3vO!{XlIEssK5P+ccE@s` zGvR9EoCVE?f8w5OMtDEvr=blPvu17HP%}T0ZB(Ca@{;G_19Pi&q7Nrats9HSV zWH0wu9tmTbTuDtjxs<3XQ{mytLjAy)qHvO&0k*FXT z3u)hH(YiEE(O*ADi1$Re@|T%qVX5|k6`|Rs5G-L{4P_oEc%VkH)JKug2kewPPcdg@ zQ~X|f(U!2F>Hvx=!ueIU^p5dvvU3lu{-)K$_O*uYuWc((UAZsc(~{G2uSGVRyc+X@B@?+remREd>k zS&5Lp#SM+?Bd%eQxeADx3!SvX4j_0Cq3U8nR+iom#LFd=q*sPw+*$saWDFT}N5Zg%{L6@hg)a~gFo}vpi-xRjv#;k z_sW%+T6h?eeHiIEWW81Qdr;TECMUl&Lc&_s$n&|gJ#^Ca15;%30)KZ}@+ilbP1QYJ zV#&vhU3PV9&5;e}ZVMmi$EKj|Uo;>!)LY<1DZ9~!qW`)^R8~?d4@%|ec;eOjaQWCU zd`)+*{Y^W0tT0m9jqVqsl&N5dZ}LE#;kzY!Rd%{BFGVM!%J=#2@$!D~D-+fj>Tk2y zAer3O7XS1dHe7^3yRsrJe^cP%jgl1$`u5NdI<0ZaYSdVZC=h5!Bh`>25=YJI#x9%drMl z(Jc3=Z8mpttwMsb9X303HD1^>CQ{5D*sLQLj)MP0*4PKB`e!F+K6mrtPv3}}PXq!` zkGt_ECPCPJ;$1>ePlux?k0H`*ee3MzNlB|{G+(}ZV3BQ<$6FI#9bWk~t*GxlS1I0mOv~75B)7Wjz z{7}fY&g@%*2Y!Pjvy#d(@$L6AScNlcVXpi$?S;>PA^i)B1Hm_0u!g0Sd@cy|3yn{a zKeLfTSKQ^M?qYhBxp^2eK0N~v|C;X2oJ@B}GfbekvfvAftdM?%opr*=1Td(XJ5C6e zZPT3y>5&{hNf4Bkzd+@$t{Rute>PY{=s%GH$xmR?IlJd}9Qg>*H`?A(?8(Y*snIC# zOc0y9Kl^;ZS$l(~f^V^h8hh$G7drlS`{4ymV2A^~`OZ(wAEM5tczMuxN)^~#LfSlh zFNpxx6T;5ypE!;o3!S*&OUuxj2=-`QRJv@C+C$~EVOhhF3bZW-zAQgfhF3Ak9&ph7 zGim1vF18daTkLUhj|Jc}dtmofs{HfNUWt%+=}OjP7>w3Bw|JZ&RyMcjK=8lK4PM$B zg6&-RA&h}9g7A(h0S+Snhk0+l5T!EQHuev5ZVtbtmwSb|pr%(us4X^{^Gk7l-|-=D zNDs<;SDp#Hy${MzULB0of-bPiGtjb|7iji2IJ;udPC*^@LR-6hfQHQf=j!>q zZdv!MO4%dBZ#`b|#MI?}4*Z}_=RF&2-CiqG`IAebi4ol1jm4k?*)`RyaQ7DCffA2m zwq56UE_VGs(~Z^>^AzfbB)Ao0EkaCsBx&Ok;SYVq=uZa{dkiT1N#pD2nKV2VC|u6v z^=g@IUkMi2nfY|A&})UY$cZ5=JFz92vYeciL19;4qO)Pv>SuWwrD`4VNr6Awms zI(WF`$liI>#j?l}F?S|{k#Jc6pBNrvQbG{Oze6E7sYiX~?A*JsS){nZ<0jqc6m-cPAIW9t(1kruF7?ycGw(;pd!5e>CLFc^2R0Wu5>=#mkJW zI&BE)2o=I3Fu=Mk+Lz_5D0T*pN^_M5By;ZobE+s6Y75~F0*36X;);;&*H&g!D8G-I zW-(pr*#Wl+bW3bs5Y>h_tQ1;7aeh#x;7=Jk4q)QLk<9i^kaQ zdc0~gqeZxLND-1|W(qL4b`~80z$WS=<85gj2$T$Oc7fHy>WR=LOUj-3TDKM-4ZCLf_&nXWe%kyHF9 zMjN16zNp@1@L6UNTQ9YDZKmgs2eL_Ea{8S-ts6{rUPG=uuLlbt*Q*Qh)u|?EJ9lKM zvWx6@Jx9n_U&03az@NQD09;}n7gm*te;iIqjpBBDNSk+wCQ=KmYTNGKU5?YqNJiN_ zu%JP7r2h>ZPz^;#C$-r_(kwt2xM%Uw`P~y5Wd+I-eR1yxH9m~< z9KDR343CX3wZX+Z1GQ0j!x4+k$aCcmQv=phv}Yp8^doVgyEn552Dz}(bG48tYmPuqQF_F%Z5m(5d`s@cVSD^dw5PDSgOMfI z(Inw?Lzxww4h%D(dshgB&HqyD%S!3$W`!oSn7t)Or%mB~1u0ze{9QvNV|km@A<3PH zU0!~ns63BKvQ6f_P^g{tdHE}FRwljR!+{3JEwlad*4=y5lF=1fUu#u@@b@NBKp|R| zMK*of0y66uaqwNhIE=}thNrcvtNINSU~|k9TCTxMk$xJxc?DI?aTOf+*aMNGeRl7P z+AFU`*+k*=3p{CP)oIsR?Y9m<7pQ2|)MwGY#HY!@WQr&@kWNYNR#gt5km&%#9V8;P zC@W$Pqq&n{M&AgPRi0l}w}z~El1U$AgjcN$2Oldp%vJ4_QI*19Lq{nk4(1E-ebN{y z?nDisG#@x+b9VSo0E4=-1VeMzXG>gi*bNps5ZvVv5d{RoP<-waDD~0m>R8Iku}yc$ z%b^dZ6qGdpEVnM}C7;oHp5ou`Aw6LktG2`)k{7`G$M#9%IKO!$6aR8n-als-4c@&d zvyuNuB?iuVIWQ&jv4-8=&*Wz+|F*9w-dD)uq{EAA~@oA;zEwf-P_@rGu~q;hi6 zSF?PT(>Plf1>?Kp3u!& zgBcAN4~TG)K+7TxtyJfU1rEHaaH5tRJO~vyohBT5p zOsrwW-GH?bp`32;C3We7Gu!^Dh+JWL*h31grHHU zb~qzoor*p#{U~X#EEqTDL?t*-NCB~eAWv5C^O8Wv?*Y@>-K!U8NtrbPsJ7W0CJqAx z^~bpg#dzSHnJ=abP5(mGxbZXd+j;@5J1}9`nMS#~7;rw0o&?b3{1_RG8Beob2qf%U zb4xnqM6%z~-P-U-EYBTG>?^v3i0Ba6pZ&JXHmk{NY*A^frms+!?=S@$AXH)SL#g}U zk!X~C16DzK&G~;6#@MJ`o1KwvZz#FC?9|`lebXqq*xb6$BvOv=_-9X29xRoW*LDfR zt`trl*^vPiu^z+*q4C$8DDJGCLtkL0b|o|(NB#L=2uZwGyzmj zsB!lD#ZZsSoG2q>1eQAJfRwJc41ieG)2P>n<=ZhbZcE>k-R7{lbv7FaU{esla%-v( zz$_dUZ5%1=%MM*hXOVDw53<-mu9@?pH@?INuPlrXp1a+$y&a<>zygK900_I!QIj5P z?K6wNr9JqrA*lP!1By@gMJ8Fc6tqt%cGAhX7(91hhXZCIp(R)UiL<}oD`%}SoXVdy zV~>#FrU&fHhmFQ2oA7pLO<-Zk?PE+W<{J8*ET=5;jBz$g=?Fz)?-)85(9K&4` zj#9ZDIW#M7!shN_eH~D45vTS|z#{##qr55U98UND6hA$q_}&p(ZH?_(&lgl?;l;+Kq`Q6&9&&V2AFqFREymn@S9NBcYX`tL)2K3 zZZI|{>it}-v8w1z`UN4uhKRZEBRh!RcL7{!zER~aE4(&)B|Cbx0*nhgrx7a5xMrk) zE{I=Cf-> zD`41AS8^m<*-H+{IMqHSatCb^OsB5_R*v~E!yQn8eTFRv?eOrQmy8@r-zsE0fguX(f#Cik}rMhK{Ust#%y7R=h zW(l8i0yeK8mvRlZ6x}C>KCv>-uhGAusQ6w8N*c~TG)vB*e>*Bp6)%fU*4VmAcSWK) z(_UgUL!54*X@$v8Dnu-3I=uPFejLp(rK3vbovEq0e+a(v6)icEuTXPFG9r>3CPV5* zdR$SE8ETutKKjA)S2O?BO|?tvH1b-{HA+YT|x>zY-)(oQ-1(zNa^-| zS)0Ejla(D~ZFtT4BMAa9j7&Q$H`j!cfiZh_voyOX1)8g|IQKPn zL*D||<49-*03wviK={Rl%-IN5g!i^4AkptC>BE09fKk=SAupcntB~6vUt)lrR~fn# z*D6hwkHR$7&V9$Yv6OBXhCr$Ff#(Z0DuTdaXb2|WB3MSZeAmqg@~=NR>fYbc004>+ z;s5|pLWMffT*zM2U^%xZ1o!f`I$K@EvHVXkQVys^=O25O+9o?)sfZonH9==1f80_a?dt@Q{3X0%o!rVE2STVsZ>&5+Cs zX4UI7aT4%J(4ENkfLJBq-E%=ldyTDwOS4SIOQ-@YeAh}c>u}q(6~pwm*v#`e6?8qQ zQJ3Y)Y3;fHx3j>pUJQTMx@SUyeT_oq*I7f>W*(UxNMNW1RB)FCIC^|VODUTb*yN`s z9WhDRW@Z4P_Xh$qZ73T60cVB77{@9-<@EQ!c)vLvx4omhUR)cVU;uVRAmU&)s1o4n zreL0~)-L97xmKir{xd|}lb)!dxYGAt*+0@^$R}}RFKPV+9mpF3F8?6;s(`HD&Y&Ad zvCK~leyPSupJ>&5(<^`CvrDt%6%8D!=TI{TCa#~QKkd-mC_X2No5kgN>)zl7EXc(& zZ@pbJN$BHH#75-`kBnS>rc>fqM@6J@G9jbukq;%EwybyNo7aD!}M3nIt z*nMVfh!a{`&dQ?CeY?Q)ANHfT1f|Hqw&6CtU(msC);?v?e^`uMQ60T1^(-p*;0{OO z+`gOmFOGW=_E!EUprJuFed)+>*u=k1#;)$OX8@=MoN{wjdXPMw|GJC-wdy*@U2e?9BH@jATOc9TO6P@7qz7llSu zFUEadr}jyp@O?L1&^PJq~g;H9utfGJ*~4rj@0N{hS`YE);>h(`J1 z8E{73&t2_*G{(8*aIClWeFR5_+dhyX3|)mtoo0gVdDM9(J?R8&7U?e3%v}S%*#dM< z!K>wxQP=;qoo}Y-o>*Xy8v6$Z~!v@#hRDphco&NSdU3S?x9}vNvGTjlF}d#V1`VBu=R+@ zjlK=gHt&E!LV6<746v@=Kr83|D+ThsS`G{LYkt^8mpuah50Cr1z@_)kkME@6`Z`?G zI{xk!GS4-le-rJyX;r-v9P~#C>g=wPlfEYFR`8GPXm1bU_5*Ay~NS`}!TkPW=EH|Igs}2@$ZYlZesqjd9#-xyImL!5xEuEiqHK z0FuY7o(Be4oMkUw?rsR!G6J z2$FGTtuEFp;LVUigL}WSFNzP==9_;ywxu4B#4!CG2D81m(&TW|h?rj0H@V_yI=Py8 zoF3H(IN!(iHF8Ikj^eP<9n^vEyN(6gK`ZuywPg8fi|cwf{Z^G0tE9nXHe_F!>o3qw z;6CY_!9G7vt~k(y!7HSUdGApFdLG(pdp$jRfaYn5*9rsnpIv$K>rORoF=zdgaz0dW zY@98SJ11aWr+5?`z!H5JQ#eYAVypX^jZ^)b@l+z&=vv}zcLYZ7z3WZvujRE>f!+}e zkXz69tEV2ni0Ik`t0`Bp9f5DrUGp^9r)@CB{+cyGWD>zYt;suiEE>x8?j?T0VfmJ; z*1%W`Sc+{ucaRI@Lh&m*(28K?Izj|<@YlC*-zlrKGA{U}zk`s&5Wk>-AVx*ffG0ow+D?a63X zhm(hwxY4i5uXg(Oz$?BO_1}3KA z*glHaYQE09?6K^pi`9OxLi9OOFjRB3jKfH?x5IrdJo^xk8d{~M3`eQi`+bGll(L+H zYNuNPZIR<5R(C6Z71a)MQElwGG z*(r}*?kTX~%qc)GRbQQ_6To0Jp5Jpigm`#2W_7hE`pu=%10Twwz_=0cBr|W>Nsd)KWc@1!$zE5 zURh}0()xMf#EJ23b7L}Om*M<&^ckHBYQFL}=Y>h~(`InNR~;c&z=`1sQ1wSv-8uu@ zyPszE7B9toJxB#+r0D7`gh`#61guausm@zAvM)g z_$rLW4#bTQ+u*Y!-wvZw#G%M@)JugW(xZU1Z-W*wizk92t=?HyLpLkh-11m*ndNk2 zEgeb?IM|{|Z?w{gytG~}7BLa0y?-tY|VBeycpnZC7xy4be z$%$TZg#CTfrIk{HYE%z5smO<$3s(x-hPR{+a_;K$`winI+lp8w>=`K(xKJ^HCgK?; zbeBb5fR;oa^hNNepL$BGA`#a2M|eU>c;dv$W1Ow8ex!R$;fng6t8wJgB)=V3o5+X# zB23q=M4~YpKMKbA)$Q)Js%~00&X+Tp5>i}>HA+#~RUb!Jp4b}8Pl#*?|6F~GJL?*xid{L6Lmz5et>L`(P}5{`vViab{gm(W z5O4%g6)-7V&)7cn9_!We+1!jx5-O(hcOzw~5DN6d0_l@cW3i|sl=y7?jQ|btp2O3H+%%w&?mqldTCCp%`?p{;*$}c-d+y7#9Z7+9%WzoI0F40g|6l`1 z&wN}D@Gnaf9O1=QX@j^$fc#)fWdOgc3OEaP1GGMVR%H=A<`!XX`kz8jRw!pRo{`D? z%0A#@*X|~=CUwN&96{*OJb+}?IWFK0J8BMtVR845aexaWz3P@_%c-MDsa z)+CJ|8*>v^AHy9TE2s-+7O2T z6OerWAF|g+dL|O4)|i2czKg1t`=moJu0_?)9S{o=gs3C)%CGp`AT(zLo{a#+|F&EL zUosR;zbEd6*?_Ax&9?df!|#7$g>`Loy|*$;uwFO&Cb)3;MuDMOfT!Izo~Q2%Y!hVj z*Vyx{B4qB7dbiK*ym#nDfJNN4OF&C#@42Q1JakqNlybe^9f$y^XWQH6V6N+`~ zo(*RdC*V@PbFhd0=Sl)jGK)WfL*>6652u?nVDACgYypx_z;ce(h<5Dy*wsMBOi5zT~bXHXFG;m~;U*FL}%hG83ShSBya>|$UtnJuE z>jbq2ns&&q^=W5Sj^n%p3;l+()pjJtm7MD;+&ru4^5Rtv)@qz)3hMr0y)PR_>=Ob1 zmo)oCM2{Owx_O`B%U%INs8VMO|C1}FEBQhX40hINslWByjuz14e{{WND*an~sN3uc zjzQcY8t!zJzrV}&D<(K!qKyBxApWPvW{?-MwYL9nvc}frzy)5S#Zrz7m1>#)hbQ!X zp%KR+0pg?Fmt8I78X!1Hf7#f<1yXzKz-qhNeOZZsn*M0k8W|2i8vp`AvTj&~r-S>; z`F}z(R{y6)81jJ|*o$JRfxbfI{TJ`>J|zQFh*z@&V3Uk_6AX<0C1dBBd%^c1-JJO0 zLYs5`2S@kgJ%nTJXrmk1LsQ<4HUBcQqE&w@qWZ*2pNr?z>ec6) zF$FnJrxnhb3&>}sPGW2$8{KsT9>_(NZpEsJ0@Um6I~ju3RB1 z{4J9MYzxL)SNoU^Zp`N*-AxUrDUs0@?}Bt?#r5ceN*nwX7+cOnhqaUHi&)eew?5GD zsVNg#y|H=KvDg?N-Nj>n5q#20>bcG6rx%FFYa>c;?pC|ZuRP^aEKWv8r7-+~gfBSv zw-))&wqv8AY_!5xmB9i zVs=RgsM;?)!lc{a%~i{hbG4!n#jxD;pj#Q1&i3#M_%1eyc-xa&dZ(U0$#%;T3j4D&6%BjzxCu=;)X?)a zNuUHJwKLK2zB2eg^LNsD2GnS1k(_5D40-X6P~C`&-#SDysx&7Cv0fnQs0OR`Y)BK= zt=3HT<2^Hjmo#$W$|AY6l4f|qt;rXp*0f92MA?#tAQn=dA{0W0);xwMy$U+cq7NA& zxW?QrvbHWAAeo2{4$_j?y1}oP#q`<5HS!vQ+Wn8x7)Ux;%iLsfS23}k_!@u{iMg;0_!9H0>wduMCq_T_ar9Z1%Ky!&kyYlW|;1}w7BioJCbljbBcr0O#y44 zaajM-HmEbsW@qCvT9=i(coA(&sd6mywm{Phq)4k<)0*UuTT@+Jk8YV{i{E>(7A2Hm zNa!|fCTjB#%(3j!)TD&KE({@kDm8?08~gDat%cj|6Wof0%bapjz}lx4D+$U5x5>HM z`uHYMg#$|uy}&dVZtGvd3kPS5bVb~5Qy}FD0@aIi%#}T@5o&P-3HkPDWj23)5Xk&; zR-SJIp<%vaN~Lq}N})X($vL;!Wum^(f>F`6{|Hiw$n+hNkCbNuMa-;Ti3@&2yLX9i z&dU4Pi0h}8ql1~7|9T5*mo=gqW@7e|kl1MYijH32_w)n$?<(frl?`yNW}_X!>jAj+ z0uRJlCady+zO4PTa5{n>gnSLg5!#3LCB&VZf*Re#`)yo|%!=X~&@?!wq5a%);{lu+ z&i;}m7Wm%yDK(xVKqjkVNL2(oIJ5YEz}%A2QquWFFInNqbgJG~@D;J6^#|MbC2dO-DKx0~??l0AA4j0tsW3I2LeWEqu&qUFzTF9U z1WP@#kcz$Db+akMtrr+&bH$VF=eaj zcr1jTJm?K}qu z(s!8?rkd5}yM_vNVvfIwVj#`Qc7^Np1d!wpgnkInb5|Yso+-$W|HBGj*`O}6YH3Ka zk`xd?i&yMTdu622f-3mB4L{v>7SNO%Xtdm$IzhPvKBU&q#JZ_Z$F{<@Ievp|Lsz z-Qmqo{$eb?LY-{$EEo~3%h_@Id|cp9v~Fr(s*}vKFe(@BtOju6lSpk!u2_=y7w>8jFa?)qdR=ehQY@%QZC=gT|b zG{VhafI#TWJD}H{3%{Pv_h)vW1kQ-|D_8#Bom~k0J+tq8I{kA(-ubjMrgom1!~eHh z;V*Qv659Bs3P{aeo}~i3|6cB=+5?YnhU)vF{_*#T0-h5serYlP_j&VD?&nqL-}}qM zzl-;eD}NFHzn(-5{-Vwkga8AxNBsZ$6f@huCsDO@V>88Ze5+^w26*TjGxr-*atsrF z7nd$Ck%E}x#m>`pH3i&Is{Qpo@gYd#G5#3CU>d~7PjcMseC$AIx7MB%d?k87Q#?29 zMymp$P!n(TylSfZd)v~CY+G(QW0i^blY;Rf`O|f4YmR@5Z_!nwnS!J>tjJu&kuQWS zC1%FNTe)cL8<`}0=aGeO(R-gt@~j=jM3)f-hSvj`@}Oebi(x#}5ieB473g_X?^x0$|v7V>*XMhxP+Ka^fQ(Mcys3)ea|R2t)n$z(BIbunpWqM_V2T!@qwzOmlhqVew_HbVy~Krl$DZkBQ2C z)zOo0@d$C~YfMyOxgOaCboiO}yM)~l;tfZ=gRlSQ$FEyEtC2mK9`y^ieypvr>{FfB zD^T`OLbI}pj3f1HZ}+?I3!B~J6ym*!@4OsA6TjW1M?Pu|?=Zk&yX*TKBQQ;_?_S3H zNbB#{n(}T)nC&4-ch<(oV(j4UENI;VF`U=capT>#XMsVES+3@;_N$(4G?- zFg^r=-@jixX*1C#Sem=!DfO5vcpCu!IZ6foHI@)jD~8VnN9rhlkX|u1@1qY^=O6g% zW-!8-+dn3#kv*VYBE5X9-9#OZsl zZPuyB5eBe{!{R@^h7d`C-Z>L-N@sLsdi+_=x=6b6!50oZbVB2lj#>2C@V*e+tNR(d zfkcH!(t2ctgRv#46$e9xMM9m09^S$|RC5r?g>Gh;leelw`tG9m^tHR?ckup-tz6D~ z&9N@dH%+9+Z;r7x0x3BK3sjm?L`KH z{fYNBEinc`kPR1ySf~RI8gZQR$T9^ zb4-gLh}#lR1@uOFZ~G%n4dj?u=d=TAG>;Sly+kUIKZ#(sPX%!^rc@gLFi#2mT-$^P zj}+;u#DX$QY$TV0^lgCoimV#m%8F!U5m9+0gKfV^j$jB%Gzmc=m(%zL-CY0`% z%!)KRWD+d4I9Ha%((sLFA``k&7sG|o6vN4QCr^bY6miDB9xKno=2HKi{dG)olh=)LdJ+H-JC!?kFJkw>~dGFcE)q9RX|n8@h- zydHd0-;H$Kn8)lRb2LF5vpXO2h|L01Fs9z|L*Fh=a**a>@r{BZ+|BD(czh*l4qtfL z7Gnb4NCn>}=?B|j@V<>@s(MQ9sGwTai-3)OjlIwL( zqj|9tzZ~}f{*k`1b6jU9g+NMa6@kta&djnM%Ka#t@|TP?To|VaYco|IgN5Di^#@Xq zQaTHiLXPa82y}5z6@Gm=GhMwj$FOWi`d%tSJ-U5FV=kws&l+>)L3VVe&%XXe94hzZ z{F;{Ed}&1AYnuCT_99M~w$ZEB7D@oK?jfrAbH1Pj7@=vRIkWK|<9}PY&`H->eo#X} zDX~ERU*Ga(gDhN0$y$~hy$=2>u$zMT9;r1>*p!(|h=x+fs6U`S$TEx&Y8~Tt*ARbV zo$&R2xKYM=XRW7-~|)xkt&{nXi%6w_r=bW!=)JS(5O^$NMGwGZP2*YIo0h z!IS0IC7tIPPl2bZx)z=kj+2qZnaBI<`-CvvAK2$x=wlwPLUW00f`W|=I7KY9?%9i**$;-Ny{d3iKN7N(x|ZfcM2^UXHP+?SFT&q!NO1j2Wwms9A5n$6K$AAt{DPdpuUvY#Cs z+dJOTvbnflUEAFc)ZRQATpSc`JSj{j<`$A7-n3@lx9%rVeOHTLc8~)-T0h&|ZECjc zg==guTE=oF=1NH=tV~KPtPt0D9=ai-%fw8e=NmJa$A}nC{qEk5>wZW*u)4oL1|Q#% zRz7)p*gVrcJSRS~*&32PEP!jD8=ua>&O0u%N;@oM!7zdE~LY}w*}cy3;J za;A9pu%GvQIJn-rEOU3aAG>&F<=ySZO++ht_98mx9%Y_Ujv(667b^L!{j>XZ^3 ze6E$+d|INcuQy76_87j!54dV2ElH_mOkB~EdoF*z(5q>*T#-8_HYF}1rLP_FEUxLH z=9Jdim;17zaqa77(%NYiZ~q+bR5Y&ahwT}+sb&CP><4jXYb0#f9w`L zqbAo%DtBM|yyp|#l3((2Mk)Q}%}7gR#;x*XWfF%rqCdx?;62B@oH?_WYVjl2ehV7F z4*UAaI6SxYAxOEdQ@X9rZcS)Wa0GGuE9d&10NZ*`8+c^Cswy?&X=s4A#D7%p( zr*SjqV42BAHF08lV5jqGgw|2F5uMND`-4hFojuz6+FG}N#N!;|icX_o^Z_`NsKV1N z-n|9f8P<_2u&yidN=)HA4aCs<_?mI3E-e_bSYLj~cbX}0?L)-fuiwz_ViNpX+6nd6 zo`nOXgJTQN`U1Dd^Jq&bCORCzo+#P(;nVK(AjVRFGgr(*K+IxUED^~UBE3EYhudTI zL(qxuNy)*0_hKq16A3c{Nkf_g*TV%uP26raJ1W-WW8k^k`UyCOm|ev2TkGp3MApj- z1Oze(2RzZy5u#aLTjpScAEFXq93F1dfa76y-Uf`XyE|y8!bznVI+z~>E%jZiVO}GA zviqr*9-aAh_gKmXvX`Ps)ICA*k(>u`Ek3Wjt#T6~g~ zyP?*xNh~|dYQt;aKR>>GS}znZ4b3()3l;koS{azov+`nUOe2jzAmuzg>p^R zxgtiU-Sckf7wmjt6oosJu0s*F!ldJWu|1!({MV z0~I?3w?lfPHQ&t1S>RNfPSVH~_Yjx%?#&&Ep90kt7Q30^zpQ>52@_;WXIL6W36k4$O$Q#A$b_%)w0OS4KbCxkW9c& z!h69_!IyjVB`70}m~Nt73r}+0#N`=u)GFEYY|z#g-8TpPl9(D+Yw*V?O)~Mh$BKbM z(U`te&}QhXpC7VGrx~TBAt!)yd%zXb4Z4A;Id^`S+VvEiR!CP+aoXFSmNf?}DGx@f5cnPrO7zTkJ_Wrb&%IzwKw< zb#p!_aojsl-OAXji*jUnazp`rTEFiO-7p<>LP0dEdOrysdso3HsOEzv#G7HjEPFmN5$o3oDG2zw`_VrruR=%13avAMw{6XCV92^t{=} zMaPpVRoib^_;gBxSa*g<%s4SGPZf&dZ_qMh*)h<|B{C`?Q6STO1RppT1nL04aLLh_)F_k@XjAjTVeUti2sf? z+H)Qv(&^>Ze&${M5z%v3R(?S)G4jY7_oR{fMVpzw^y_&8k>XdO!FPG5U#x8Bp6 z(bxCDIei$TXeYQcYiDhA6L$QU$E1eKai)noWh$Znw4G;fkGT8nY+e7@1&`E-JKNL; z`=u_x6=@d|^r1yk4HsQoe#S|#_m#HwuggVhCG6dD>nWqX`Ut8G(|0FkB4#eyeedc8 zz8h&@DbyTTL}%{^B!tsCFQF9^06LaAzi#%9UjWDQkd0tG^NwOnk^VcF&dVkWjJ}TF zll{*nTm|uNep5i2Xqn(io1cv`zWNwz%`@#pjX;8S*x! zu(pb>mleuQYwvaY8-<=5;h_Ue;9}{+e^9PkbRqGVPi@FP^9udotl*L+FZ-_G=N#*B zZ){_(D90^gwm+XmGPlm;-&P5zFmfIKqQ$>>*-GRB4f?Ahd)BsOc0WGn`SqKRUEKzR z-d{qZ|h^W3}Z2q@Xw9nd7GI~#5ph3 zYq*4Cc}D7a)NF8jo-IC<<+G09O7tr3aI5V|%HrRy&?9l!Z_lkGY3%du>}&VADnb0V zCE=3Bph)ByshpgXz&0r~swdP`8drS>N3%}Yo-=G7%X4oW{N{vM*lYudOPcKT`>9JiL=o5fu3y1z68hTXgU5HfMdSxz?23ATpek{8xBx6C?&%-A0~j>a{T~FyuQ*-SK2Tx9H1EzLV#{r zex;@P?u8R0>i&18FY0y`{p<}d_pLmG8k+3pEy);@3+T5s|rA|Fwoe`P<~V)zNn_j zupKI{3|F6l)B20F50~MNJG))}a1sDcwN}Z79(@|kNLP&W5-7}jbYug#8^6@2P| zj~jHhhOeE0;Ttv$Vx!R$V$6~a8~Qs_Xn4(ksIQEWReyz*;$FMHWKWfPja*z1?ar`5 zvfn8#q+Y=lIBK)7<=DsW&cN9EWdzFKZ!0DTM9YA8ebkQ zIDQE~jss-~$mj*T+K?luIaH@`R+&OEziYHSWC`C8ky?x=`cPLPbssZ@^}f+&co%@| zch+H-^kNzj8r6fvrJb4wLAuV;yME@(2qJG}5ce{Dm-JwkmPuXPK=tY{KjQnQYqq@& zaTDW~I*9>k=>mY$FVzYs0sBR_q)$5);7AMW4gP*;hzXEt*0hc!D4cHW(zB9~eANQT(N5n@hMhVfgX37aNza%Ege zav&d4hCg)+qP@)GY2&_Pxl%q^3xLuwf+3uc5g5VCCF`~&u>ZQ|NbXJ^7sT7jQI*s* z&L)1(9n1KEwHSAIY3nwjHQ1@a&ZBBL`NoaZDuv%6txWn&3g%J~Y50WWC=-JP4sO#X zPi0ThvF}uy;@~tN*T83}(3_YWOd~xOMNB4RMrgj`jNRlNBa9G~RM-~jw?9Y%uu;-L z3dAr7*2t?SViJ~I)ZSfeu>g+)Q=bdET-ly)(A(>SE5Nk>bRtge?QhJrD&;KfWzYxX z^)In(DNB_eZ?k%UxbUJ|{WZ_Vbtc0KSuD%Bx z^4g5S98r4Z;t0VPSnkJHM3Sx}F)iXjWpYh+zF`2I6yJA0H^Pv*S^FGF-e&wZ8=;K` z9on~!%j&d#U}kNZL=Fap-km0(4jTW2mbA2_uVs%cY#w5+$_2!aT=XIWu$C!V2obwv z;)#VjtqO`?)|Z1R>@Wlr=8X$O^nFv&Y;Uvd_#v($&#&Y!ae}e?!~}GC zC9jc}J1dwZsL+BmO`eE)5`>uPvM_CTGjP8@(RjBcN*86oWtC*1Bf%>XP0i2T zt5P_kz>zv8(E6`H0d}g{I7!b`mrO;mmx!(|h93m7)>@!u)lJa2rA1scv!@nb_LHc_ zOk+y8;HzrxfB6ZsEySOsVghg0{y-9N9Z+po>--m%Lho|_x2Ls;wuWc6T=;~tPytg> zRXWyf`m!i4G}923>DO3o6YuGbf2m6eVj`k$SDm(;yH~K!aq38ALRi~XX_cSp!`>4! z{hH{whtW68_WuXs8BymkMTir_2Ff3%{^&CN1SOX^;iDT??MA+M^+%$g6J_ZKhpHwG zkWh13lmwpXajgz$UrCe`6tA!tTvJFfj_;!pb^VCN#YX>&?souoS7d#r+%LBopxPi} z65^?T+e|NksA{$vs|{TK$%&PqRd7aXV4e`cmvjS+E7L6<1wV%^ST#{!l6`2xSVl?m zWD0XVMJrN@E%!_T8hCz6Xf&1>I(9T*hCwUI1hky#M%ZQL%SnFt)~Cs%R}>-;E{KZA zMyHpApv;L&cc+Du0@XH0G-)$N^u^4JA4M2%p#U#rVS~|8&|KSdRgdxD?UF>~+P+`TmtKfCE2~%hbQ4J{+RL=3$Cgim8DHuMzpW+Sjgl5nd5*oBC z5ioZO(=pnw-NT89O!)MYzG~99$-Fb$N>vb2lN6m8ata-vHTBlNr^#_ZRfD#W(U3~S zxQP_JT}8V5Yr!38JgW#X_QeAJh_BxtXqG@R{t%Wsciq($F$(Pfe|1+yqx5vv#Jz*dHvH$`oGUpH3hRg8-*35Pb)31EvmBAs%Qh z{Zl5GJF{t175=$60eQI8Z1El}#1xK3sMqXfd-$tfjXvJZ@Gs}oZce|fywrb%hnS*j zCuBIJ$%6uP+M^EvY()~2>kbtsNKB@T=zPTt-WJK#c5kfO;__d>pyo0{F$Ih4Fa?Le zNDast?!n0Ln(Zl{%A;DtS{dnGSzF>GdKqXFJIzZYRsr_}GreIEO5H`TRcKxHiDAV3 zl>v_L%UvQ(sU28ERNec)!$R*hl$yKuXbT~*a*2%I44Kt-AFbL}t0Q__2=QC4p}iCU zZJGq|L*iz8S*u>{C^eDpQ;Jmhpa3=(ehR?9aUb*?`$FBa*XzAvD6+lAGcdnkp);@7 z+a{>KrmdLJ(-UZ8{A~hjW~BNbAx(Ijt+mSUIIo%y9})F^ac|3ba@b)a1E0R@8A*z& ziSvz8bzOaIH#($8M7pyxxwYe7S^oRmQ%o{m*35NU zC5htFHa%_xX;icor3gU(`b#c!w8M!=#ghbqxLC5*L}RW6y|_nz3>Q@S931$Oq3K0Y zVt;DJ=vd{K@;YnTw?Mv|e!E&E8KOR+>xPLcr%}3$uIp>L#8Z)Y#jKM>q|@*oZ54L8Hk^dv@3r| z2jEhLs}l|H*{B6AS=d~u(ymyzy|Ko79ezaXZJmVBZO#0eA@W@XJiZENv0Km-^Z_@0 zMOg30LV?$y4NRt@stkTU6WKz)n%-hJ)=7X{Jlk?EV#|dNo!L*n+!?)H)xX+X1gdJ% zdTVX;vGYCJB`{yxxMNg<7USqe2vt55yJ<~dm6cTWa&TmA5h4H?>2AFT}3*?s9xZskMOkxbL^q7i7>(zzoH((=n<>dQjgBtE^nlY@HOdRS+DF z(dgWvKM`|-6uwLrSdOg`=YeeB7h`dM&;r(LAWu4KGo20NZx?pCQN0w<|L9!4iuahG zyk-JEoPJYQ)kkif1ql1O%&MBK83v)7Y*L%=8W`g(_1}1s_LEsag&)#dlJvIpAwv-Z z?dmc`71=yf%S3I@>qGXRWW0ERYBH+}^oi`P)Qo&iD9yd)-GA|jks!sLG77GMqtDec zvET8!O2VBJXVmOhLhT^~<_zsEj~rA$Osrj)ODF>C0Tdu9w^y1R#TOi()s;9?;cC zOd`z>iB)Ssqtk>}kT$}XP7T#5DOK!Du^|@tg znDy;lfd_p^0&F!qH@;qPri;c-1W2OHi`SmBKY>cX@;>M>xXWrKaq7|T6FW@bBls+E z|7@?gmkQW1D9e(l7RLEeZM{eWtgRtMT9srml>ow0myI@mrOrTV#SfU(hcxOW+$vuS zt-TCgm;sXtbGTWqT=)n|biTbk0|>~~+upw;ZShr2(m+6mQJ4{96o3#GN?}7a=#5+v@+B7Y&Y9rD3-5%MTxGO#s z(N5KBxv00h3cCRo<6#cf*<=F9CXmPl=rArWNE>ZpDBWG&z&?7EpvA;JX6 zVHm3ItBBG^tqWholp{g&DbPyYV1g8HO z89%W8IE)r+*RBSzLAI^^S6F5hmUq{fHFzg$5ZJ^14Ldmm^40R+|HC;2{d%{yD_}40 z^EXj;KP|Sjjx0X<=7J*Kw;E%ORwBvJQc1)|AnMqXA?j=b$^8-CT##IVU3I%*(DfDLPtR9_V%JM$mqD8N4a6JS1?$!H@qQR_l~G}!RuMD518af`C&s7|5t_;E zC6mM03#w@y`egXff<*tj*)QBqCfGo~M&KAW`Otdogn<#Gip!KBp*gro{j0y-A`xoC zogH}7j;!i392Vd~{kb!?u+yr#urYDHPOVh!8dCAv|*FHd4=TCFBXPz_0U)~JojdeORJfDJypd2h5g+`h-0 zF3L&RG1rZG0FPM2nQfUqywhI^omr>l1vC}<1|7ECuT}g45^NAkF7bIG4&~*N_@e=x zN!^)4k}sE~7FQjt18ek3Ax-**19@vveYf>$#V|G%muMJ^jfYj~(O0Tz+!D#%>M*X* zQpPhsWON0WQ0qD?o{~+@_maC60NEbCc23qRF!*z*ub$J^H(DLfH_n!uGbBrOEV6@E zzDIC9Oq7N^g4$er7+`Dh9`DK5*7$``7RAY{n0JEHqzp+mNbQcqAFE!16c+3A9el_o zrcb1fbC!DL-tnNb9gOudVm4TRNqW78j7|Jm*QiLaE@c1%fd@TnBCs=WXYnI%J6R5I zHy1!Xf%-R97@&Ry9&4{l!P6A{A8K)qC&=zn9+BQ3VJD>)_H>J9dIBg zT-NUPD{Xh%5g$_52P#B7EEg8>=q51r4tgR58WJ-krR?lCpzs$%hP%6pbihfZq_|R>_NVVV7^?sf|8ej9axqaB z8~sY99;-o(bAR9q7kU_NEK_@A?#{AQf=wP6%UJU7*lzBu?8{#8TIV}Z!9sc~>#CP^ znxNBPtv6r$)3@Eznr$;%lvF#oez#*$aX~cGE1}yj`CAMIb~<@NzyN5jEK2BS+MiW~ zC%*nRn6yp#Yf3oYhUU?WWFYMBy$15eXx(Sz9iuUUR6I1*p3SY4@{6Q{`a4x^`yOkJbfaz!ao^t{!5!N_ydPj=pB%CK7%9?LcEBi9f2f>Hw+zNckAlN8*O## zK#>5}nmylv8jgi+^?w^Q3GV!*(YybFV}}uvS71`~PS~F8N^woru1Fe#7xFAy*Z$)` zrfz?FN#kfAp7lQtEI-!Y>}3-dSb)S^AerVf@FABQX)b2ilD~s?cO<$pufpn1x9<9j zX5*?Ny8Dv<#gW&4&`bnqDzzeU+LNR}9sc8{`8&`w2GS z->mtG5YiV(?y4*pqvIoT{gXXv&3-c7pVq`yEw8QqjUwl-YzT_5=Hy4%)7fMB9KX^2 zs(<|Q2L)Ko|3bms@DB>5bpM6Ixg_^b4ZET*W(Y0Vt(LXis7!xwAa{pdM4QwTD`}tpk0j?99B#pQ2Pw z+1N)y0<8MUN*i@t8w5A8WQjps#?X=Lzzvap-ZVvYjam?tlIQFtP*v8z&7CbYsdu2s z2uvuh%{vid(48;UU$Xm0WRNy=E2J$Z0?xmK+#G6ZrrG)dY(AK*|0BL6_D4L8d$Ym8 zvAJRoD3(8_621Rq)dijFJ1`-0xGFB2&T%t-icBAowM~+8{7LHgzOCqpJJ+A8;3KN9 zbJJ<(vTFW}tOTjbC6+(=;FbAp&?s1{-tkIe`q8;d&}^pn%X}dwRCkOvCul?76aPy4 z&OAJfwq(a9zhOg&2e|yX41smAM+ZTuKoFRjTKZAelz2wG=yoe%T;FeY()qC=)8?Dh zpDE%V1nC%9Id_l>HK2s}@|vEgesDgFHZ!FXh#N@SQ`AopJ;yaS-c?{SNCELp*jgff z;#OWle|)O|c#uRXZ4FFNN8c=BO~KX2dhLV5?ihs;4WR3>{UokGzB~0cWQe0GeZPA= z3n|b`-@gJkMp=+ak`o4*ByLf{DaDWc<;K0*em zWT{{K5daN6@TbUdt=g#MOGuOX>k=pMpQx#hDZCEyj;YT3aFM%q>?pkY+4~F?Cd9!y z-LoFxtIeh}DM@%@fXSO4i6<)sbQ3ME44}7ML;5G^%_@@%mg-xBBuFqKZy%?kboc>_J9fWb+HaENRAQ(`qM9A z?{0^t8YcU9Z}8ToH{Jtk3rS2=i=~Rwj!4#-mQzFg&i-hP{Ug70`CsxFe1CEr#rX$} zJ>7r6P<4jnbIhId-{OseH{td_MW&8M$I$^Wv?)SuKH4@xI?GRyJw&^L#6Q^pGyK-* zR$&UQoKXW>DKOpH(nKKBJ(6je6sTD94H^gprNjWn^&jzfAU%^%f@`v2^2K~V5P~u> z;=V&9(=cQW+6?>KF8-1KLu&+Rkaj@^w2KfwYe?mBSOE4VPAx;;0PEn!Blj7I z)^bUmc+A#fh64i5E(Ri(KJn@gWDs=Qj+9SoqRt2)rwu__@J~F__*+0c!06H#4NEKUe3Tc{-{d- zy@rNmez$P0WdT+&yHWGUqK_M|?=(bvS?f4<<$Ioh9)Xhnpj*q!m)CS&IC6ZdF47-& zyM624$Y0EnI}|t4^SE|-16+4*=J~F7Tyiq7b(ATX>Cx2OLTc&RM3OS_Kc5}Dta0Tz zjJS`R$jyCR7<$_Ja#PjJ?Ll0VxHEdba3I4?JD=EjymwzYpvYrsn7U)|{M5vIbbTUH z;u<%AHk3GE;0Asu2iH8-4y`R5KRR7CxLZ>mA4U_QftENeuSuRBtDcdbx5F=H9`~v| zd7oz-9g!A%pBWvwo#syDcAl-c-5NbtQaqmP=1Cof9h^5JHjnQ*U(Xs;^46o)HtsYY zbTW>Jab*eKfL36JXU<4y<$Rz}DBhdK2B!ZrpRK{;3poxL1YAg5fas@$wl<+CwG?6>)X13x;+bcWcNwA(ksxD)4^^Rd^{Z1!% zU}lE1=MJnAf9vGJ!!8&$wzmm(a(~{-79bT6c(*KAac-6Lz*YEcbLBb4Zdel%nz+@VNc+WkI;AqJHQxLy$k6iBc?3&zOr`DBQ5LTiQ_OR@Qa^5Uu^W@>!w18GzE7l3mp_M_D$GD3f&k09MQrQ9!dtqO_OH+KyNXbd%XZGY~S2Mm{ zz1;o#F0lJJvA~lmze-PzVzJRgki%$%{i7J{$y82#1=z(YpGwfvRb}Zrlg#7Y%zpWt zikw^lycpQ(yX;DV9?s#{yK;+!JB<@gku-%wl98*EsSs|&iJtGb_)E z$pY@v-zQZ!LT4}pEei(}!qB_G@AY=6BCet^9Z6;I`GTCP)%v)W9y0^s)PNhQ&XpgYQg= z=_(6Z^opkAYivwB_SX{fu|xUj?SF97UsduJcXe==+J#7&DLfw14VS9Uxhd_Igzy!| zuxEH^k~@3E#9RcLv70q6)Xg2Gb2quVmbA)EUS`}qW-O}6OwUzUge-}HgSuO0Rul6Z z!uul_Ob^{$IX!vrbF{CGUup&QR?y|9>7Xb!xw5`cmLH{ui+NQAN`r@A>a+b!eF>d> z<+hX?yIP`tWxw=I48}{JjLKW1Zmn1K6MnrsL zRvN+!ha+9JLtbD;z7fiT?|M0gt$YZzXj(?mA>L*FAF_gy7T-&>Skc+uW^)CXbq9B| zJ}PK080A-{R)t@<@yRT*88rEj(PAl7zq?iCVIq6MP%H}2H&awK1vw+2PapOVJKan+nv6vSn+*HPzwGI+n+v7_LJ^M6EPEf z0FwuOj-mLfbCV@Ws?e+&h`~t6FFvV`eGrT`BZAv)=ldquAVZ?>6F7*4jBPp7UpNBG zKPVb4)xMg5|66(ZPDzM9&Eqi;yKxlD`(LqZl_krJw(p5jg3HR@DEx5wAo@wM>!9IN ze;yJIc{3^I)>>DGk7)7mThTT&oG809EEz>{F(HDzM=zS023%Z<7w|uk7&o&XN)od| zgS}YB@1Ye)B!Gf^^@8TpB>y|XF^VtBa6coLF#^vIK|nvY`}4H_+#3R2q0DUT@!h2b3U6gNxTs}Do|<2_OZo;?hR`cq-hPBv z7c%3Y#Du5;A4-2Z1%JQF_@;7$?=0REUIva>eMA?z+P9P0aAn zDr`^ZfnrJ-K{`yfS#~u#XJSU6$-IzY;fiU zj-ql`5(=8Rc#+HI1FAuq=Ld+cjsjF9+Gf3L%kHZHfB1VmBw98>UvVjFHKCmy3U?KR z%a~=1+w%oBz&y$&&N|A~RGKx-%D*`_?q3W(vg1gji4lydxd^V( zrc{PZs7(`U$@PK>*!H&?KRV;@G>bM4Im#T=SKUGf)yD0#kl(f9KK6#r~ zdg(FRs;#G?{)4flv1fzPbaG^7O3k1J+P&KA?)}DHKM?W8C5~y89gC+?i)P*3`$5jM z(opujkv~F~+TkzQ_jeM{oks7)g!J|v+fwUWD$3sIrIn77SEnfm>Z$4Z-vbi3@_J`I zWtQ}Gy_^h&{y^^RuT*|n3IUH-we1?GT!GB35Xu(ZQX>zzo{ zEK15Z;2Z(vXXT`&bv_*Gn!~PGUV|OqMt|AHcNHd$UKKPuETbLjwVMwb&~PFXsP+7D zyrl}i5E}%IS$%8Xoqwpp%o)hajYHFf`=QM@jR7C2Z(1CQ;zM%isG|8U-jtPDS}AMX z0XbWKINRIb|L#>grjm^>IuqsH&`R#Rw)1xdhq3x899{z|`N3Ci*3F{tvwujh zM~ThPpT3Dr4Wc#dkWQ0+cU$2cbcv`Bqn{_IeZ)3ST_S|c>W!Qt{F~SATM^A~*YDQI zDcOnkilu(2tjt#oYMFlVLSc%58YDRu6xdKA?!s)raee($Z$3~V(6fDP$Fs-nmf$q%5OY82HyCN5 zxA1h*Rn_=ZCE`e|-h}C!njZeg^w3n+wP}B-2oP%8=9!WIF(E+ZjH_Z-gLT?w(7{gk zG-Vou>%NWZ!8T;;Xj~sBoYzE+&cbi?VQ$$x``t0SNGai_-65a2$e$Hw9a>>s+DAa21Gib(qNi7SH$r{LR(mmjkoP~v| zX-8LTUS7!*SG~Mhv2ErzY?D?RM9`MNvGI+cCisDeOR1z-In8|t#o&-Gv@9nder+xJ zi-Uy!%HUX;LCH&kP}hporZ8bXH~zc`{ApE2rfE8X!%zisVpoir#BRPt5@G7k`T2na zlQV|}Xczon_-SH*VOqej*u&}OGy?Sr4XsI=auA$G^dQ2n*?8zmC!z{==lniqcLI3L zVksomn_Whb?v{xE`iDG+VyAco@r}`QAPD0HO+fV&T_`(>NTWUDPlV~sScUS{(wkWk zpQ3oe&olSBi3A8yt)+<7uK;C4{RwK9v&F6o>}6j;rxK1wWFMxbxsj){2m}v4Xmpj; zfYHUhXJ$2TJ^?TI)w?Ty#E58I%cPHR;WFtSal!n|Tx4$HSN^pyW~o807quv#Bbp>U zid7%|n+D$4%pWC*U1b6Dp>bGq#aj45Gs=l)Ff6XFAFa?Ghkl%si{CDrvA*1JVKuHq znns|nnv0TPK(W<0kdbZDJ^wEIjXP~9kN~sPgmt-PnZktCH?~Lve_jLMK&CoAZ)8*h zy&T<`)toA)G`eaI!IV{3!|7jeL1IeslC=1l{CADfx0f6AS?ysaOpUq#J zm#1~oF*SVsJhF-AQC0CD23oew7*NQIOagZpc~5u;(yd>Qew~*d{73GVypR{*=5uUh zf4ENG!aVTenE3ixo!X=lZSrf=_rAXdZyT-ehiwAwg%V9znT!63WZ&p-B;%bQmQfd1 zMq_*IxaLk$J1d=|xXji*8(qxPH=^%gaV`+MQ#Cbll6)jr5D|*2h;34G=8zjVrq_bzPtIgw$IqR&?56_(~;tJ$~FXdi})$=PlQI5F9G94EzZwsJ8*!W%`=CQ4rn}6=zJPE}SxTDeBA~ctvY6LP z=JnFtvR|WCPblzhgreP6QtmE`7G+`s|CkOXV@XCYtUpLNxjQU6LfJ{S@0jLX)i07+ zZ@8=DYu?_GwA0}mk5)<%oE9?hkB*IO+h#)nnKgTyMgolTvU0BZ3sFb1+K9%~1e1*o ze$xC?>E>g&S_$XIaqzLiJ$uGrEOhSXCrPw=_eFCRL$@S1?Q;fJl}7Ada(}gRO>)x? z*cWn^w$yxk*VY7l5dPxh)ZpY{IQ2@*ZH~nVO2naNCEetn;p=k(PlpU%n#)ta_OJk+ z`6#{3Uo30Ln`0tY*$*G%iv?sCbuDfCF5*~Ol`Dv4oPJ|Q)mCM{JU4kES04GIbd!=+ zdBm4EWqCUa4<&Kf>Ei;n$Pc%y4%^_k9>0c?6fRrWe?=41c0`Ut@@^ZWPvSkF5*uIp zQF_OKXkKM??>pxx4O(#R-F1Af7q{ob#A~;_uO$H% zkVHX3X9@slPMs5sbKa@b93uPn2Xr9TZobmwG#8T1(^Wq_MW?FlNMuF;&#OKH4BYBh z&ObUQfT~>=AD1toRQw#rR*cg0@m~O@FDs1B{Df25=PpzUWx5fV@d~6 zpnBsQ_K+f53eWBSu2Qr}?M@W_|w6QF4Gz z#g}m^KZ4zJ8A7a+v()lPgtI@YGaofWA;0O}k%_Y=wR#=N&G#AU+U*U9(^g>U$>mo0 z@yP1Q&ZS;Dr9dK^bh36mH~L~P`bj$-+?=mBWZ9o8FfF4b==gl6{hH+c)zB$8Cc&TN zpkePRy}P02UTezDJ$Z6R>1v!fLFv(k)xCIR2yA7lj4}hcBn5sVo3L~qZkgF(+^$-F zB>mrB`t|e5tq+2Sf=b2zKQ9+@{5`Eg%W|I!(?ieXS>)#pm31$gC>IaN@7P)0qu;a$2l8 zY)J4~eMu~5>`J3~xIZVS94yXzF|fXqy3HtaKYK)Tgr=X@IJ z`pq1hdCb*m`O^GSOZHp>V}ay?eNtOVMFt0aXHj!N=G^z-Br2IF<*^1l3VQlVlFJi^ zt`?%%f(OEe_hzK2*N)CgN8an{G$Bu6(Fx))BQ2H(IYT6pW%n^o8Wv48rw1J?Moy@y zGbzeA&I@)!IkjGMxI72ja!2{eTM|@DPld*T-)b-G_0jnh>PeM?ZY3CQL^;53G^{8L z7p8_&g6+RQ9T0mQ>r)(d)!Xu2zkPgQ!n?4CCi$vLK)>{RTaBgBQD;JT&>8AcWi(FK z#j?!F%{W1V>K1*(+AAZIa!A7np8$2l?$ZDZM;wLUuP0Dt#f^{&DfiY5>~nC>sbz6_ zPU2zyp{J#;M|zjTj7Z0=J^@PD+#P+o4mvY(M2&W8`L+!5t5Z{DcqxX!{KJ?C#;%5y zt{f>kK|3nA)o$3MJC$}C8FJ74yPP{MuU>D-A6{Bq$f1Z>Eai*6)E-u_D7U_qZCqte zwUthYxcC@!Er!k|q~f*ea5c6%`o!umv=qa3Sh}tB?cQ+Ru%C>@T2A1{&?qo*wXyLL z5$kc!l4u>Kaa*KeG8m?@Vd<*M*rs9!HU!pUWg`(?bvB*!6RX2a2# z`qlRCzGR@4xn$PwDyl%>13Jzd-8QE*icY_Z7X-id(@gv_^x4my1c@C{cW+HpSs8{* ziMwGaH29@^Rb6wL*0rJ`V>(>e&u?v2MR45{rb4AE37w7J2}MnH`hC87MOlEJAkHNx zLBgmp1c2@#cSNeIlVt^9B@*+3!M$GH;akyp_gM4oe-Hz8OX^04eeIG^57D1ngYlwZy7 z;UnbcJQ>dj!Z&{2yTo3Pur@vep+rJ`Is;KFng}aI3O%;6Ks8sQZJ!-}Gph3tonK>= zk20&nDo19fNM^pJ_$VQ-koNkD{CyINXojO`ZR%!{s4ZqmJmSwyGIOe!Z_1>5uY1%Z zodgX7cX39!!z;JF6#3UOvFQjT)`A6nURXs`5-Oqi9!m%baOam;#4g{vwdH3V$lq6D z-h2~HGs<0$SMJVp$*|b+xlwNQr#Zy-+1&M#EGGt=X7|HZJ&@2x$l6R%O@?TfeL8;D zp%yLwRmNDQ$loR*8@&0_W<)a5RcVMS=BY>~FQ`r*JMByI7<3XQMGqooteJ=6^nr)s z-pIUPLpTaY{?wbv0_Z3+y)k*6nFopii3h*f)DZsW;#(o$lo*|1SH>T*j$>jky`wHj zMzUDMhh9#;(w=n{BHiel=>I1CLwmth1D!jkEBfus2J%?yo~`zzXp<$j$N)$BZ|O4P zsfJer3VbEX^|3cjVD3bDTdQ^|A%K@cZ5;_Pl_Mi=KgF1NbX@Ly7Y_Rkp9n?2;CJ$E z^@Va|re@sd`fchj&BxTD5$0HU+3Nvjspfm78jbY(!!&yVdTzpV#$7{shUHk}hjaEc zt-fY1brZw_N2{dJuPoGvQN}$c*d9;4b-GEOtIKZx*E1VPCX7HqhEPz$PcZ-2nGKwO z?)JEkl`M)!ZQaA%WB4pDG{k(W_}F=_f9N{E+a^GV%Ud~Os$qd*t`R`7u%v$2D#z5j zK7>up63;ANJEpv{X;G#l;D{zEo-{_;mX; z)7tC-K6&1`jstInjOZ;t+-)T42|V2$Uk!M++&`S_wLG3YA0-M3dfeUbq^>mIp9_oM zUR@l-33`Ih7iLOz-97Fv8Zj&dJg?4b9b5Zb!FwCI7?v%)&ySb2YN?+0m&Zd9E@L1) z-E0tOZwkbD;^|%=c6ybY!YuG~IdNZmLL%7m_}JN~*ZSSp&E;kwk+I|XV&ug0-i`FA zb0K9-pb30=v*LL_una{+2V%!UQMz%5@kYac`lvs?LcmgnQ`*~$N7?akw<+`_kU5{foSax$Kh5=8^ipdG@g6e=lWC6QzZnPNAg z2u(=IkPH!<218+|ojLOyVVg70;~w67J)7#B@Av(^|NQ*Cm=(b}42bV${b8;$dUyFzNbit2l!yKHS0>?2&uBULz`pK4r?7DKBu2Xe~av ziF`dM-|1DlIDwC2tjCXcxV~0GvGh5ix0R5?7%eF$nwFWyxMtmd{MnQ``J+cJeY*dF zoM{$~HXafvP9Ns@IG}dr_T3*&D`(xsJFm|6?bz4*R|JXbkiAy__zUvAE+?hg`8IhI z@iEB*ml_HlkcOXBk#k>f7mRvsDoYp^?4GEd982j;yk3)`j<#G;!kF}|!2W6X z#i=qn-&&75g#14wXO3Q8vC#!qeVz< zvhIQV`Rs1fdOs7=6Vu}r5naLbjwT;l6WTiGwkFZhAKn>-M27>iAxBheriBmZBri2z zs{ApMRYhCY@?eGkC1F+kHr3$n>np|&-@kVHSgff*nW>huUs7AW+!2RYKC@Q$({9S% zPJUin(P|r^RlpfIb$io%?jZeW{|=LanW!0-8SYR|y3FaJ`?m|7n>hP#DSLjJNZHcO z*`o6?eRF8RJZGL>2&cpNzRXC!+3myk!!?E0+@6g(i#rj*-in_TSaG6t|L51HVguRP zQNFKR@i$&Se@-i6Z+zXl_Cu^miudah-nxZtDJK;DM(1&QS~NPV){i%3n*=Y!d0Nyw zbITQqm3?l*sL|i1}DstKGR5m-(r?*01bM$-=Jm)sBOKQZ^Vogh8M^)oM4**)nOTKkyOE#;R{ z)Ac7zbGJ38rT4gcxoxv}|8*QTz; zHJ!_w2-H4HzeaS>y>R39sgfm<&hj^x4}N#1n{#_`@sbGVkDhhT5s3-&#|C8;kSA2}Ox2Ysvx@EB1Wx3Z)Uk(0@n`d7RK3JdY zA!WAYJI|-{xwlVMFa2OSvWkmSz<;A1+ZU~-b?SHKbu4dbHJ#Jfa;dO-7P&^iMD<+M z%gUuTXP;i$`>N1Ry!h#jG;(soNMx%RBBH% ze!Fw-S#;mC&wf0dpG3v#KOC*#7Y#;u^={L3%s?D6pS#y9HVlp+Qo?&vIs-N?Q}?-i zE6>`;#!;!_+CP<){j1&X+=RG#A+Ba_tIBiWrmsd|n}!eD6`$3jLuzaJE3P#Nh>8LA z@#;RCSBpvu9sPekm0+HYTCM?jza(RL_ipogsiq#iyt&uz)!>7d6Wi=J0C1 z;8+b(b^p&p_8>pluZqbJB7ZYAe~axxs~{GQ(K6ry)C*iN)muqXNpuwiJ&5@7Abm!Y zWftK~elL1W-G>v>3z*_TOz~$_Qi32ec%~OJgNK(XrgexZtrWufG;$)66NN88yEvO} zm98eJJ`9_fc&>=*)v2^xqPQpP`=A{uMgFFss0k)YNBBY>bPHwWq7z_c0q$BGp8}^V z{1XR#B%QOkRVyh6Dk=1PXO_KNlx-MhVwZ}x*}Tp?c$(XO zZ`kXn6@Ken<$CY&96@!$F(Y`*^Ye$Ne^5{=`poO(FI|YV+eF8Y#|JUej2PMZKSi0n zS46cE%T!0D>i@t9MZi(%&Z6w1n6i_*~CK#KRpW z^P8q*Q<^9|GDq9gebQt)er6=E6%u{_%vmLA$PO9F|Mc12St=w3N%>>-eoOfkUJM8Z z_qVvRJ&hl{ll+PK+`~+&?*w{2w`$UNNHDnCsXfy%>Pnf0U;1rThmRkY*>b77_zp@O=7v(NkK}Gp`zm)p<6T9DfW(Ry?yQ;=eYsd3EV#p}2l^ho7n*4%3S6ng>4d zdR-3r_zzD_>NQ@j(w}uL{YRq;k5(!f4`-Xa40uTUGFI=jKHV|ZP{7!Euatb8pyFUFSm2bGwb@4o45I{5W(?$MRTuaOn$GzR;KUA5C^C>TY5_ULSpI@$p>| z`$6xQ#CtD^knDQ8^#wdKas6NQHdmf9k4|e+iQ4_c;FW^c`mO36#C{Ef8cM3^>0|Zx zqK?1ZXeu1_gNG|Gz~%^>r<7|uQP?*jcD+I4qbgv({)28UGL&`n$h|aaVSm^Nk-SXU zyjpLw5W!e6;boaW?aS4VCMVTj2xDl3*=$XCrm7nRj@q15Hx`=r>T=AEmu`ypT?AaO zUgu1eKWMPRMbGgkZMg8=wI>{r*T(Nn2k4B)a< z!f_zoKY?TZJAsrEmMo~J%lZ3)Q!%kOo^q(`xn*zVI8w7Um0bMOO;^C_NQF~6jX$*9 z;oY+&H5!Gb@e2_%L`Si{;A6&Wm7=@IsJp%sPF>G8|L4cygm~`r%zJPfLR58YF-A@< zJ_g(SK%3Q*FQxljFdVuaFYDGSAeiI&HS}tJq#(Zh5;TPMDxH|ZjJM(e+n6xpefO-r zc6$4dj>kI^ga+CEMnJufH5|Lc+ynQ+1zQ&{F!+6eh;PDb|7s^dU#CHCOI&|;;!7U( z1;MS+D_w;7rOllMmVYe!&GIjVUvM%b_ua$W`;n=&lL|gBrPVte)7uKI^=ix)ypJ!r zv7mzN#Am;bi?S~O_x2ZXehJ-3B#;Vvy3?PrR7iMceNz1wf4hGnvw6|>iACG$dJc>1 z#><>#f^K}}kHeDaaO@{&IMRJA4d?P41GS3*LKe(fcjGT2;tsyTB*ptFlqje+mVizTmM=w!cA zGD>Pa7lX^vDXGiBLj}EJ7pG^#V}09z`r%HyoO*{xTfXT#*UovUv+r*T5*pj5<6w}$ z4N*=taeRohzPHr8b@Q{9jx)N$1p-slmaUD?rs6#Qa#0^_rc4(m?AVzVAyHZ9>?dqk zx>3W;=v>}D>vMC}`@c2r8(Mdwe&70YHSkQnQFW$3;8YoTV3qd#HjD9$0#)PjyI(b1 zx7x_RKYfOZ9!a+klfz0o#5yOwsXh75M$92KwY^te^KR2V>Etlq%{*=&c^!9z>|J5v z7-GY+=H8psh6~Nx@`FQ4E-ckQmcQZkg&oIEley_U{V%jOSUoh&#~rth%FxoVD}P+{ zs)iumI}wuUBkqxYX2ZsZMK0_9NmIE654$c56q9%z_k=#SBsX7t*rvL%BRj1q&Bbsd zo1%tiB-{3>o5waetlIUo=-|txq4xz>UoiCE`k2pXwq%5(ZRzrsXS+uk7k8|4Cb*86 zWOj0n_Z{5G#)EI#Vcy6RroXM_!g^VP@_~4~%x2R4o{90>PIJC8o@)*7Y*uq3N`&14Qt*^!VOY22F)JhD3TrBL zM_CEqaL96XmUYIo;m#3}!RfqB(bj&!;sW|D7vHlwa&_7*V56McSYu`!(cJH{*pa{M9AA7&+P3D=%)5r;=hyvo8QfE35%)vA%ISNW?CF1A zR;RIlR;?P%cY0J_mf`oR|Na#P;)8=0)+N`xHn8+fg#WlKs9c}@z0WYpXQ(!~kxQAS z=BM)BZ?bO527Fkzk+dwfRX^BS$z zl@)E`4i3o=uBF91|04b)Z0n=d^ksH4AvZV}PdOd+Qr;!yt)};~Ua5^9(Y!$>EtQ`s z2H60USbjwtdxn=aqaFzi)w9*jt4d|>wlpAxsS zuclkj1zDWt1=oL5rW%)aSkWjP3!TLKwznQIb$b-8wJhy zQR}{y@Lc}mn~ZjP>ZJV_#y7^2$Xt9k!T4dDb;-zAdaucq+~*_saT1H=NZ_ogK1H$V z;~r$?RLUP#g6s!rYINs3f$6}lhxjr70SU&ZlJ7$Fw6UWDu)pr<;{Jy5;p9V?XUFH% zr>*?*?=V6c><3;D);To2V|+?TYpjb^HaTVF%6Py~U}<5n0%hZ*PeN}#;AdL}^v5$0HV>ksFz1zyl4^h3YD_J5kKdsD2cy;MBeW>J|VU8rVGW+<8V0IEjc zz{6cD?{tV$!+F|qg~bQzHL~=fesk$BAK#GIP+xO_9lA$3$t&!VAYq!eQ^3@??%Waj zlUoV^e(Shxl=}C)Ru6j2%fymB)4gmn4jlI6hNZ zbz1S<0u^9>-Xb~Kz-R01W5B?N5W&!!ETPk?^#;Bf>3nDppXD{u@wzcEGCWT5qF)T5 zDKqxk;cAifI=LnL=pMrnddGL1CCIVuwQH>Ty-e3vmtdo!%`w<&{cz*B-2IBvq|}~P zdtY~(*k;nSRf>Ny3VPA_Tf2G!@LdD zO2+q95){G|mHS3MjUT-9;wq(?afjW(!*h=f)bbWQ8;E#{-Waq;#Cq`Yh$iE5$z!I_ zu-uWpSx3+E1T%Az6hb$Fsj=k0C}$JnK=FhtHy@AS-5Dz&LmK9Lj0egaT7&hM6DCNz zvIKu?J8}99eS+?qCosRM-gMpPCOlG&%I9!ebuB|UgKm`h|4iY%@sY;uMUthr zj1PaF)bCG0Y%d#`nFc7|68#`yGwD{MX>H|``U|VKf3J3GkM2a2g1+KSKwq;V{X`_M z)p&`|9j((;!}w08QRfJz355DL#+POOlfsZPy?{UJ?uarF^C z$#kg;b)IUwj#QTiDSb*|aP%#Y;aJ?HA4?#Jf9pie$C*#`g~+o!%c+=ZQF(bBI$1KQ z&(s@=94k8g{%7c&e+CGZaa;dKf)NAuBKS>6P+&DI8xR`m+sp_uk{kO4X>!Q9cPM4o z?Wi*&=%27|n@beX|BjMMgw7J*MAE_aw-4`U7^D&luv}(l8(3$B^*PgI5~S>m15E%C zMo+Jp?EAGkTRo?KqX3nsUOfW6Ca6v5w?HsFl#^uV|F;nPeb3>H2wqmF*_hs$(t?V0 z*@wi5bgQ;GnUlF-hl^DV>S5xJldKq`GABtw1C7Pnf(X+-;z>{G&#j3hv`>%7;lAxH zD4WiHV3Hp4_#$s@K)~du+@zY?1C#o`GId1d+L7XkP6760))1<$ z7()w83hbh{9jCSBOs;9NHPuKsIW=zH{ ze68u)8y3iwIPQWW@p4AMNkR-c7%3dvJns`usFq#hRZfzqHQkIAqOV}YiSAW#GLYfq z6|0dzdUWDR$&Bm!o{IfzZ#XbMW2$i%^uN{X@xJ|d;MHe4e@Rd8XdIo^TKh=oHT`ga z69=6cFra-^8=)OD2VZ(D1mr60IeC)gF9AJ9ho<-4EBf0UJjxU359uSW08K?Oj6(T3Ljj{`dlhUyGXI#NTuu7I*Eg@N#gNXN(`RC# z-Cxgj;S7ym1S{4}L3^Pk_;P0*9| zn<4;_W2{LW6wI z0#Q2*CzMYR?e2Kf%;@@EZ)fQ17=9Q;k`fQ{$^%hz$|hW!B!W^7OW7(sq6e|MfFb1O zXIcjm|F31JT0|}bc2u4Eh^vYX{a;}jk<();@SbY~>hf#4bW~RDKXdvVSbvkY6ljC= zao2e@07Kv(*e(GL9QjQ}Ae14d;d0VRLXb|26{G~)$c%HXY0Oi4Ek_(J0t-{lovR(f zq|Q$eA8{E>Hnl>OfH^ifFcm=FE*nJI`-wIZ9v#4#7N9|gjZ&SBYr36 z7m4gALfoBmi9jzcmb?TzA$#GLzO-aHd#@hr}p=m`a_i*JH=mb`T}gS zz~CMZA}RS!XrGgLlKxDrmsT4}*INRk^AbBNy>t3NjgNGnn~yCO4?XOI&3kg4;35@>zLz< zrllw0HjrgAqh-G59tQ4uK=#jovI*hfIao<10WQbSE6;1cp%>SZz_(wkhncu6nVN3F zYyT^JvH5~AQZl{v>!d!U%|p5#hOGzV-k(wSQdLCbGd)4D$F&$%x2x$e_P}m?#7~gt zi2@ow(xnA7aNQPwok_kJyh{LUUttmfNnopqOJVkdHvdRPB^tM~38z#NS(t;>zih)?`6rbGpb`xSC@TkG2)IfU0I4|A z&#FTG9iBy+hvLJ8bWto0sS{a_KipXefhpHzGKpL_(t~;|(eT?G}K?KMZN88S5g8@dXpaT}tEW z{rdKKH0?=!j?evq@IoIompA|nzJfyeh%`w;g}kb@a62s#S2l(AmQ#t$u^@S_N2Hqc zy)Bp#go^W6I+%dX34}6iGZp^9oKaD0oi-YR66w2{xAjbN4`%B_lfP*&E3s6*&NiOD z8#D?l$Biz*q`GNNUrF^gp^$M=pV4<1jcKTeqK2eTa|rlpdd2P|A)bC1CT3(tju50*kiJE#;vXLiM;7KmDn-!lk87eA?x%dg{b0Bv}9JvUuoWr4XfdIf1 zE@oPR&^IwY@zmrnm~~$!Y!E!5$<>Od~P}+;J;wuXi znot^|;l(LtE)hy6fV%_UEEZaUPaKtmSR8;ciXX@)QLM^kQ24{C#_l#)yl zAVm>WIj#$?=&c1{k_ltxp$rPKl*XxH`KGmD{680#(~W0aF@ada3t&8Q2Abm)nBAcj z7caEpc6uCY^r%6jUQDYlVVJ-S5sgL3oB;n7w{wq`R6S_<6U4VzlxTe3 z?71J!fI?KYS<}?V(RkOGaZUmKkp=rb1mK-Pcb+6B!+@cSX^T0dfLPzyeJA|GIBXw7 z1Aq?%qZb!s`b#L5k4)_}GtS-lvjQ^>@wGMnZ=2JY&EDLLpMX?j&%iW11#kS=ZQa`C z{}T`k_^E(O_F*dudW%jaz#xaoy<58cVVc zzL+wz)$@r?k!iF=widOEak$_GQjakn0t{l6 z`r{+I9#DwJlY!ZK&^3J4a7_%w>Z#ow4#sIZtUkl~{>3U%@j~D4LQaR4iGPEN{1|3e zrG9wV9pSCTgCAD0pn>TuPYbNUBXO85+L$CF8_Pg?SRS3B?DBlhG>z@8vh5o&g{h|j zuT1j?7ob;eq$OU5Qh|O3gH0e)n`nvm$4>3UW-to8asju1YALFm=V|b>g@r-Z_`WHsUjO^*$HB#17H$(( z%YvdW%50UKnA;a}ScTowi0E)_V^{qBFFNm%j8?gM@Op1Q7yriYt(f4(sG;g_u8J)3 zQ`t{j?VTbnR(TXl^~*PXlt?vcH8a+#+x+S6v7I3TQE#fP&0pB;(b25oJ8`9$t4BN} zn8SBRX`0nPy^{j$c?Uz^$`s2x=&rPqElrbxHCLQ~Zl7spa(C4?1-#U2`KD*$QT06v zCnYu?D4!HEs=Doa=v~lB@Wn(;^1+gceR*F(kG(08x+~x0D~dLrzx7X}z`PUl1>yk@%Oj?`1JT=fg zrF14R(Ol=gWm@eHRbu(&uV3%JmC=xQ*uKIFS9sNQ z!Y$9NsyO*c#kZI(@vG&Vj<3O-o{J+~$~dgDQ$HbcWrekj-W`*OdL8o!7UlZO zcI&wMsNYU4V}?Amyuu-y;DnTJb!Arng%q_#kA7*s8|@ zWfQ&IMbup`8cME*;Jg$1mU+}m_oFQ&2orAnL-!nvhV0}^d_ zI(V=b*MB?Js?n?Bq5i`yb;4i9bf?4Y(uC@7r*dF%-sFYJmc1SD(Ma@W`_6ZIaeQt% zqPlT{M{+XSckUF#N2YzV_7lG&Cf{27GtaHx=t^klWnrB?7t=oARC)6(5@ZxNh(0#{ z`84#1pw8NhX;s@1RPi-O&YF!%k6R>b9iW6Xp4zx9Tb8)}>mAcwO1l-L_vsi>6yA)K zl(JY&w?wLL{ZZG{rd6I3b=>Gsc}*=hw)KMHE~V;stU>MJKewh?ALw;*^U-m#`#Sm@g`r;QL2uPxp`I6?`TM?W2D9SsSph<{|k1t|EwwYmPw}C zU%C`2bm)aie1o-Jp2nJ0!n#H(fo~}sI&p$-b$=OcedzU;0=`vN9oYJCPxjM#yBJkC z$Q!@(tZs#lHOqyh9>V_X2jGrxmovEj z0((9J`llB{8y8CcoTu72!a6AfcOyq&)0_Zo;;bQ_mJ+ssU!$d3;Pk`KM_JF@7+Vbw zaFNI4x)n~oxfRR-yG}+d?AlJG_#WBv1SfvVC{><$a62*TIR6C*kT+fwd}wBY0IF8r zmcd~GAe18I4?>*8?HR?q%s3^8H;Z|l+`t&uUZ$}{62Ma%GV;_(IC%YO!l&3V8^jGP zZ^4%J1b+vRz>NYpY5a$4(#V?5&T~=L8LTxw^Rm1XLsKe371*pc!UM${7^9MWh*6p3 z)0w}P1bER>yi3Z0`?ol5%UHq(CdrYJDhROnEY?{gv`rt|1_i)`93%mk?}y(Xy8W_M z%Ykf3ZT!7SfFEs&JoQ<%(T**?+RqiIFLM@vPH8U|4++s|6_y?x9M%@eIL?CNd9s8V zPd|9y^pganp0@XzT!fmkYfKJ8jKrDp2t+BKT!xuT*Crs|JmxUo4$IYf<1?%-&%pO+q`kk>sc>n@52zbb7BG0&hFa+k4|8;Ocs`; zn~pSzb6VaMWZ8-vct}KU6WL92UL5zV_$woljh3iuu%d}M+8E8GB!CggtY5Zkzr^a@W|AHLBlmh|I@*6&F+Uvy`$nFw{g z^Ja0mG|{E--Z%@tVdP^;SCi|dCq*`_BULx7U25G@yGL^`i-Cn0)@;g>$e5d@9ZXNX zOVX>WZq(VbR#biN9z_gSoVuDbZF%WHe|ngM`VqG01?{~?jj16YV7hgz6E}E0gvMIN}%ocRT=V$KkxNXH*(t@jJEiX-geeC3fk}ywF zt7>4DhNs*KhAs9uumV+ltEM!i8n<|B>}=)-Jyf zg>bmx%DkulZTITH208z#Bs8hikGPQ$2W{^-EXeb2WS`TvGaMHEl~p%d>?qnt*jSwU z^W4asL`9>V7nlP#e!FB1&VU1&-jC{g`*Gsuvnj%1z4p6A{y9 z`yJ(XBql<=3QEE)^}_qVx{(!?sykwCn*6bWpUGcXY{`*m7(l=wubohS(HWj>%H);Z zO#04?7zoJ>xvb=8amBI7_vW?exFSy9%STQcvUDo2R7488t94B-YH7E0Xch;H5Nh#R zEq1fl+*bHt0%JLF+hhP21eCTOLu4Vzvp_#rJoyLr`w!T<+&0-lq)d8q|8@m-Wno%i z5}`EVt=OA4CIsh1MoW*dwdw#oZe(GUJ>L%>Lm>iyRM$(6*-=8EH{r0KjWJOfUoPwH z5@FTr_eWYNn;59lfyV5HTPok{m6ac#)Tvc2i_254{)Ben+}07dTgha`I72mTKkQa_ z`R_;-xlRQQpo}Ly-9!x<)hGFt5c-%c&i0t)Fdi(ue?2Gyz z`xck@q4>)rXG}{82i(XH6voUU7DnFK!__=B=dwXNV66wM{s!gy!4sQ>HKbdJlx0ka z#j*m`7)($3zA|q#8%Ov6Txb%^lbV*aH4F4%NFoZ{$O{x;yGqg@*P}`>Qq^00`978| z!q}B9?pgAO)2mXTibF1+7eNAnlAO#oIpF@wegU&zF0(uhjSpy#f(D%p%}=uz2i0%V zI}o^nI>Cxn5Y`(U*%iVGx`suUF6r22ph_OhfpLoYmLG-o%|avl6+%gRQ^5!y)8Xd@ zm%Y|U?{aqz5wx+Jvwy83}383N-r0Bf~y}^20HS>kxR4i zS66Pe*r5OuqJ%y)?me4bTa*GEMb<}JXL#BMPNF&sfA^)>JFr4nmc>NKI4B+N;e3<6 zXYE@tb29vkgG)#olkRem7;XrQMff4*VCS@9dH)}UvJ&#n>YekAmc9!!1u>}fLQHnF zmVlV3(iT>?#K-HP@rg4l8C2hd`ihIgEXtajjdNZsk?zF_vM66ZJMQwrWZ(?A6=K_i zlJ_k|Vpm{2YR;%Mx?E}#mIikl_L;;9y4OL`@q&?V0slqGDBsrIv;$?6FBDoma;5n?ZgBn^~^^$g4|$djUQep4l4_xfJt%Li;TSS&Ar(=d@Qq_ry!MY0uVEynDENTFFk zHusGs(toa@inZSF}-O>&{R8=)0 z3!pbJyBeyXW}8xM?XFruW6AjPTGtj@`mv+Wv*!s$u<^dy5jJ-+KUSnQk$A?#6;?s- zSKOy-3!3mbQH?l(P6ibQ_JNR@RCD&a+QzS%^zKh7pEha7T0=aO)YKyjdoh~@4UJt; zexPL&A1Vn4ScKG1qrn)vlF~UE25Xv+fzL4^8(Wu`EhBt9YXsd^>rje1^xPl^D+h7f zVYq^pk%QTkJvs&XFH2i!N63qdUmHiD+ikyQGXs-tZlm1*+B}RR?tzy0vf#ffv6`#` zQ{J1f#ub?AfI0#U%>nG?_uf%h;x)JYy3ofg*Go*Gjz+~oAbB-tb!4)J7Dz?@5pOOOfZYN8A$*a5>u%gEP8yM3oYlfk%Y zSaX~B3vC3p{#;zGbI#VK-C9X(3+TDT+r7uT2aaK372M8)NyIk(eNb4Md6~D_?|trS zF;Ke$LpVASbE9WrjA;;-9&WaqwRgSrSvXyk>!m}w|tnZ!sb6G{u5C(J9`>VTu!-l41OPSq^y&8Z-D=t0WC4omwu(nwa z)qaaV%ot^hRRO~ra?S#GMKVr2&T>FLnC&GiGR2-@PvV|XzX8`)cT!|fqEUt*bIrO7Dj<6 zO%pb71I@(D3z;bY%N82R+|<1O3}8W5HZJ}xtI_1v>983RdVQBBs{Gmc*qT;3$4T^Z z9CH&o%!B%;%`JAi6vgA6zV5M`ZdGb*7G?JJ%xucbWm*%(n)kMRj6X>1KVw#Pad_y# z+1pLx`mZ+KGjZLLQSojwUNpY&wQ{TI$SO167igdi_o&k`n(g?m%C}VBvzclB;k$MH zxx&(Xlabs`=Q&;R9qeO2Cy>kw+#XOSHeQz9&|vqn88& z!Q&=j*%xOI@><2e687mm*LB4orOZ`#attN6>b3*<-D(psiros3Wnn_*&c z(wp6%;4}|_QXNn{`%b`1qNFlc{I^UBly8z3fhaNG8i~s z2+Jz&cf~0w8nL{WA2~akZ~_Fa-I56-X{SP4vmNV$`p;OgF!}dkEHEemc}m!}Mwi|* zY*5S$vC#f~FP3k9_RwD6!3?trN|Y6vxH_j0#xltb!JA=NgZ#**0EOXxMYhm7gWyHw zY0Jnn^frTe(@}-Wo>n6uEnyJAT-=Q!_L_`W6k+0wRU}j;P>@=-E|UfR$_Uj^;2S13 zdZz*`1~HKieM{j-d0`^t0cEi96JvKh6C4=B+f~MdVimzlthWGqn=q4_2h1*g&GL4( z$@t5M*WUxp@ez~2OxL@&) zo%`)}HBWf!CxJ6VnG`lu@~^j9XY5wYI*df%K;}e^W#)6EUA3@D%)%}p&c$ZtKsJm; zwx~lEDWgMBI(frzirGlFS>En8=+HjQ8n{=5m9}5I7}{lJ&W9c~DYX+{R56A-FqUPZ65?JPwC4!B$(GCG7;%;V?bOwg>u4Gp+3dh zrCL6$aU}MV%UQC;n3eU+Mf5@G9pz~CNQL5cX=1lfFwXXw_fFv!c^t3x%t@22^(h|Y z=dqM;-ik-bY{L74^c`?bidmP0%8;#n3wHlsTRwd7Hvg}c5@azH-Nw1=f4jLTmqY zQz?f2I8w3G#D@B_$g6NOa=Jn5NTN}fGO5uP!G1+)4dvzYd9PLW4*s~--|_z1si9qM zcM&0Xa$Bp}>&gFhkEV7UN49GdM%Z|2snVe&+dp~zGe%X?DA&^rjk9FH;WF+&45Zcl zf9eCXQ}a2?7B^RQ5 z4tvc8T+gkax#8}J1w9j^%M%}UO^m!9a#c-=6s|$^hsf?fPKdd^;aqv2d(GJ4|#&-@cdB3P~dk+byRHWis<^=DnkrXB0+%;P`Im zw=b3&yEDC0=#x3Q(%i6jTYBn}I;$jJ|+e(S7l82Ry*LVV;s{gINp{*sd5Hwzn($yVWj zQ(x>SGHjKe&E`Kp!p@ClwvyYV@4oZo%4_&v0a^+V2PCns)YwymN`gS)|6qLSa`tG}iJ4AN2+LH4C61>Da+BBiitp0)g^-V6<*I`vb zQ|b?!fEQ=*HINVy0UD zsQ4i)Ud(%w4hxmBJGf$4&m_L0WZOIi%8~LnBLUH+Awz__iVP&`6|WPal4WWE{q8^h z)`oaa-#0;7ZTDX2-ih0dc8<7v_~lnU$kROTJrVA~I6{zomgzMSJG zQz(1iA(;b4-E}DO;s1xf{U-+0f=E_Ezm(wS(8VbL$G&(^b4z-r)-ZDgwXT2@T^%*Z zjmsWn;+T?~lKlRU9PcPfX~vyhSN)*?LsBWV7~hVV_i!+-V0qj6z&atN+lHN8M$zOJSCl}<^4GY& zulw9svtBO5+nLGV4hIEjULrntzbt$1%R@p;-SgZFh%SHw`T=80g!eZcNCZD2p~;Wc z#kz!)a!&u@B7CUi5h&wav>wyt*`9E7vi;J;W}|Dkqhtq+TEWiD4;(xys5CtD?tw@}r(_G?B}bty zrIdfd#-?l$l8&{SfsJ+|uhw>TVcW_Ak+oy7kh>M~`#?{_h*ybyA)J1QvyQ@l)@FxY zc0{10MoEsLjxM6P*%tuC*7$D6@3Y5UB-@{gLb&e%>GWKSw_6=`ecB}{>XHjHOK$B; zSMwsXsEZL50l!X?2fxNdpPO$Q4t?P5keDI(rlS%LQjT5($Z`o z1ZfWA!$tDqfaE@2H-&D5`GGU0zou|OOe04dMogx^DeMBstx@J@LAqY&-v!C^AnuY& zz(U&81O7XObFgUvQcke5@q;(Q5$2?x24?YT&-`NxbD${Vl?DilwXSbLo5(G*&o4LH zh3)274gn-O){kAqQgGj=x(b9%*kf3^?Ei=Lj=xtu3^BwQDNhE7ful_xcNaKXSOH(J z!%XAulg&LgV4&78;@Oys*jQM410pQ525^3bVyw0R3&g97Is8~Nm6JYUk=k3>%(7zpV zve1H)6nIL!Z>tGHHn40CsXUUIuiG!|8B{PVcGv!)=H8QM)6`9h6#{tRizA`D7FWMk z*?aQFOLY_JdL>L@Mr`qK?~4uUu&!C-`dXffN>R82?m*u9z^neoRU>p~!o0$B$ZmGm zGKFi0$n)ktp)!jN7{5iB=b1u)*ffq)TgcX?S9pJ;q!QE%J=qh`mP`}_!nOQGggv2L zn085P$8vmN*HqgUDimcq<2ZqJ;0KSdI&8*qUX@Z*{7?t}yoi8~#i=VbhBXg@;&umA zKzr(h4on@yT7_l+4v)EACv>)*xkMYjs6jk9D+&i4H!=?j78lBl3i+6mRh;f&?R*}7 ze}CAvMGW@rk{r7`#+I>Rr(%#d275?PIO+;6zz8&o6Oa>dkd^+mGCHlT_lZ<8-<)^3 zSP4wD~^O_B3@UJpTx_Fl^3SLHQ+v=)Itek)5$7a(()6 zWMah*D7o0{uymgp0)@Y#Z~~mm|2`p+UWbuk43<6ZTJ5r| zm-GtL}$?0sj{JFc(;g|R}sQ(W?@)m~*TbeTS`0s)RUMn$Yqc@d|ETYi`#bHP|z&ZHB#MNZTL*6Du z5#olTnl@2sP`1~qz%C(S&xRa|OVB?|Lgk)3#NP5mgl- zPMqrOs#{q3at5u0L5I5*54i}!`x?DI(1=YXwy^U7%uQXMT`xeoJY%D9CKM3sSoZGeb`frQuNU z^XCr!Oj;VGf-9rtMGQau4nNH*df!EI>KUP~u7!hc4(3*nE!MkGUu7m^fyvAJVlkA4 zA%550^`Iah=y}F?m~NRKxMT90!WCQ##T*Zt_iptO-PM=sR?`M4lyhCk$DzY+V5abg zWYg*1#4bvjgVHs}3)BY1J3RQOJf^*gYkjVW1}O7a7UW0WRO+B`dwejKF7YwbSDhGj zQ{%TE63wa5Z;E|;LuuE_gW`rh8tp6YmQU6$8zrx5KmAhEL+h^DLy;a%{&sE;$%E9C zyGm(vz=d(%l6&IM?mO_>Q`>@P zRX*u)dnhncB9%OKN@h|CmhxqhGpeSgcxyp>>IDIh0r6-4J2zv;nlwc4TR0%CG};2C?W!M#@e#XP||EBZO%d*VWYJGXdR?kh{dOl{ffX}Q1by^^(I ze&8u_?7F0{l;W#|M!fvrJ*U7=a3K3D@6p0gLHr#-d`1Y0{Knk0Yc*be zqlKl&JC*#vwB*>iG9d-epprSGt79h9D_-&z6=k+TfMbF0PIM>8CF9+G#LLlh+HVEr zJR*bz3*$Fz9(L09_$$edka;$S*eM>zUaA6DuvE?Q6Ug2`fw@w66*$9PUIM>4l(DvsO$0gF~pJPTj ztK~vWy6oxUt3swfsziM4GD?}F2T?oTzsS=rDslf2uie8bDegCKIL3Sb$tTjPr_&#G zBgz6_5o%^etH(OxHgsp()Cks#8>M8B6mEz(R|Q1Oa4HJoC3g%97Jq9MQt|vg)E*ZW z*V6Aj`uJNI_o)sLf!~9ORnH;C-o2_I zu7dlN(dyZUCHOKSb--=>%++xd#TL_1-l1*#33MmfeZ%5wB=C|-_}8~*(&Lu)7^Qq9 z0ihzZn~QdfNjVZEclQ96&j_a!vU{>Kz)7nPs;>y36drvT=CduLo{kKJmxPla8^I~Oh6bilDq{9W+h<0D2Y)$_tBWmR*fX~KB3ee@`J)gz@Gpi8mu^iYTu z(HIUd-!8_e04`~QVCyKgy%BOCPO|1ZvmHhJSOP1YuT)OJ8os>e5VJgm;CFVZj_RZV>|OZDhm34 z+avE1!_H>W@3QWiu+Ked>MvWsdv5yrz0nyT6U7`zMvs_P5!XywSivkv&pKW`=_P`cyDrAs|N4x4Ue*j4PNXU%YK?}DY=irIF0-4s#8DF81=SJBzcb-{C+6KYJPz9%2|nXcCh zm@lF8u?+;GEdD@~DR^P#;^>)zi4MrWeAsi(2)ab1qX4!s5!zR9EW$kp))q7j97gpt zSiYb8JA#@ z9Ej(cmFD`2k3Tzl{WYa0j$A(4lZU@6t9f&Vv!lmv6f&v zhx-v_yirI(-aca{iyyZ9kGb>M)jCj*?A8Q+1AXWI?lW~k3nXZ8Da z12*J(Fy!%@va+%*J;OW8%MBinB^rejo<;DR@OYrZB9-hMuj~ke^q}sZJ0WTjGn$X^ z_`NzN6&7Q>NIcMZBR0*BzpIO*O4mcHxJ^?VcNjX6^Hlr;wRyB>P<`CtONs8^B;q6L z?w1kYr_1Mjn1-;%U=S1$fG>y;#C+X@M`>HGT@cYxUPArl{Tl@tQn9(GrROo1-4pi+ z8_;D*RB1sEaFWnsB9D)|l{Z{%@M)|XMfjGE4(`A|qRyV_*Y^zSp8?{sMCLAdVh2;; z&DCQMz5y?f*BbnHHlCexuty?hW zXZ>t$KW}OIW3YYM0D8={_P9fP`6#QSXD7A8dmwF${d%Ilm%X=<7kN$2!QQCz^c4rs z{gix@?pFJkMUkG8)&1%XC$}gB?|N%@E`3!lp7Z#u^mVJOLr=t{gN2TqTPADW(tSno zP&M(3uG#y?I;l0M4IZ?8u~EP3_j%SQ(XQsNIIZ~8R$IK*XQUVgHE+-(acTOGTIi#- zwcN7Q_&|s5jYV^CkG#Xio~;=tFWHZsk`t0NCUJ54uOj;Rb}0p~k%F^P%^S|4vlq)c z>!dPH{*-J@cM~m`kr|K{QFyld@non_d_Y0ik;68lz1O~7?z_-pv+9G7Z*6vRZeK>q zks~&I8U#y`*8E!ZiE`Ljl+K30Se+`K4YrYCrjCg??+n%W}sy z<8b9ipF21z*EAemKckZ>0*gw%**`XT`7H6(wOK{>@r}ucrAMMdrD0Jq-;Ta?vHUit z6<1yTJQbYmupJGXE*O8<{^a@B(WvtZ0Sb|#_=`#92hWNMiF=X9b=S`#e2vPL5=5sB z>USPYidOa5SoEQTyxJrG;o#uLBKVsV=R_o*@d}jKZ<)Iv-4vzUvw|`huM-i)y!eYK zSB=HpvzlIWT951tZU}nh>kjEe?pIsASGvaHQP^JjHDG8+=WO?i`TGYa>m%r6{>Cl+ z;PH0|BFSgT)Y^OfYI(=aDlJ4td4P(P@_#Py`k#q-tumaEGP(B9An^;OQ6kkN{xxAM`gS&(cqkyyH|$#-U%v8Z0N3Q&q12qJ(-Uho$!a&}R#Xnf zZ*#b~!a8{RBQSW^XUXK+^)0&Ry0xygzNxbnHFZ=|NPGTjPM@-kC|S3FjzmXP<+rsE z(Nxs-{+%Dn`mqS6iC^qRO2dkVp4YOtT3Hk=&%T#72-51SF*tP^6^0q@+PwKvGI1Ra&}1N?JMum2PPP z>6HAW3 zbUjw{!*lQ{L8=hZeh{9uwzVvZ(y_MXKfJIIiPH~RokPp_-WDpiwlDc-S}M6?pFH3& z@x@Iaj!-B{ny%|3pn!T_aSGuI45-y&+)|eNE)RG9JhS!Hcsg-juS3V zw^tMB#Lj6hk9V;aQD)CqgJ;jrl$tIRsxLXs+dhn!yzD%%#HmWsxIx)TcZjz78Fsex zOW3k~^UmkTC-V*Gs9vAb1XD^pNyX?=uD7=Y{0y7EZ~0-|&Ry;#!1z2=TJh35UGPt7 z7U_M93GglEL7PR1d1{n{^kqfZ1|`aeea(8*x-apX zk`5xhXSe&p9YpZxi^hsF1u6`Ve7q!{7U~Fji8KS^y@0s-FpD=Mk26GEBkX9r5oOaUb zy1?oO+?i$%ecc%2@V_Vlf%B#D3hY%W7Kf9wQ6kvTb~!2z7=q&)0;}g?=@lvD2}4ml zwBm#Ft7HU152MO@O9bAL?~4;^Jg(E4-z&p;Ah z^*+U8xxII~z_-!Qb+cChR~Y?A2j}Ri7T(6uY`v}b`FeuyRO8vr%@&=x zz1a(!iyPIydg*+cW}0@I0vn3wo(Iid=n^z^5E0?M#%hz=dU&6KBIMgUsrKqt>qO=G zL0l)|Z{-AN#;2y(^cEy2XFQ2&JoVQonZ-sug+lxHHiKN|Z&7W&b@A}R3JLn6@UBmj zCtT``Q0ac3H+J>3dxAg`A-AmMm?HlAT4yje>6f||(l-PRR>h}-Kt}~A9&2jBYL{t0K zF>yZBGW+Ls4CTkKLOq$vX;b}YM9WhB*|Ss8KJFy&!FiA7^GB5!wyY1nGE|56jilO@ zJ!n#Pj9B@z;)yC-bj&t|yT{oek^c7goTq6%ILk4>Tn|)#F|aiSd(Jtr`7vXsj_wep`uiT=XnMNva8!|e z%TX($?4B^}`zia&sa#osX+OI+RMvJizeG_^ZKLmvddzY2#py4Eo$g~%5NH2H70_r9 z5rOHi2WCo-8?A)JwNa4=-H^T?_7%4ORXKxWr1k-`&t9)ms@VC-+^Ip+<)+f*@kOW7 z<;D4c_{GLn)7fT|*m-5=F5&LptdCdW5B-a6`;mdm-gZ*jQb zN+q0WIzyekX!5x@TR**QQCa+O`S)zk_poVi`tsWU_1Bj)7pwO+Fi}v182_JteMu1U z=R33~UrY)TdK(yCN`CjWdH3bmUrgSmn_L_FTQ12HvxgdWz_7b2H$MK+G6P=*LDV- z6FaS?rnd2^$?M!Gb; z9OJq2r_-8GSax2fE@Cx>mcsRnVUxBg<^_!26BfZ=a8%6eK4D%AoA?wy`Ei)1P~)xQ z<1MV8)qa7^u(_wF-;|fuSgk~!N{cU(G_{pBUBalSvQ_!om-qrJr!)7og9b)-{N1lw@n=RLwBT3{|+?O&Mb0&9lKr9SEX>-py`Eo&DYDRi1_z_h-cpCEqy&| zaf`_lsj5j-!Tko`Fyl*|_kYR_xH0Ck6D1r|w|pMamJf96?5LUKW{C$s=vzI_I1Y0Y zLmkEWo?EULZ|v%hqnlE(j9P7k_vKiJr*%uh+G{z>SKL9DoyLo;;c?aD6xV}b<0Fm6 zJi3Gno4ao^xKkeAx>P&1-q}@+7Z(|kpxVr**0Gs+rWN<#=e3fz;oEO5%L0zKS2vv0 zxR`8r^NYE1#vI8);g~gUsp<#9ozaa6V(Knsb~qsdY9#0#dKiAzH>KM$pUMssq^8L#Z97Qt;`?i{jq-_5eyW%o1T1!Pzhj^fnj{{d-Xv z`g^7Qo`s+HjigcaB%g@SDi(JRL}y#Rsj($Q>-ddF^x$FG$@jFhUgxJ0lI-m8Pignr z;TdU_k3JBcJZF5J*w=5=@!fJIC1817)UCFY5KpwAQVr9%N4N+z^yw@BIF08Nc&lAV9z{G(-IFZX>5I(g?%4e4Foof zO4e=`64{hTYWbte+re(e-EYvu#I#nai{gLc{Jw{Cx#y1m;}JbFfuyto%oC4(^mK9^ z&36;tg+F3GYTX($yfao`iWWOEnsL)~IQM?T*w^<%nNr{=DfA4j&b`p-^w6&bZ}W;+EgW=JQ>>N%>%INo$oX-YUDY^^6P zqU2rEO~M|`2#reC}giP_&@^){1X9uA4#kL$myOQHSv)}mGP(A@{cm>eq= zrsA#rH^E{9!{Q8m-o4klFwM>W(h6+ypl5HeYXz95xdU}?LQ77#U?~T?R+`BrEL!1p z?9r3XH5sLfFD`(iu&_~ES)vkUv-CV6?M&8eoh>t^|29jR-oakpcA$ZD9p^xZq zia>Es7>b?{QCg)zANG#8LS1aIiNwfTKn%9eq0csSMk$sj3y8hSmN#Lzwkiuij%658 z0xH{<`g86sM%Y9enG+?wVkY>Ec4V^AE9kGsLBz&*34-0LDlD`05T#laptjkt-%*7V(OdZxu_;znU4;Z2n^=z~7; zd#YUk2Scg$*P-udm9O*CF^qA}r!d_g7#=|XSi@13y52@|Qp=;-T=Du?#{#F?ZH;Wi8iewFM<|IQ-gLmkMS%&0JQz=o&iefX#E z7m7!7m_)iCL)?0}r6Kqk1N5`Lr2_}2v#F1yv~xD6E1$f&2;!;(q#Q(eFp15aJ{2~$ zI@Er-F1huF3O_)pN%U*#b5nbKeoE9LTjik~gYA&hGda3@|96V?yUaYZ!$v`I=Kg=C zNFhXu)R}y-AVBEN_1%|ypH@dhhj*T1Uh@h0bH9w=OIl@1(wdWw%*^95KYX{gjrGiB z*=pZR!;PKsi(QFZc&uj;lj^qAC@5a?QQT*Crmg?ei}F3O z`|&GYOJ2R!D}&Qf;!}+Y!wDzM10Qgt1xMLevMf1!#|vi~7IO+y;uFsBW`$yh*{px{ zuDL%m$QPOHr4y#HXk72N$SD-OfBS1WZ>TaYemm!EY~84;&kMEa+v4Uo77dzU2`5w= zpZRdydh)qS5l}apI1+cxvx$PhqsJ68*#t76bO<_130e6A?D7 zqRC-;>LW|(Ne>p2dXj!BnRjzcR=$P%W^(Hb7VK6(P&6d(xonKB&y84eYw_R06R-;i zoy(6eY4=$=TUZmnx4qwnb=093LeL<7DeP8#ie|1^`d;m?(bAM>ZztT@+^xF&)dk1y z(U+sYpV+v>SAv%r#A#8fg-Ddsl+6Ch(2GlTa<&!jnKY7Q@pk{(iD%zuQB3Q)jGqn} zNRQH*d~~^I9jv1@)b#9~w@;UT)Hf;jvx2dETZ@gjT zvHMT9m%{O3XoK*~W>vYJvphOE{k!CBRI+}5-zoock073q!*PMVT!WY0i^zn3?7ZH! zbd79VZ@ek-nJAg$7V8bIKE#jTdPfK1qbboaJq*t=%U;$b8)dOBuba&GN`19$M7*xR z60dBB^Y$;5-#p=%C#t>>cP95KzuLiMvgduzfCtl-ZSNUH2KIu}urT}?Y+F&_6#fDn zaB6=QGT04Co%ba2zu)#wL`-t?Q53i~ziRmV3Wxi7Mdw|`?Pxuo2O-9>bZV`-`H$|} z*h_`otP<=nDKUx`{bc;{T>F&)IAr zQ5|`67@A+p`ag$%kH$>NkM)0r$$2lkj)#gK)rkr%+;ShS*KY<+nBmtWnnj=H_o>qC z%gs#G-uFT`P=nerXEr@B-WeXS!{+^ll_V9_*}kWRbiR~uTNXi2RK&^;j6h?c%H34O zHO>!PeGwk?(m_D)=O~)ubHfOBK$8CnIKnd>@q@5Lw&N~(;xkgR+6OmYGI450K}Y2M z!t;9qk|TtOLS;!}YNmN}O^cO7a7KgzjBmf$a4?-du+b+UA%0v#n5nV(riL&l2cBI& zM%!64Cir(kHBwl&nwb2$ek&nm;Y-Z+p+wmv(xkXD&yT}jG!Li(YYfNv;Kf}WebW_= zZlNqPL2)I@Qk=B$Vgd7EeP8F=8+#v|^*AfPb(cO5?`1u{b3ab6!@!Rry) zK_X?aN13A}lHoJ5*8Qe2aMbgeIoFTZ*NMbUjzZzhe39)!{fF*3yDY$oI18h4l4SUz|AM#?CS~7MdZcEnq+Ti@Y3ms z2N*x&t?DGI+b=3K$k@5AHE*&t$}NpqkSfW;o+L{-o@KXmPW+e!v%nyeki5_bvwe(t za$&4ZQ>$r!vMj2-L^z30T+Y_yB>T82;mDfk#UEz?`$ z{Pv8Oee0<9+)ZL=K+6|=Xp6J)zM*NdGXu<_OSOT;hi!<(>+1wIg_rsnJCY6|ZA~wf zHtR|Dbi;w+m^XOxzPw#g9SkJ+=%17i}X47-}#2HJLnMSP`Lejlb6B)%e)nD2l zlKaKAD%=&sk*6kYmTi4HpSw6nHq2a%PtZra^=Hc9>%`HVo#}`luf|6~ZDj$fAY!>M zN;+x@HGyte$!;H*io;>7kz`2`c*0X{L61VDQ>t<~9j>S13#SS^(%t$IoJE{YYIZAN zzU|hh-=Ae%LUsOh2K2{1CLU$of;%ui>5sd`*w3D?FlD?)?rR&bEqXNXkrP48I=}cwfN{P)<4fC}LjK={!%Pll&JRBlf$c@e?JwpsjaD)- zLly37b*^ZBq!Q4@2miT~|5&$rUjbuNH~cKD-08`?Hm#M9CJsSUT7RkEQ~;g|Qu!3> zq4k5>vhOG!5n-$mM82hcv>sEgbt4Vwe<5${duh) zm|rY?WLW=r9cV=e9BvbGd0EkBE0A@x`+#ny>rS-5=$-uOuGRP%*~rhIKA9=ZiyZ1; z-mL9fgKKB(%y{@6f#28BH8!rVURHiMpi?D>?g2}i>EPXj2`*YyT1MpF3wjhzP;eL5 zp*>h#B+P!vgGm>4Xl0_?p=;PG^`^tk9~8avnS>e~?6fj9KJ^E2qm;BVxniSl3*6og zKdP2qpo)BSgYRgR*l|ap^TDkLV2{oSps*n9!C&afdVKjN$+{+0v3Q3GM*to{Ro<*o zqC!SWQcP!8%0D`no$uDEI9&SWPvK^!e)-B-LZJs||G^^mQC|CjY1e0!qlBdu`$6q0 z{~zLUH*`fBeGbs7Pn~MmR-YKz6PS(bHoZD<8M*NFtGh(`zxw!$>{NAH(8s5Mzp+dS zcD%IVa^qDs-yu`9UxGs|dHpy=dw)OdjO|5~Y0Qef+glXv*%fRkyd&UJ_{bS&P|C|) zOUL(eY4%&uBYpG)Df=f}KPFDX9M>n8M-86QSsuPm&B#qeX=OIh$;qhUw7pNDq)fax zxKE|`>x0RAW=T|Eb1qk(ZyCSRgqbZq-0$yu;(u%$hu3R^C+8v3VYD9`WcSFKO+JQ0 z7z^V#HFe(F$3)>PkMpDGhDN=uuXk(F+MT>2-*CxTJ&v*ed%hH7-m*v8ao#;e|Iy2Q zJF3;!fiH97Z59)L#a*SSc39%ZPYaQ=z=qO*QuD71bTX~F_utHz2>IP0y%b7F)NtAf zQaocCFJyT)*As8IV`O{2q9*RPZMxf9>$JR^d9c@1sYPR)Xe5;Xh>T`*N zS|Tr8(|3K{oFBPeD9mf&G4L@knkF@~e%oZVmmUXQ?QL@fW0F#XryTdT3rDbyL-XD; z_6Oe4Bue{N{7YCOH}S=e5-q;+7HIy`D&vrinr~dYK9J9~a!bxAK{fwbm+DjW59;wg ziu5-a4*&8;XLQ6jvnK?h7=22>EW{aKk#yD8;VyX9Z*<;h_c89gQES{NaLgFpB-~9h ziWz%eYY^q3v!oJJ*M`3~a3ALX$Q+a3p75u(A~4RDNkVaG`AvZ~ z{BoT*yl~cf1m|gqi{{IPA_ea98IBwLdSa++mH24fGhfhetzWnOgZ_M3U~n+W?cu@B z2y>0~bO2hmRwsS+=$EPImC_d6ZdHKFz3chmBA5p{SS>WEwZw&HoOt>qk+u=}eAQN# zW}H^z>11>}elg1f(b&ZAh zq**@nb!aX-g`!_}<|LImtJ5&A>IWV5Amv{C%Ht4=*%zxU6>n+z@W+SqcAI-gN+7Qwmphc5;`AFr!EJ}I$E!SVTr(h3l zIAc9i-bs09uAoD{pu-){D*k+TIgZoHFx5ayZP(m(IgwLW1-C~Oq^wU!S&N$r2ykcD&@N=vJB~~Mp&krMTadYw|)-h_l3>cm^94@(sw^KmYuJi(xis)&-rp2Jz#~j2zbx*|^TJoKI?L z0aR-eSpz?S!xEL;zq;v(JppaYw?MwYVMoQm`9rKi_qs-{*|YyMsr2Sa5T>xBq8P;B{y&on z4o4bmt4n6RjxG*nXBz(gRmJ?fy_}HemHi%pd(9I9b&Cw-@ z>%Jhk6g(Ta^t||{G20ZuezvV6db+(FT#|a}aJ;LuXEu@2bi7>PjeA~FZFh08vz?mi z?Qz-b>%G^S13m_o2zDno{#FD(I$1f|x;#lcKRTXE2sz#Prevotu9#p!cR3)sOBdYh zrB`*paQtRAgYI(goV8(UWzY9?`_Jh;@%ocV@OAp9r{KZ$p4}z*6-#&uvrliZo+kZslgqs=AkqFp>+FSbJ!flq(8c(A zllR&F#q_1mnH}w=&&9VI&ePd&@hxAcW8<5g)s}CXj#uu{i8pwiM)z%DhOU=kg^JS! z=r(Cq_1+aZ+wP~>GYLQ5OXUiQRa!Uf#D}$;~op z5`DbK)5S~8*}avs%UH4{=F;eSusVFt!29Lpk%jUP2O5BwwYdvHFUq%c%iXXe%@kH1 zN!p8kI=YLWqXP@L!6zn);|5K&UI+7|iIF9Aq_g?P6hS+AzYSDjQl~nJgpZYEX49Yh z+&;MnyQ3t-#h=5HF0MS1ux@9h-yIS$HP7S63BC3FCa&b7Y74F0 zm(~|=8h#)7?&zIzT@;;@b4^nC3ZK1UU6tcpTEEz6H8?qOhYi`0bNECIEWCS^4PXAL z>}*{eDEr=SV>m6f$}8o$l23A1-l>(>Dg6uI2(#zBYH!U${KPJ)lz77}XHw?^G zo5Zrf&h|@>nx>0Q+xbbXGSjj6NI(Vm^ZTEnozV~t+aPNl;oCp)c%s>o8SwJN+x6}U zRkdHc{WwM{X_u0U{rp^^p@3PTtkC(>0u6b&+7Cyq$L)BevnQ?^3h}nzUg4H2vU*t2 z7UaE8FUxsX#+0Ku`DNTh>|Bpt0k<-#hf=<{qF}OYYGMMF)bvqDMeQ1!&_FArY6F6pwT`ICfCrYe!XJ?&@T;uI zZ6nVH#=s+vvgvC6O2yH>>7yAZi1CzQZ^p8+4+SX$GlTD#-3K1$=X83?;z81g-lFV4 z{8KQtASLD~+?3*8UJC72`qS2Sb){}kS?=&T#^J#QQEI?-tL)UmmmCxQ&9x5CAO#)K zH2>s;U^Nl{B1rY|KID?<&4UwjyE zA}Tu5nyz~gThFTRzq(-(jj)DUJ%UEOI~&9yg_ZNL>TXJCy+!Q5pK?MsbUNBJV5w;% zB+&gYS26V#cZc~B>MbB(8~|W2ZBafx=z|1_F@t2|0IVEk01fd`b}*HAe3>~gglmX0 zZzXkev*e|uxDW(8LiZ)rTg3ba8=`#f158MDLE1CdJi>bijDBR8JC6AGZi*J9dcjyv zb?x1hKr;4^x-B>+SV$*{1;6 zyXEQT#}*Z!ooRD6)*BKS!%_lO@7J^xW-1Dpd#gMova}rGZfbxwJ7vejGlE=t1w6BS zi#tHS@ntpzSkT>3_pM9g|ED?~EN+a%9Q|1nP!O_40qoXyCi80|C?c+$ds^%vKT{EN z)TMRpX^W;YLb+Pqo{NR32=etv^6Z=loKQ{!%DemyB0_3f_%K_{x;~{`P zLz;I6QVw+67@!ZLfzZwTDm1N_Bi+XbHvdbdQ(6HaU-?Zvh z`LEKXJEIyOy{*7Z^Dk?Ax~c2Z?J2;EhY;!tqq3ea97iAvybg1fbdqgY6un8&0k;5( z)G`K&9);A9?I8;t`354@S}jshMMvOP^exJ1tpIC;dyIQPs@+cck<4F%-176occ&2) zsoDxm1QDbzDHMcxS6nemkiraJ>=T2llbxLI2SA&EMqC~ONBkw4&_4VUD9VsxVOwZ_ z=G`H*?e!Oq4hFL_uDP4wCViVMz?FpOn_4fzIp*zZRh`>2`;_ zctn)En(rmF7|)S)uXv>pHSkMKa?8~@ATVUiss3M(CA7;SUxk3Y3<3GxZc5n!6jK&O zKkOiH3O8GaeA8&!X*~Q$Wc$v^=)!+ajg7UtGU&-Kld$%<$cRP$9K_=7bk+BEzq zSc3Pw$4puWi;>byp4ORP{jRP&ORQtJn(+6-TqUzuw!hJn%;9@Gl{^@y6a;d^KSO!f z+_M*DUgU72a91iC{pIcHt`7G|VJixpdNF6uMyb*>Ss-2+Db4%kWbx69PVV;@RwlU5 zczc8z!ac;Y7Zr-7ENf!J*_L>-i}>D#cf{7OE(@D-F*}7l!LCW|$$Jo^oV}=YZ#b zia2?M_XHCxzh#EJ=I#mo_FVSuqX$Vp?=x0^pwNR?@-RmUQ)7GY=ZaCI<&sS{+@*en zEqZ5KTAE_X%TiV}HD|xLYvZ=;fTFEp%d-wG5!?_g=Y!R*Y1GJrMbpL7J)9W&LH_JT zWk)K3%#-Fryo?LUs3Fh4W^OJ`LE* zO;&$ebF!!$oY`_Tu{HknX2?74n&RwZE_qU!mjPum84Z28IeW4GH!}BfsW^=2+gip{ z1{hTenP{%i60fM)cF}x zogyTkn^qrJEYgzv8EU|dV5|xj=;|)qg^a?gVi%Y(l`iYh(*X8Q^$jP%8i_|d8$!FU zS};d%@DHI}XG>5Fj2I5oY&HzIf5iPq;`K!xOqr~s_4?>(qN_WM@#fTcu+a()j5o_= z=r*-T8oW7~PV4&SS!*dD0WMG$jXuF_=jYzc=;~kn5_tT-9`u-{;8qem$Gw~VInr^3 zKBKy7e@HGD2*P`c5M&C&jm$XLk6eY*q|0gx!TN@@T58_shV;+1z8xwf(A4j#N!~Yn+H%`(@##^0Y44 zK6HbeQ4cr+?z0mSXjM++xWvYo`F)Wv0ru@zz`K7dojd#Us2fEPLM6MDf09Cz-+fPI zGa{8;`sI(;0i(Qe*e8ACCpTf1k%(?-C(p*$yN0DLDM`70RG5tX;qn_B5BL!aV=cIW z1xj0)_^Rtb8S8Lq@i9IUe#2IYwjgE7R=qAD6Ii%^A6&REw)PYq$v$FDJUtq)PxyAB z;(_R?O4o~03l`U)2Mnsaxl*+=2n);_4k!+x;9oN$pZ_4evGPJf_DFRX?rENZ=|B-O z&rSP+13?bY9Bh-ozcxoMoBsG6;67j+T=_EHH--3{k;oJpUFYZPE8K?M&_U;rxLfs6 z!~z1{&lSt6yEjrs)9|k;({!|cJ3$z;MVI^;hql5%j8hrq9D#)7x8_D1@kPY+oPhLc}h(3D1p$MJ}cwoxu|? z&DCz8@DQRJ$I!aQ{7C#c?o`LF6(E84`b8o>ffZ1gwwyBeWF`Nf??D&$#oyAitkw+V zu2e>eDsR>g;lF^J;?nZd(6VirOe`tCj;|Th>!z7`+6A*Q`_d(xe;tR1P=DUojoIy$ z6ocy6`UiZhAmq-(QaxR%8+dPbmwklw7QNNTsn7!cJ}IW6Hl`PDbAGAlOFhUbf{wYD ztjjOaChtP5uVpPn=heZtktbn~`WMPmo9U44k!>9v% zP;nU3YfF1!*G+G%ew8ugK8?s5Lo1G88|xYJ`To~TR+LWlPn08VT1Nqow&7_@5hA6_((C}r5d?BQcgu<`uA;2 zcX47`M6wJIZ>mY%fWO^6TmxV84dtXH97s%gJn6VZ{2LTU?h}=f8HR^CU>C<*M@m(p z(b2&8X2U~IwN`w8_*B+&8fNFvaF4a@*ZCnG!h<)pt|{V4Cnm~j$+NOpR_Y-JH8G66tltQy;* z3P-B*ii%&8x^i=lRB?d@t}dHb*87M9X$0}_m^`ln? z@=37+>jRios))QG3FUzZ1S=(P{{FUy&qE#wk}zdXutqsvF_@IIaSH!mEO)Dk{$RR5EnrUwWbq?+c6;hyTsn-%r98mxnX+M}C)Q#$10l+A&KWlqs_Xb&V=ASt1w0&QilnW7mD22?)*G1{)|dUOJa z8~etBO5y-i68mC6id%$Ca1c93yGfk!NklsIjGY2I)q=0K3 zz(o4u&+=#_xwLu8h#(0nVHR=~9rMj7C+FaMIU);V;{LX=_9XgY2k=9pEZ& zm6fJp>7)P$gp$@t{zVAztR$&Om98&RS$_o1Upec@(pc9!e{s3GzCxGkyEj}i%kfTv z7Ctd0Pxa(T?@3p}l@zHJ4U*CTwB9^3NMQH$LZ#H&NMKUg_yfh{Z$&7ZFx4AyK z%|BufW3%HU1;>7^kxYI?kaj(=tYwZ44)^dmU`Vt*rm_|ci|tM9VZ?NRc^s5Q^oVwV zQ@4niSo}ny!;8f#PbR+g0?LA!+g;4jSip(LWS6S6tpvl~ViN;#5SSdl+HyDB(Gb-E zCalz*`DfYeh8)pH4{sLhyV1%@q983_F{`Rv0jWkK zRbL088)GKwc8)9Uf#_Dn{181SABQ=HZL|1o`dv zyoT*zKrr{)w1I-S-~LI)LmX)g5l_p2C!RZxYPKpvl`*7Z(5EelO(U=a6{7?aB(ZE& z%0f~3b8vq?+&wjV0w$T8t7L zzj^jgMO$Yujz)14eXUVoFngAGpaZ5%9&lDe8DTNYlrTAl$OoHeA(^E&3=m6fATG2i zKL?MH(~tw~6$m z3rB<2PkD1t4;BB;w2~iR8A5GPz+b-E2=M$XTt%k4#V-0sVvHQHBXsV68!eL2zpXGD z3y>L;H50kroF3=?-ZAfdB=cc*l5y#)iHa>O$aCF?#yr$yMGN36cUoS#CB+|}0JV`q zNc@p#d^1icm*Us=iNt?aGXV~sodE(tFDRG9M9x@#F(bXcDns7W8v^942Ml=qJ1CZ+ z;uk?V0Y7T>h)12$3>*c!)^mS_|4gi+l|kS*ISJeTxvipQ$(BTPO;lbFT-7GCoK$@m zxoImCnL{8_cOuw`n3h|At~e-4VkR+0e&t6-9`_+8fRr#-nmF;gGINASY6HbVumj3^ z^^Buxj=ed(5Ap#axkS0ai@3#nu02VCSP>kBx%Y)1V z#eS+rAo+(JB=r^0ANC|CB?4Q3h*V_(@*OfipbLH$031}jggs?PWF#m`sAL0B5q!Xj zswCj;f;qrIE>i;_)-7&?p#SMmlJt)FW?l&bF;iJksGw3k>xn+!b3YNqkj(EqSx(;gQV{zxM3TS( zk$?xU^>XYY_^J$$L3OdvLa9 z;u~9#3vfEI1Xf^OpgR%oDLMw~!x1Fut?v;AVM^r`*5~uZ8n^|b)r2BIY=6omDA1{u zbK%-@IExJSpNzjaA9QEppKox9)nA_8GiVo2@jgEJ`#IniZqiTvR7eZ%GDg0!MY$j$ zMjGowGWaL$Rwkhw!yZiS&ABs(NeVCI1;gA)qaIKPn&aLK21OTi|4bxgc1(@b zF*2|+(L!`iDkB&MA^_#VXAp#dyhy``$)P^??|_|VengroL9snk0#Tey#(|&>oM|0C zrx+a$1^T)eP+>_w57B}uEPzPR+eGm3Yydr$N1_1-Ialt_bhVdGKeQ}S5+ot{1&81R z%IXD0#n(ZJfuQ2;f(enhYLs^*C1T&;vAZhx#Haa(1xeWKRuDy(iM$01f-p#DH44bu z=1>mA8c z`Q-Q14o`qsKTogtX-i5Z*q8%lzKglP|G1JHr~>x;ls<<3y?s@tnE#wqa(fJwN?94E zG>CHc-+lk1d{hH zz>BT3e>GMg9T?tZx+xv~1tpe5^4hQg)U@;IObB0@ZX2RT?Q?SktdgWN zkO64o6^l8t*sy9u@Db&z<|4rgpa61Qe;YbVDDyMRCYqad1B1mCD=-`T)JmNFJfc-{y=0d}fFCGW)*;3$#BGtx;X z^ywT}jHy3m40*#5-K{!8!cCR((NV}E0UL`DbmtY@mX!r{5I`hkLk%_J2rz@|p|pJg*HPw=0w`hp7)qbf!;}swYeRA9KZ-!K zCkPEIwk2uGj<2sHE(0?m#Qnfj^pp{xofL|i`2QEIg|lcXOJ(K+e4mm~YSzPSldu+G zQhz;=DGyH&JXM^s~nRzS_0xg#}1&B3%D=?iCA@A8EWdVK`*!rfokI% zabPXmh3Yy@d}{Ak!^bHG!^rh)rbgI_QL=!6>5UNpUUIwdtO_(m;v2 zKc!Bu8(R6-*s1u&E+~9MG(v-ieNfj68c0%LxxTg}>>6F2D=0ow1G8sPxz&XfFkmo3YHd5n%szlymV7how7m5QNpQqPvQGNr&K~b;=2jT0DJ!yAU`hp<={8sH&WWkU|c6zdt{JiU8;3MfmBi#XZ$-S4RY&lkQLx-6F#L9ONnh zVNi4+6|Q}XUR0W_i_qM9?ltUvhlVCOgwkzfhDE}@6M`$vqkjx{Ucjs83mjO`TyO_+ zg5`R^*ti}{&d84*7aJyw6pOjX+OzPk{T&94b6t!R6j$@Sk)3^Ajb67q>jUSlgDeo) zT-3-d&;sqr_SDhqiv7sHHL`KHq*16V4N>5z+ zk-h9csBg-Hw$e`+W0oBF)o&m9EzpLK){`)th=vK006hTt^uqcTYwVCZU0S;ehaejw zZ~M;(0s%YQY{+H$z_eoQ3Q%COfq{+#0ChkU879)80Nj`lg(-fiG->;|4`D=*Y!Q0- z7mx!^Sw<09;6)4>^t}H>@#fq|kcY|$C`Sr=ZVJ}|PxBCC?r(Dx6mU(=5f!cfTk*lb z6AW1prl3>>gC!8S$9@STJpwvQ$OQUKi?3Gz0UbSJ4s#Q~L?CrW3CQD~P@RMv4YeiN z|3{&ST#1OzSA1PrbQ}ro1hiLe<+|-qnEhKZSvQ3Gcm}*GoWhZzUQ$+r4pAx~!q;%O zI&zSLi9jwGJ-8r1w7P~4!2ziV(DNZO)BjWiG#o$-s~uR(Q65VF%Su;fs5XJ1F1Z21 zA|iGH#8&!}K#&3xg~v$G4oB$jx#H@dzeWq&tH~e&B!=>pOIw3# zWI7b$vTs}vM_sAYCyj_`34C4?%4}3n5U^kYnNlM8U#1*`2He2Nh`1b$*8v`Nz^oaO zYN-A@_=0S-n~nVpDwH~6N1*)uU+3_Lrbg@kMHnbmpvavJg=I9C{5@yn*zMollqkf# z9ta2er=n#&P7MRl7K7)FQ40h+e!`%0wqSwAHOM%+cnW0TLWHTa@uICsFyZfSQ~VgJ z4pk-vN-b9z6le$nL@b*(`^-Pp?jb@e00bh1@{m{<|A!xFq9&d8#PWaFDJ*x}Ap0O9 zuSh;3@*Um+iZ1{pRvytI`-c(w!{vmAX4}d^toB18d$<-gZF)J zD3lRCGA0EA6d6jS$D{)nO2%%fu%4Y(?d+~hVzHD9%z|L6=6frZ$r;I3mTA`!E-B8 z6CU0!V+6k1rwGyKaAY7s3zXzI@NZ5%&gPFon`tXYm|N714cA&Bqpw?tH_|*8EcImdV|?XL#j$?3%}1DAR~B5t->NlP6EW{kl2ByQl+2? zsZs?~ssFMLx{@IqFkBmz(+pELB)AUzAEJ#sQ!twXGAA_K>R04|=rXI0uV3T9FvZOu z8?>)m;pb>as}H63_R@bMb|Q9l6bSwEJoX{+I*X?_@UZSoYL0slEWzmG5Dfgb&QMB1 z3hd~W5NdEuc>yw67U=q1Z&&jv1DTsYgn&T+a=!Ra8W6cq6eOW209q`_dw(e-ogNHB znt<&K;2w09-NLxPNueeS4A3Fae~uKc7i*kVQimP@XkPRyrT(=BxPcf0fePt*9G2rl(pD}WRR(w8m4t9SqE^Hvq~<|L>b zK!%$C0ZK%i@m!lkC7xy_yteod6cI>yK(IDqLyM6~0%HaczN=Knp%MLCrjY_f;6*&S z24#iBTT+2S0n7&hTuP^YkF!tz^}9#p=CcEjmdu9PfcIPA0D^S{CP>7LJy}XQfn4Gt zG2{}6+rfw<-k5=--J`}ZYCr{H2JrR_)=&{phvvCgK$zdS_6>O(Fac zuTLIVe%1^N?kEZN4xF_+>uDMhJDsH}IoafVQ*c(hV@)!TCNsz>d6opBUztN?=Ip_w z3>lvu>^h$L%_jeF?e`pYph|7Wg9bFoJ=3?XU~e$CVGcxQJcBZ2&}(L>R;DJ$tDF$U zcK8=K8O0ytdpy>#H-T`nNttjo=;=7QC&@0tn227z^7Dp0?dFbO_8Vir7EX{QWXm)| zjLUEw{6H>tR`aeTRj;_4p=t9#R})bB6xM-yB&Y+3OP7tku7M_C!uc9G%t3}Yg-jcp4pm6HG~CC~cPfpxLq*gw0pGfL#g=79&zcC>(T zF5s_WGCh;5v63RVhUDNO@5z!#{(l*~0?C~^z;NZKzyt;Ic7L@WGp6kM%gR7_EaP$e z^$bl8Ft6HS@5;?$wan14fntsXzFx74l(tLHzpZtMFWkSz5#G68u}lX^3kQR56!gx)wiXT{>L`ev1{Na z4{zYj!1NA-vDHc-($XiHhk>rXy`&Q4N01UW55S}mB$UlJ2G$^iI(8%4GALy)=W%uA zR)Uu@DEE3Ca>(RAZx$dWH64PY03wPH#71h?bdpE9l*g;W~b}z1?4MR zU;z>Z_&2lSaEycjy;Pyid?1HZ6Dn3+Ode4W?oj%sO~trY?1 z)nnnpD2Uph>XUOIW%hxDG{)tFL0Ne>8({fgpa3%*&9JzK#6S&5NFYL*ME*9@9Yp-U z(x#>x)b^G@Ps!lh`OmaL==%3oIf12~b`Q+?N@46qY*kVQ%A1egfg#Lf9->n$g-uS; z>SFg>b*{Zu9$P7(1bSnLk`EZPf+t-B z4EjK<0-3Y}G4_HU0VXg|T+ZWv45unCbjTkHeFh(YOrh$VRMAKGNS~lMDPUKfdpM2D1b%R{)$|M#&+ELP{9;dD6c^Y3%uR9z>L@g z{6q^85fs1KzWJk*`V1wm^>xoU?!t+3J^%x|DTl0#d0`Dc0A z=4KOGk9H48>j1aBYnIvIADhYG|kPuI$@t}o8tT3wz@u6zsLK8;ajnPsV&_3yG zrRb;}G{QL$q8>&-q5~98P(6~oUI7Nu2w^vnc@i;dhfKoJ?t09`2Snammct-bGadY35=3oRq0_DlzW>*)eh@ zz6-R&5t90|x1bLNWxsS+jPOcF@{Apl^KemlSD>K?W-y?EaeGZpV0!7}vtFV%{#K?) zs-u1mO~~X~{mLQ}bPa&PFY1JO zr!uAC42r*kn2;Qd?TlZw20jjAX5oY;MZSG|J@I}3B)UG-7{UTR=ytf?hB&z(nFlh$ zg;ynbHV0dX8W^{`lpj~lQf*Csi(8SF*QKijl!#^VJa+yscC=_;R_Ncr9 z(b!$^^oAR}886UI?{cxe$VFWWbli|i{YB=8034Dts99sBiA0(V8A?k@{JYBewbxx8 z%K&2lb|{i*(>bJTJ>O|s0-1@!;tI^R;1_*Hn817B&_1%eiFDXDhKzM0dWv#qLtfqwhs$HKDXCEqQHxFI=UV{hC7w$Jg)zJHXnLr zINI`&-<~#7WM8{s2x7`>eiDN~Z{r$QlO^+Vu>LNE+}La1W9Nl;`jie zwrM3&+Q32C2Hh$a6f8iYfA}DP1#&b3A_}-4V%A7a(U{SZl6tm=c8|2hY$`k+~^%?W{u;tbjem@YEe)1sR36ycYo8v0y{6NtCh zs5VnXDNxJZ1@+*+fJHD`)XNV;gv2r^jqtxB=T-)QL%0ZwyWr3t)6%y3hHxwd&1$~O!V0MoJN85CcMo<2_`XBVmgmT#!Cyg~U zEb8iiwRyaG*D^6+a{%yk)ol1ZIRJwFU;jZ<1jZWi7fT`i&>V-N+$9L=W6(f3S6{Uc zB-#pVM#9nF%agr02~sq zB${k4%j<($qO3NofEh(y)Y*8POo=;6e4k7@h}=Gs{QmKl_Jc&s2SAGw z_e!DN!eNmb2YZU!Sx*r)BR=;{9UemrzW?L)G9FYsPXIhfuuT4Vs-&HaM98y_LpH+$%Aei?V`$q=gz8V6Y~PgCJwmw^V{RBO#wn7;w34!wv*#pu6bGUv#bPGSuoXBQ^J{g2B%nZSd z1TnfQGMHjc3^F{0nHZFtTJG<88lM5XLCinE5K^XhRJ)q{O5Flb74deUaahW$D&mvA z5M5OZOH*EmhN>W`foDJLG8Z{~E2BG9?AwTVy&#aAsz=SfxIZ3Tvkpi89-zM{RzpgI z4zc2(u7?@Z9KurM2?$BiJH!Pw(Zw;%1=m-f7iAV@{^$(S2wwYMP_Wlbs>In5en4I9 z{GuI1gW5}37bJsQ-oM5*j6sSMzXDb^B4$S}-5Xgs8dF`uas;WVD*Y+>ZSR>JEw1PU zCRQ75aA=sgeDZi>2WYdLu#mk#z43`o8xh}6_wOsKK<~*wg+v=sqD9rITY+r-yBS6` zPkg7;pQzf_>g-*(&*Uvlk1%Z zQ{JKAYNi^2awLp+S3cXYwnRe;DX=%8+!cyvKA<2Qe~)`?L$mym%UeC=6Ix|d^~jyM zdTb%zZ3ttPpB7!r6*{ofmE1o|?eoEC}~+55r$*#TzA;k<1p*!g3 zuQ@kY$zf!2_WsIWygA88xlrvN6lkJYx4mAiVmFPdD-t|PGfT=8qffaWRKK`qK4nvg z(ZWzw<`s&~#wtAVG>48{RBoct>u#br+*=}T>GwHCtv1Vi^|?h+m%E9(TlYr9Ac5*Y z(&SXI`NAGY3vspnCu$eg#t(eHsBB;W<@xcuiCb>Y4w4jU3t{f5Ewx={57@hk1e-%w zQO>V-+J>?uktAY?;pe-Xx@nXqVcIg$mT|~XYtb(1AJ-U^;bOd4#*iO+2VEEAv(>o0 zV4;eQoMl1xLA}D?W7DjFB`tdZ{~LDmqO$g0yq!`=0-IKcC^&NVey@CyubCnLv*sT5 zVn)tzAAaKo`Dt+ShuSITXsPV+>{AV|Zi2rTSg?C&?l_%a+|Hx;ErYwOy z1xD~h*BLocaZ<}@Bv zfw)`g$6c8kG3CY-u`8rR%$X9L%8J>~HfTL*U24CN-yXd2^u;~+NJ$L7u;C?4cvN|g zv%H*tIKExrH6!O%;|;%f%^<3D&fXt;ky#K}|9or)9bB-jxCpy+&l$>rptEHaBVu9W zgpUCn(4{$cfgf5T11WReru?UZ>kU2#xhxKSdVl1(-$owzu8uloTjMUh*oV7w2nI$z zDZnA6Ibnp?^oAc~Cu~Wz=8h9Vniad@uz<(df(`jOToZT0`P#vi9E3y_2u~W4I_#^Q zqACbFPg9sk>MzgfsN?Y5n7&D@ATH}gk-O0iCuN4AE?SHv)c2$m7m+u>vY}(JF&M46 z5}*FD9i?~hCca1xDpful>G3AU#pTc{68C(cv?TmNq)<&zl7FVhzl6EIC#wZ-bd%(eOCt+<6`?v33DMCxx za3y4Ej-l5Nj=2V@LX(D+xfh!G4kM~Ot2x6DCwj9q zze87Grbl2;WlCIii6(A;+9}(7?nvzc@MFq*l47pt?;QaQw;~13yNi>=APCwia}x%j zG7R0nKdp|!Y)K5}gD)xrtI`^OjN*N+3H9j8k)E*;!r;F6YTT%C19)^iwCyy2iyb4e z5Ag%O6Q~0in2zkMOcChm@X0Hny`O-LpseWTy)+jD90Y7=c~o~U`Z}*-V{{p+S?^aKVm%gq$D0LJjVfNE`}0&Y zOiLec86PzGV>z_n-u8r|>X?=0h^9g5V_Oc`3uzdWIt-FmZk)&`g<6yTOkqd?rVulM zgFW^p5nek(5n!O-=m0lDflR|aJ)vIb5M?&!he}Si;2XSAG=AvR2!2|=F@59^oC$A< zXB)Q8Wt3y|G7&6ouwPRDQ6FhCHH>z z7Tw>20GsAGt$B3JMu1;{(l1MpJ+nY(g;;{$DB+vFQ{EHqbf*dL!J%NB-K18WKAbJE zrwT^L8tw<6H%H-VF94yR0A(Jc`_q=Bl3x1W%=`sQ>Df@TZr&4Z183we(~`mx93AL+Dot|Pxd0BN)$>8G~ym!w71i;wpWD|^>p*MYJpz&fy2Nhh`_^1_a z-*w*UwOuMw#J-G>cOk3RsH+-7xp4h{1cQSqT-ngKDM|ws-~aMc)5a-3>|dy8a9kiy zA{u}kWhFpa9Sr*tVZh7=Vc-P8f>7^)sCvWs$CE!AjI~N1@2(Mix|=X*mWWL#3W?x> zxy%3TNm1aS-7}8Xj#7DNE2L)DPEbQ!O-_D@6IpoZ*e8!dQU4pfjFzhf1{xa1=RS7+ z$GziCp_H(&ik?HEQ?qUgE-hnQoJy6g{Q9{35UU!E5=KgJ(kz_2Jn`01I@7oabj;A4 z?0H4w2roYBN{)OmQ|YKsfYY-~4&9S|h*j%J1h_VGik6*nL9IunS&|jpZ&xm?mWqEB zX9uSM9bg5wt5X%SsJ8e9d>_J+h}5K;Gp|uJH(K?aA$;V6{dVL-Wh!I=)9)uDyhNA( z4xUG6jOr%p(*D_z|Gyg%W+QvqjbshV>^^Hse~3@s&@p%`^8B$3ADP&7rbcskYfC>b zEv+1<>_Jm8(i8wBZ9WgDlJT}lVO{6Cas!<^4A{>%`pc)+e zT_r;JV&NBO5Jx{;mB<742OeUr=O#|T%>h-OwYwDlFx@%C8hD-ezNbK-$C(X)z@L+e z1tZ6CC4($2GH^k9`9(&X&wLQMx)BT-vo<%SML)gwtI|}aqJWbO<%5~u3!93P)-F!* zqq(a88tygGbiLETj-j7VsN%+o?HgNa_a7NK15ndBNzRXC$t2PKEn;dKOGO~O=3JGiR&H*=x zNSfX0LTnQinMRn!5Zb zx~Wq&mbs&DMsp-6D^2lap>W}=!lX?DHG)$rc_SHV>`o`9&~pqs;L`NT+0&cuXy>`M zZK%H~y+UDo{s$WpToO|YUfpWUaAz63dmjFsx(7#}oTu?J(#hbzD`ELST8p zEw6+b$Gm%b+zm&MPhYhm`#@rSGDW;r26Gm ztauc<6vjNCExOvOXOq&F#>k7>=jiixZ@xa^B$4f0*n4I5Ew>+)PxXx1`r;}zLm2v( zSsls=G9LM=2>arFX>(wW5Uh47g64j117f~87q`L^6(f-n}4B8 zHjHRZFLqk3ciLsRD#<1F#H35|RPmo-gQc=R^NR+5mU3Ot|80_WS}2=inrkz7n7tHj zV9%zzSTvN%GxrYW zB|1G`CxUK$Fj|xqy+zH>J4#pLqLlQG;?kU4VY;xpqYCN!f1~GL3bSgIreD2i!C%#0 z=u22|*?{+@w|2)}u+C+sd-=ypc|1m?-0!_pzp^&GntYHoF#UW!i}gT!Z^*Rq(dyk> z)8ZqU%h4Y4U03`JN61gK@+ll>^5bFE^fbc|+FwSp2QL*zGYC4C4we~YeY8#qmV(oH zN#$q_oKCyoBZoT^QFL?NFU?C_Ft>0xr?_p+{HNzP!^tf!_Wgh6lEY-DE{~5+sgH9O zH>$iEsu~FVu{!bjLjUJXweUYb28)Lc{tVmvzV>J1QXA)~(PF1R*Fx8pXb+VB*_%7n zvG6(i9_}ti0<`B=6D@x@u+j>6wCu!*$1;o8BBeeM{Tg^+fZ-iLLsbq%D@0Ld&;LJ6RYX zTo8ZQyuDttxO3U|wmVm%o%nTI)?|jzJiaLVf~iPRThwp(=$TgMqO7e^hAba0vWO#> zj~tcmY|u7-C$DnUE@F1IL43NT1c#nI-F?}epRRLE4c2~A+sy{%G~EBG-*CqG-9?q# z_7R;+^J4k%hsp{pn>wS{n_lppo4Pd0_nN8Uxt_9^Cue$A*Ad<>=}(gPGiw`P8WjYY zEd?EtcWlU9Sx|hg9K8*$JUZ0vsKU8??$D^~*Z9>EFG)|5x$TY8R-F4vBQq5?-Tv_}BL33+|NT|Dn zwwXrRJTi!HQxQwijyJ!ynM~uCwK`SYr7u@6rn@##Yr^vb+lqvt61ShTYubtXdJC2f zmU(u5TECjSsRUfo&C1r09wJcOP@=`Pqug%gAF=#uEq8n4CgJSsnbvX&LJryI&TbXU z4?81e!{4|q|B0Vam%dNU4)}N1?A(}#cWr+ky~WhlZ*J zGCTTR4mMOPU9HMxc0$&9zAF09nLjhv{>=Ybm=2wD`P0=o@G?{BeG5Oco4m=}8*r43 zmJQ4vEIHk>uaRbT*5|+|x!VtqhYCeT^r<%0uF+i6yklPK4`X#EpS);ejDF#bYT@jC zjrX`jR!7D!nN@4iMY$3E#T)e9e7#VOvC~9#vC@lsTADu9_40jMq>FwO9ZT(IQ zvQCG`DJgv`$#_!g&$g9oM~>HQlB@Bb)mno4QWe|%!5wY!y!7Kt8QEdgV9C`>q0?p$5?WK**dV;y6wcaY9YtGdv&Grxs&HfJ=g?X! zhwM2ssh1=NF=Ko0{K(qG!muk`PxQ`T3RT^)abW*|^-x`;^30b!dl7P~_~iJGz(V%^ z-$xWvO|Cs?5aQXU_exMi;LF8^VQ-<1G|Plu_700o@yVvz(-|xKZ7um5hpzaKhx-T_ zD*dc??_DI*Y;Qfr>^002ag@2DrmD{@jW*L`xK6)Xob^kH%r;nqX6{r|pSb24SDu3% z9-2zK*zDQ#PKxdD|JA3F)?!@}x62cJXl?(*#pkMMBh5LDcymobvi}CZFy* z;J+fv+)fG$yv&CxbXFb=D-!l!3N7rilT;hH)F0I({5S-zlo1j$D1#gXn-5Qym zHtX&+ko9kA+of5~#Wpt>c!Ys7p*s)1ZCj}EpRb)d%!SRtqm4?Q*8WOH1&qmlN+Od+ z+L~)laan|FRDa#XZ+}zVhT()rv`oNj;+$lHB^!<&M!rpS^v?I;qkBdg$TlBYo^_}a z_Dk#oT-;tTSr}F*D6;*mA30S$jlUOM*_^2LBKO#Ug$Qy;{mP=uyf#U_a z@2)fUbIS|Ir#pzfdHAcZM87(Bi|WoOa^HsxxjQGytamm#`gUy?KXF%osB*hf-E%!9 zu}<=#JFWq-n+wJvR+@z(#o8fUB(GnpoarmUrE~>c5UHK3-*M5h`?Yj`fS5 znMUV#KfUUWHL-dnVOrstc@?L!4ys zX{!{R4Z5t+vT)T4fqAq(Z1(2@!USlA2V1gT zUuJyz@`vC^K-&d|L56E}x@HiS-*(f#e9z#Ea)hDu*hw90uWKR#?(wUhN*BaTWPVE@ z-BzMSx9dc;p4%7Se4h$A57tiKgORKF3Ly(uMRI*>r!HWG-7h7&i_aMx}n9# zwCnf|*&MN{_tk#$b4ZkKzv@o`&u-r^a<%aHRX2?csxUg0S2%t!Td2=S+UP4J{;EYw zQeD+P(Cy(~&M-6K$`d|gO&RXP8fmkvUjzz!R(f|T)C8RC=SaXw&qK_^e?t$OHLLQ> zj_qxbj`*JJ^d|4xQsF4Ee$ig!faaQkj>+zgd50WC)_If9EBfGrcM?br}FTm>p z_eAP~gJt+WmbBi^cJ0mtPY1Ev{vVa$fMQToJ1f7XLSbLPtmW4Q$WP9%8dfQ4G?{h$ zwBBZ}+X;ifRgLWz#T$=qIq^2?vZWYgt$0!> z?-g17+VFR^cetv49B2XtVPz3obnnIJF9F9}mo{r$QAhUKiPUVqk;9q!yE;~{IbAS0 zaSY{4x>pq^WxsAHQM$X7#i}1PazrA6X*pNwVxEKFoqYkjWCk^KRRw0H^G|MJXiTro zF55-8A?e=A8eL9=A?W zWW6`}ury!sPe8MnuP0^o4I{v4E#06IKwd?_m7O+MVzHCgXID_M(f3*Z9VN8h73h`A70yIrsi)ZYv&2C9)nGMSIe{Igj4Y-uly=5 z{%O&KFoc%Y{dGO5#|OrDtTyDfI^s7p;N-*W?J>|X)eTF4O?!YL^}(8})|s11lo->71qQ-)0R(fap-&2r=zkb{;?ne`%PDPx;5HqywirP4cUTRM)+OA~c zzQ=Ief3Nb)?q9cV0e&r9@u#B?Xoj>?C!GWzx15?j9B%fHPrJx+TfB+|SxS_6@naBt za0m;u!Qv0WNr_3R^b$D$u${h}OO);loV2#e{Nmw%s;~gt2Y(Ita6Ie zEBZKa032k=*GhNjs_kQ5wCc`)7^o%h&}*?GJv~$#3vS|v9bdE)@yi&3+sua$>L)rN z)DJ=^eIrgD{vUh@tS@Jp%#RIxak><$ak8Hy{%RQ<(AmTgr_3|wFW+NGbntr^%AOcD zT$ax3b{*Wd=|naH=)bRdsjZ1Z`Z-QmT59r_LW`(Z98j+N$DHA2nV%VuPvPwgH1#&0H?g4k<{+S6tUh=oEXxzD=&Az)V>B+^fP z0I`y85fElIkUjZ3+%2W@o4@@G)p=xwJ-Oc<05J`M<*^c5z5{UJmI^7C&`CcylLtY^w4(&m)y4DvaNqk-JQKX`@8TLJ6BH8RJY*P9_3Mc z_?P3J>Pwjwwd{FjIo(UsT3)o<0FKwf;d}buJAJh;^w$Vo841cn306af(jTVd21uhn=ujfzISEIXhu_o{P!BI;i~Gu9g(0&H z*N4Lz0c{dg<@fVwKyF5PGUG z{O@zKCJ(S);4OH*O5~6eKHDc#j(wBMRGtqguUE5&OV+Tkj^x}|7H+UF;Fj*U zqTP6JG^#O#Kfb_Sm7Ju*s(5tj>R04mNHTAgHsMf7yt|KuB!zdhsvRsVQ9_n=qyva7 zQ-5cAw|>SkbG{ymS#>Y4c?=kJNB4%;PiZq9>RLwEfw}9jD>1D zjzC2W*(MbthiwO!7~272^W)8D;I@Q)&2x_pPv@h`;`!TZXICaeZqc_&XAn3du1Cbt z+@QM(&NmbsqFLLbo#^lpWBgK1Ib_LCHVlecdphE;w}_OrfT_a-7*&yLwCFA|0Jni` zdMEpn(d`S|V7y|7q6!uH;cH(`%$UWzt6kBdC#%1T>oI;4#1%NjA`PrAxgf8i0&#q? z0McFVF+f?vXB8PE#4>~<{^MK<2aDPH_EsqV)K8TE#PTtjF??nyf({@BPif^PLD5Ynp*oP+nZ!@h$Nmh2VxE$$kjdvX*PzJ%YtUuODF?j$ zM4~Ub5J(A!j@O)-&%U(qiNN+JkFtD~?Bew%FD#5kw~POAeqEyDX&rmTA#!SY76TWX ztO0QZ?!3KQ5rfE&281fk+_0NzaN+s?2_}G8oQ6>>yN%SMJY7B0z46Q3yvE>kw~vc$ z$3^}9oW)J^Cyp~Y50>c$XC9gA`+OuHj@I`J$9(~r4M;cdU}v|-Cmd>y)w_S>hq-sY z?6t@f+VO)NJRjaN4{HF#qaq3-cV;&~v-PD=3N~A(zO9aWwrQp0OVa)nM<4avi?C_! zD|>hnLYWq=QuzVVUpG8^3yQ)}dDg2Izt+kof@~BwWL4|kcu|oNK^s6J{4G-f-%SGb zS_J(eEx3nE8|oc}v{2O^+`$5QrPpPwmEBq<4_YB?_x=nH}Rsn#{B?;+;`b4F~x0HeFWRS1!jh{fTzdmyd~ z$%C$ZRqL@WUOZ77S4uwck{1RdMKCL{0Nt}0+lY9P+Sv#0hyk=-eladVx6NwnPNwUD z;joX$vkuuOHBs7u`{u_&=-62j*zpO)mF}?!C)uyS*aQP6Mip2VzMt+EL|FDA zBdHZJ8VF>>Iraj$Af|SldazdP;F>3*YHrsjyp6cfIE`4(BOvIHEeP+rHtVQqKmPi; zgNWSXFV*v7_uaR*VuFbn3#RC~c-e_blw&aY*9IcN&5ea1^w%yx7%0O=qjR&~H+Nf& z-wqEr@6L=s>V`j}=;lL*@bIKaJ~eaU_}}?I@xO@*rWjdBkb5B4^R&%G73}+(QXv0(i1Efg(@Vo)&GO+8Vy%}-;4h@u7n_aP|iT>Oak;f z2Q?N!C^f1vQ-^naNrw2Z5h_uFLSvm`)?ZJMp3+d4a0@bI3=ht0D2uL^Q#6A*60wfI zs{-cwucQv9IE`FIv7ts!Ntm$57Szf(_ZSeB>lc*w1q@GScg#n`GH~%TzFNozW`@Hm zG_SzvQX1_`kK<6_)rE%=MC00n1HdarlPI1BztV`@jz^3MRW5s%bG2ZO04IBzjtod| zc2K&Uk{&7buX;fR#Z36p{gTMxMku0l)ich|sL#xA>#dOE^IOVM!fw)#yO5oJ8U7@G zqa)=+&XG?+VnskPo45%iQ165ylLoAT<2-7+?8LqRiAe2&YF4Eb?dr$4AiUqYMh$P; z@y*j_Q_N>(j-4jn?x`b^AA^`xUVm9ZiBjvLtpZO=#v|W>GKYR3@Qo|4FD@SV`g;bG z8{ozpeukU){$vE4(hGa}{slthLaEsU+F_Hh2heP*BW;QcZD?((h#4zI1Yug81z*y- zmEL-#bVoya?UZl8uLpGz9PxdXN9E{8vuLK^pUj;({T#I zEhZg;V*Na;5l#b2A-3Ga=RPh5@*%-KCIdz9~F3$1iWje zcO_dtF!)?xq5%BCAkkqqC72BY4;0j_osK!Eu;@S#9yLqQ80arnpgAn^AOh%3UiBIM0j zJqb6d4qK;TkK>@^QXhre&H$i|k#{&}4VU5fQ%dW2r~)D%zAf$+VQhmuphYQ^n@F(t z#1+X%YnN)h#xe363WJfJY*HhKQxYefha|wl9M-)^UN?CE^i*ci-Is_ZGfu48`TFv| z>w!D7yagESQuJH09iXnsV(})o^(+stJY*BA?^I!qN!rJQK0pbfy@DwKlqZj_VVweH z*G^(*ie<{F#~sSIRK$_pJFno*d&COyNpckM1~{DrOj8n<`-6z5#N8VEx!ds=PVR=#YwHH zq@RW1G?zdI#fXDE45mH-QKf%iE(}q5y8V~jXSuEwUJG+_Ew2?*e1$*u8YVOX5kH>F4+RQBgu&lhwA|K1@QObs6n5hZ5MLy zoVf~70Z*HONEp*~ZWTyDl41#kh)n}6SfKsrsYyRxUF0;G!*MH;J0;^y(0t?N^j5p)kSKuk|p> zOcWcLImxF`o>+s0L8kwy)7BT!m-c}O|k}%-g8(G9&!UMxvw%q+Hg%j zk3cQSnrh9WE2ty)m6_wy!Q|(9j+lWVi^r zANDMT@DU;j#DyLuEc`k0qogmcr9#G>Li4eN0U-`I5g8AIPD;8SfAn`i*0(SvYLIP>=L7hQiA3UNyIsTIzLkdjxRSB(DBm5TqRcA`36BeC<^mp~r z_&n&>t~&$9UlPF@)9!Ah&HtDEWK_}LQR&Su^OS5%Z6}o6=`f&Q#TspE-E4K z0%y{=0w)#;_vn0nhCFpE^^C!#yYZw>tO`TJ6cS;f4ve9JeuDM>A%Gs|*SGK70WmlS z7a7nAlze(;bicZ1AXQDqg)L;%LY*sVU33X(jifc8$RK>k-oF#~+z{PWEnYGf0bV_~ zSK0apzdNzN7Kki+-*rn+jUdrZ7{SPTka-GnW@UC=sB(JBZgLTVOYBRX7rvPAZY9ik; z2$kBQ9yifKgPoi{3uS@@4s(=#m9ksDZfb!-=96XORE5BPS;V7I)^Z zTb=Xu;-^&T3o~hhSP7Zb`jlcoZDMugxEN#3R}kfZ>tB=H z&E*Bm2UC45x=PeZ1f`z{o>Qu}A{U4}LguosaF$TAji$Ygk^LP=?8u0EcNJ7z04EqN zYs;7n;G7$~yClLUgKBpUJ+roH)O1bQF(8p2P0jj9aeymi5UL?95w#i_YPHX6F)!NM zH&7Rbi4nXV<}LoMU90m^a2$Z|D-P5srn%}fSmK`>%K`DmW8YgP_&Bidqg!x$cY}1B z4vTlsgr&)hDsdXCzTC`u{{qN6(ceI&Kd6(5@H+9^{*DM$ez)I29B0L`wS07mtqH(W zL!Rl)?HZXJG`Ly=Y!H0^SFt7fO$w1jm#%K}jcMwGxZhOj&h(9!co*bXT$wZ{4)P#+ z)`xnyPJ2+Xf}}s(LRgN-jT#VOi^5!1dc6*%TvTOjP>2i(gSjHe{BM;OsF(lA89%;KE#sNmFS2JU1kZ0CLVgwjr&2cV8avnUvXP$Mq6Xn?fJb6)^ZLcBRx z-7Q3v`<}!}DoM3h9$Hxr)RvY^{u4oIRc4tN$E}4{f_gIb2&SzlO=<<9T7!7k?q+-8 zMmZdW;O0d!UPQ3Zo2}wHY^4S?3?wKZoyjN@{4FTfSv|se2X(b@Ym_lg6%++xq6-Nj z8tbh7)%hHCbz81RkM}G7!eAjE9pn!|y{5!XBaO_q6;q(^`mUiW(U{`G*TkuPU^?~y z6?)Xyv_RxNZABHL<}Irf#~Cbru@VF|u-{N^ZwHb!9mFUdQqCQ#D>z#3j5gxOK4jHJM)pwNJ4K#b&Rq_i3IcecE%kfV5=ZFeKoaMK9WMe=VhI{{~;HT|6Z zEw~5GG5zgOlCqCxd0O``*B~0JNbzq&?Z+yzA1Z&*sl>O$ufEb2o!-8Q4Tcf`QAd{F z#9xocy^(Et9{$a3yO4$U&jmW6ltqI}fcpW`;h;ZKf`#eSC?w1OEQ2b|dq@sJo+o`!`icuShlp;^&ATE8W z)=1Feu(1ZIp&t#rp>Y!2K!g#or79{+kt7?VByDxCiCnylkO9Z{$FQfMC!CusYq zQ(LTh7ZLrrpKA5@sZVCH7WQcVL&o*{d1NQMhdpuc4y@LIFdP0yBp;(?u|x?1g)p^| z7pzyHEeV~ZFHj@{{4~R)O&!eR;HQkKY9^#Z6bPFOpmJmDN>s!(%a#gN$QJd=&Z8b^ zJO{`vzUeO?04))pFhUGhrFRVp(!(TT2-F(cXnO-XurMREnG&0zl!A`Go;3#MUZ@rV z;{QS-HV$!XfSIV)C!K0Q$~*>6mp#I@J{>vX=ig#?QDb%SJvv*Z7TimQ2UL=oUyf>P z%;1x5gOt&dTf{ewUYQ=Zr(uJJIASj%&Py`}#r9#C4NF4qiVicQ%-~>K40zwkgPY$~ z(9{H=j>S7Tx|Bu(Yz6grHA6Q9^#KQYl4Sy`0(W}&4=v}i!&(4Q_GgB!^X|DZw|olc zKsaq=Dhg2>mJ~%cHgd{)=*HZe85k@YB?f%dH@xGcbIhDRh3b{xGz?$}#d9zo020nG zjd)VvU)-a}(3Cv^9s^10x+SfS1|bME9%Lj@i+d9_Or1Na8nBtA-ryhy!CXfgX>>{u zq+z<ly_y>fQ7dT}+SdBR zFS6D_pRfDnMn~L^K;k}{<$>JB>fI9yGJO}&;vP$v;qfsk$hkK-LI95e#8WrE!O}eJ z4hNOPplK8og`W71%b7o~J%Gw(*Qa{ak;U^qnC0A?AcInmwHMrLjl96UmRc*KAkuhm z$NoAK>SH?b4GQ{{KSm|{cvn$5I`6lw?UGwuTVm(1=LbU(3CB%Enw6aXp-~m&qVsn z(#AKzWX}BS5~ch_+iuSLqg6@6GyPBJzxd8TtFf`W(^rQU#tKXkqRwWMa}_YsEvW~5 zxUh3zr*;q)LY~ru*q$k$y?#Z5DN1$1AWvk#`U@|Vx(!QA{XEdIp}m>7*=oi79Zb*0G=k7$7>(iEtk6;lx@FLAbpAX+-Hkyww6beGvkWfFZ_RXJ9f1?e3(!; z_GbOtSG_+I&m^@Tk$j$PUceJOH2m49;Ow`MP@TtSay+#TO(W(*fzXIZ?K-al^@K=q zeW#cH_-lu>lXav^uh%Y)c|?qA`1J9p^_qL%;L|572+vxj$<5Eox9dY@fd*+Lcr&6v z?y&mG+*b|C_7$p=0llF8_xivASl#|zL!h7MXv4b)A930^`)yNbYq0)!xc%$Jnl|z; zbZio}9!%LD{S->_alYqZn|2a9aK$c*yCj1@oDbDm$%W$F65!-_zed^z)-yYMtCFF6 z>zNEiF7%XjqzpSq5I$|~Q(EC3{x!Co17NXmv{29$*~pRorIB6?d)gjO**ZX}J2zNw zg>VT5KYK#d&cb8PebpII+W+oT94xBjO2}NiJaf@#r1JfQ5ngt+}<9gnjg-#rw8u~fP??JzUj|QePnz3 zTf(x@uRz%CMxx9Dp{Y1(P{ejq`l~*G-&cJyy2ipjD(@nN*O>a#(s%!e0`%V$th*V= z#8;6cepSou3pnqa8;S&KRr+MCLV@$O1q`_XH=>fCew(kRfskKub$_EW2CUwC%_}U5 zN4rxU_l=-S%)i#@iA)q?W9Mr)uL;B9y>_dKa#Iq2k`85&dd7261%avb-4$2$&5YA% z$qIpQ(OtWG3Z2{?Q_9+~?_nRQzMp0Rl55hWwu8@*`@mOEdss`sI{NZ^Be&*8DQlL! zVMMHXY0fedc&0alhkt~S)_K(%6l41vek__iqHHF9;k2c6BQLx#YN%8Ttx`_$fDLg4 zKJmH`aZPDGwd@mH7<`hK5`t?JCmK_Vo4MJ^hxxPT(zx>JIGFqYd-*PKQx}XlaNJ1hy#j;Jd-l zXt`zZZ_FCG>7J*2anSP3tSUBRCRR4eb*6)lSx!+);Cre#gx{Z~DOSF^@EPPGaW*NG z>H^(VcTAwcQjOOz>oY$01KrrNUXi808U?JqL%#FMn|R}l_6ld;%mfq;t(OLh3QEue ziY3#Q5SxDMsoU*EGrNJcNE`1*7!wWvX212PJ!kca2uR|0mJ8Vzu>IT4tU;&|BbZik zRpcHcJm2IsJfn)5?GX8VeuNVTeE@mt!4Pi+UdY|3_?b`5_K%oC62V>3jS76&()+mgXLEM2Q%X;1&bcai2)`pqWu^gGi;YIs| zaK|W(IDeTRa3=oG1?&i?K3~3XPBUnNt*W2nV!PKtI&Yglr+jVh_-~uC{qySactLuS z0*_s!^LFX)C#P%;@;Rq$g?r6kTeWU+nW=3H5vclht+PAQD(&+9RJ}S9Q0UhYc%)^; z)f>V(btHv` zqh*;iS(BjBfix2mwrchV*;T`}$%}V!(NYh4BM~kpLV8bj@V?=)WN-o9s4;Ap7`k8* zcmU4EP^cgpD#||V%Xidy7N&?J5R%*F-~WH z`s>I~${e6)F&p`-CR|TV%+(*JHuYKNyS@B6okSrI{Xii99%2sx2J%X4I-CY?$%~sc z1ZT<|kdXw&GxNb1>rJ!`9rY`0@4a~vg>*E?r~Q` zPFtzgbBRNyu^(O_psc2tL2>V4n^=o^!isR(7#>KUQ7g|UpxO7=*y}JMwTZH*Drz>vxVXHC$s&&^)P$Jqxova1;}|lOJqHyupwgHk$kke;`q32*pA! z{5oO0l@g>lCaGb>_mzo8aP}0s=`#Ex45$9*c!z@d{2=2-3WXLIm&-w)Wpz75JDLtM zQ}~9P3oEXUolU@79jCb5IyVXxvVvbX*TMaN*a&lj1Tq4wtSyK99VH71^FM(u5|=lKe>4F%LWk<33*5r!tngn{Ur2?=l&l!XAc~>!tPZV|!MV^F84y zR9Hjv?euqCBS5w#JxvIea#M~=9z;E40<$Jr#AssvUf7>avaeuG;kM6@62J!^82qgK zwi-op6K?csG5P_ewfADDsUc`JcDuU0k({96(?UCiOGC=h7H-v}qjb*bYg z^ChmV!2%xmfm&Q>&yp=h@TPUv#L%V=cN9aPfefHEE&!N$UGK)-y#;8A%yT{HJ^|B6 zYE+_cMk7bO8&Y19&Iw_=WmgnP)qgXvUO!K9dKuj%uOWM6kVe`M)-NoIar86?fKm{N zQaD=#wka-S1~X*7KCRoqs8YdO3dE{{)iP^qD6ms?I+{mJ2=P?uJ^XvnYsQyv@rueA z{hPq>J@)y|Sm&Z9fj3H%h%QlGypM1(!Ei=$>%E45*t|opD!)hN@_`+QPQq^W!4Zbq z)iv^PS>*k+{`cAV)NZ$GXUybH$z{i zQxqK;xgB^@cjup3Q(!f$HN{!b!L9zB+EUe|$5mJRz}phvY|uKjp{_n#YiswCGjw*L z9-v($!SOsnZhQc$zA{;n_wUv>yH`v^0+X9mCMLy##&6T*%llE(dLBMdB*HQAuz3 z&M)8s18BnDLS8XSrG43hnBEd#cXq*WBcuyNk%S<*qEG;0FIRR8B8mdjVFfr8HuuR) zBA-Ptz0{Um>{)Og<>>wddVaRxa3ib$f{Bth395&JGj9+q9c!l?1WB+REbwGs(H#AO z`oZyKw&hDG>BtwX;_}KprjL?00&BF>i0m()91Q`GnzS5Ve$!j>dBX)nXOa8)8#$;& zTrrz!;NZ9&lyMC-u3wq{spDuDQLTz;jwvr>P57njjRmxo$!*(5k#<)Moq_LH)@QTs zrrJLNYzK~ID?<=`fk?pMd`#m9YYaLIP{^y%Q!3L2XPU405WqzA2_PEVfoOF1VOE1V zyG%oOAuxM_d4xcMT9%6uvccJv*PT+Tl3qg9zQqgX^eF`tUja@tzx)=V)XRcooJZJi2Ow^-2XO$fu&YUz zVphNTjS_(uD3_xvEZLl{Ga0xPfH=Ykq6kQee=kQNNUv!ik^J45*V?GK(luKupjN=6 zu$m>=fw58-+bO3Hjte&&27@{}okph(J~hRR*-l?@({&CG+P_MRrRC1~$5L4yV_N$+ z8SntGuXqXR=RECp8350P`%|_9vNcZRZT8^@C@@XAON#~IKlp?_6sQ&JTt4pZ=NZtZ z$-6ms*UsgJDpFeJGwUD%4>gc?|3wPO9AU-c&0J6@;!7+UvH2;)pUG#L(c@&u?B^H5mQ;GrYNqT@fupfx( z*K|m7P;txBMI?k`$)&+1X8!$7`-s}wkci~_V-*%e;sta zyFnO!d(wWD0s(F0arg{t<{5 z%gZ87-P`y1eGhlLz>W9iZTnBp3*5c%+kTVXXqb?=m;gvnZ@akw^5Y`ow`!Cay2wya z3r-U!7se+q|DJKMK?+8PEEKr^_O5dFd0%a8*PmMKE7A`)`Xv3&v96MsQqO29Q40X~8!;?2*nPPsb6V4#`m0B#Y{bxCWXZPFRd{!%7+(@=gg@JHIWy$ygG`wM3nK!8pTo)^g#(mcp-_j$q>J zXU3kRoQ_w`i%R}<>M5?&@ZXDJ2urm!x6D9tUJ8RyuFj-QJgA5 zTdRF6Yt)L<**fT~7U0~l6rOt*l4{+DDmqNWcf@LK7j(nvI5l**w7_x!zt zimCmL5?j11PNkvOz@$2Xwa|FC8e#8{w@$wLAV#(EVHa~k54OR?(l_%4w-J@WFcj4#fVlI=x56#75rNL#YmWF=)X4Ym~*} z9bz6vQyf$UKLf%HZJT$`An+-dolV^*^wDhYRmGX#>^3GM0N7HS`Y&*29pUp+oROpC z%r9@1$nF|o1^VkhX3u4#?h5`tzTP~p#`OOmw@r3t7)v2bDtkmiB?eiJij)SO5?SU@ zq2;6yvWrwhQ>iQ^6=fpnwArgkN_C_iMVm^LDAn)zy6*eL`}2J~et$YT_qp!tdR?#O z`Ft&FY6;U|>sl%ID&k4IlfvDVF@QD5O+0|k68NhR=0?`hx+Qt8+mqD%@9HKwz*5*~ zm7hu}j5h0gqvKddq{#2B`JJmiQ$$f+D)K@zUbz5}xg%(VHVSo3a$k7K>qBgDW*4de zxj!{&#XRSe?b@dvpix9?l?32(NZP)K1uq0v!}=82Jk47`+^z6NO3tk<{Q%N97E~Y5 z6?$mi?K@+5O@mczQPFRSiJut7e zfBY3l=9?loM)NIeAqU6>w;zawlk4=e7{E3f{;9>pI`Mmw9OCMb_5aT|QpWY{7wklM z4IYx;goaCvi_F4l-_0Sx65WqJuB}nY?e9w4+w+o1!!(Pgn@6U2L!5i*T^W6>h}QQs zy$#1lR-$s_^IGTi0C7jZHFDL?pXz!-Y4}OUtu|tH>Ba;zk5IQ-f_euniOl~6eg)LB z5t0`!5IB(E)RBs>{)^II-)cN9VHSX%&uH?a*_}rOYBr8nmkYZ)99NX+?qJ$EDw8Sy zz99`ng!Uo0E{BJ#x#{Lvndz2T@F^XJlR5Ye;ztAY#sQAi>bUc{&0ZBsGAHNE=yM2l zz7k5h$$ntlI#2-;EYOnO=1p`Is$WFY0m~OoALYJy_Qojo!z=`u7BfKais{e~(xJGy z$R2YqH!Bs-JzIyf=;{*lgx$fPw9LEr$T}u5VLL+1wbcwsO5VM}0x0Wm8_h)g^DqAK zxvk_EKz~Se6$MAy#eNs!2u{DyY22m{9@wX*Vb;z#%5GVhhJ{Xg2%7=OlX1?<7^!nT4NmEq!k@??W;?o6E`1i{p!jj>WMo!~TYD z?XMeDw^OI&>%ffWcLk}VTiP6U)*Z+#n@SPI$9g5_<&i0C#K&#E{F-PrHy}T8+d$l4 z0I8}sB&ur)LO={W9WEYc3b;j-@^#Wg1PpQuqXu2o^Mn-y^k=#p2>k{B56-OP!^8#J zmWf~oE+!P_9gjwSN0&kUo1I{Wu{Y)%aF!w=R-+2xkx^;a-kHk)thp?d+XS5gt#X#DIR4>vG%;ckgP4Qy2b&jP|4{>j73?^9PT)F9`TeZ{Hd1XB~$y<3&Ex$-_kv_&W**~ zq*`QwC38)0_XYsRUk@UT@mjBlRPKahaY`HnR^^P4JRTwWCer0@T5Vx9HFhCgh&Tz2 zxc~07JH;^whlj}v)xI&13)SWZUaGX5XuM=`XwSpV2xXNf&!Jf2r73RnYx@KYtB0Yl!8y1iHFRpLw5`5^sd)ozt&W%k@5)-{e zwfKz4j)QgM7-?5rD6oF>Ek*l?1Pz^kB;dz`v>6Q zQP1<7Y8uU3UpAB;2jyg9lr1oRZQxxj7I-%T+~Pm7fy$$d8VIxtd(*-&Nh z#Mz`41EO~O2m72e@E&{N%Z0{4F`q+1Yldv*JUQTZRJe7cQ>QZm7^?He{k$$LqC_-Y zql~8SR`gQ0s(TNjFW6 zsDuCP0m!#OcLKo6O6a2@n+cX2q!D!~Z6or(8*-oyRBwd8pNO!tpqQ(@XBkbf z61^%3Hct*$>o+yG5isWh!Z0oj`>I=st0vzS|wf{Sp7dF6wbVvz7CO zOv#7IFZn@ndonz4OE~%-_ye!x&{x^2G~L>wmmsX1KFBgF`z7w{grjMZFIYM~51+pu zVkJxBxj!{vLAd-9VoamwGoS~=L)=gZ>Qut)YM8MsSuuj75ev&iC`7VrcaXT4_T zsXeG5VrI3W99NPJF2M!A9Bloj&SV$pqU2;1ffa|FYCA3p3o3H56L37azw4-Gu#as4@0Q<;*1F^ z;6i_EBy`^p?8Gu#b7sU#`^i)otfE*J++B;GrQ3_TrtphK0$f4}8FO+Mnd`utU^K~? zO>O~me~I}P1uRrk=i2)5DOeCSdJ6B@Qt-4B*8cRFxHTiQ{;GRAFqO}=!n&_ zYF=5`kf)hSiB}ctM;GRl3N@4`r8%~2>6la5wn%r2$E%jr9P#hCZWu|7i3gWS*sX5Yb=-bp5@IE{^g7O<+D^dOn$oyJ#b+)UXo~0#NVO zT9iEm9EYXwtQ!EA2;>CO=h%2kLAv|ZruR>Ofa0-$kI(8Y?#f=x%RCwZiQUgxNnU8( zz|jU_JGFq3Hx6nlxHQaHmfJ)`g6uoI8;rOk=11HCraCSTm1M9Nzi@KebI)?tj^bu} z`cNKmL5fm!3~V<~7L(8+>l8nm>;0&G3We1*4TvoER7REdGrjRNsNgRrz#ydg!E8)H zxgL431i4vwI$bM~FaD+1;R`!MPj9NXm1B$*gM@Q;xLxp*A>|=(e{m6TuG~dnJa6Lc z*Htp&fUN@qRT&Cx;%QGB5uZ5ukeF}b3ys9scEY&klZ%OE|u ze&>CTU^Qf^QL8J??m-jifO(Pob%lAEMv&H+P94QfwCwU!O4i57r4}cgSj?-&g$WVGd zxFhRa`#AbQvKTl!qSwbq(%?X)D=4S;rRWO5Q{>5j#-1l z(RqP417_f3XX;N;`wj_GmjTEkONKVo*+2fkh8`Qo@AT2_u3G<+gc_C2=*&xwYr#z&JG zs*A)Ur24!N)IHDplj9KTmLSznssLTOU2>&f+oS zVzqn$RI4o7^oU)oD2@$gz65`>ie&ks7Yz}El&ViRV+!FhqfvK^MgK<5!*OkjEMedYSF;mmnb$~JGxkH1NTMX z8G})rRBLaudpY?Oz{rz8$Wf~gj_-v~;>$?(mDML)*XWgyD#L3iE+Dz({)9P%-4%@X z1){L2&VFFbuf8rb4+5xQH?ys2@V5UUP#51^xV^5WcRAH75Ty#3-?!hY*N*(^i{bEd zBHoWrCg<|5(7^*Q$QL1O_yBR^P#!L2qtU*MTu?N};FIcs9c!k(^S_K9KZ&!J&PkqU_|dUlb_^d_YswwWC9X zx-*LEDGF>quw%J|(pajm-sv0C1^Wun1po%DYfMY0R%PL>k^as3E8x9%CS@VKHD0sh z*Ivw?`zVn9ds#em^^RYocOaG|Pel-Rm%+qI+yM$gy1=a6oDZ|crwF}gdiZ5X0iv-F zRR!i}fNfzbSYp)6F|)+AVh!YU9`Sr!I8M~`f?`*QEFx#7HJhC9hCgGP2~(rl&pjth z^K7Tlp3T0+fj&P39s5`P`J#PGS6zm3?)cSdCgI@h_gOK>0OSp89U9M2S3v4-uI`(; zDm=hkyT17Gcr?2J%C%4EAxnZ7O}@P>&1aB?%H_D4|B(;T%0C<_Wef!s>^h?##Bmu8 z$!y>D6E_@2`k@#>}yQ- zy#u})FoEhh(aLVN#}K`vw;D^f(omR)4%G!=@7n|Tf)pb->+JE?VMtS<6u;sta4X^H z&FIatUQkw|8qaPUcblmdvOD()-tG{eb}(rdkqz5}H-JMzSrnbjGL7N&fi(?xC%aqS zRkZzn{C(>nTh}SJ#hK396+5z=z9)BwDeL)Z;XvPx+9d%iw}1J{+Q&n9DAg1iR96R; z#&kibfIxe@>g>Nh*d)#id=@gh(pb&MLU{|4gRGLZEEbJ2RH=RFxg|2CaKL}dW{UUE zR6$azosUXNvg`6%uo2J47yEluDmRD1Yd>xWC_hfo7I-@KeR&QKj<<5oC+GRzKmB2g zEY2WJyOSyMpMr|js)L;+j;u(5Of!05yvwBC)EhJ(J>tXBZ%3Md2kGmSeECJ`MS5EhsuyK2CM)1V8u>2X z^I^F!fSeV7!~xKSPM(mzH})P>D+2n7cSsdOH~X=CmguqW;|FEt`UV&3chR88_VPAGhQjn`1NKEk!yat?(4J(m9Z`A`-==f&t6N_3d)?mdRaH!LI z5Gn8zfB`eaEgWnDP&~`=|L;PHm6k2^{Ko%z8(kJKRCFZVNCFS>zUtw?-2+)3_NH!J zGLmnw05P&QA4d47Y}P4p#PZ>Q@)=4iVg_fvRhLJC;5^?f7am(;$3jlj8d~h55V>80 z^UqMF9M&Jm<>4`SXr8ydpf;;8r>Rwe_u_3~9FSUpoImPg$)pENDb=&#E$@XG{yaKP34T91A3rG=`b*zMv zGP}q>KwobZ&LQat3*GdPZS<=LoPIS>u>#h@C7LrYwR7huNsy zWkq}kv|=75?F;mo4zU~?&*vF>7c=k!UHMb0V}C_~T($cq*Q5{ECVeLI0{t?`um@6< zNe~SE;GclNs3$e*!HBNp3m9Kbb3_sYx8E12DvHnN18zmH0YbkM{r-8?kl_p6n6M0V z(DrTB?itXBOP_R5zl>~M%64IH4P(!7k*b~4zmfgnykXpz6eN|74NzHxPFiwCA7EoY zbzwF(VD*?In{@&eyo`?C;W5wc z$Mc}`Cra&gqNy(tXT0GRt)G`2O}z3YpId~{J8LUj5r;dF^7vh+3GehRLk(PLcxg5|7+oX;o>IJ+D%CJQ z6yi9~#5q%#1rXfm;4`2o$d{z~E2mvJe-^Vzs>p9Xct&W>!u&%ooc!?tKXM zO*fD&$Eda?zpX-@%Ezce#qf;r54R1hlIjgp=d}9S%a50+xV_M+1K_?OjH?Z%s(t2r zvp635a~w(hoVH9CKEOmiQ`hc)!9AQ?T!s=$;<0NQa+igeiFmhgiU!qKiCJ;2Afs87 zf<$*D22$nmNrkBUoQyGfqP5z4zsa%)g8GDz84i1jvfO%B82q6C4N`Foqu-8eSb4_y zKPcxf(eX{hga~vWFL~>W*L18(&E_r(tPQghqJ%#L8Ps#w`_O?CT0>mS=V!8CJtvd_ zrrJY!z!uhHpvHFJLVXr2pj4B4CnD6vRmbmvgv76g=&7Cq`is5~R+nm&**?yTM?Mns zkyQhyQTujt2koYfSRLR%{76QvED|NUDhCOgHTt*!5UooHh5yHW7Z^mnz6~K z1!onqTk{y<;$u{6Jk*Y&qdlnTg=@$0b|5Skocae@NpKNaMWx!@AvR_~HcWT%pAlCI zp;A{FBmDxjxr-8CSw*|bdz(~fBs(F;o15H!LeUf6md10z2W*+EwuVvFd%O`|jmnsI zqYR*}fxQYVio0`!G7~%Bh5Iq+aYG^@AV{(Y8EEcNo3R@9$LS~t{7BTHuymonr+cAr zo3@Rm#1UOuegNnbUnK)@g|@LJf@LSvcDu7UHkc_YQ9?I684Jab$s+Vu3|b$O?CRfz zxpYne5_qu6e@{sWK4BAo`kRh02R6=ts-}! z4$(;rmEL0{OaW4dU}*2EO_w*g|8KK@*B>$?+dy)roo**%=WF{SNuG7&K&B-!wGREB z{2iNE%Br2lN`GRF^Lf@72|~3*6hC)x{N4;QaAmEVdiMAFOGpPg){^$@U7t$h`NJuX zXO`m|=d`4~kzEoYdqTfwR8v-t-V39?lCuRvZmwM2YBZ`9euXL3B_oSU|Cs%Ut4V4h z!ga(+4NEFFbvB zgXvzQqu(mCfx)f{;*L-tu^rWDiP1 zFHVc|)3Lmnq=r0q>S1!C&=*MaR^ikmp2k7L6@=eF&?+Lw@h#?4$h@}2l3236h{d+RT0Ac1^H*Q=~)5$|UeW^nYI6{AP<2DC*ms%N) z@mDz^19yKp64R1o6$#JA*(=ShA09mP-a496B~?A9;wGWiiVZd`=!6S3y+ys!y!J$) z)3z?f2&E9%wDi2T$W@=lWHIKL%|8JErH0-$19CtDJOXgezG&}2JqZka%rd^DL?o%@ z!?p<|)j$Q{J7gr$beZbG-3^Zot||YlCpXUkn}36*@Kg_8RP`TLR~4@$b6TZC2&3hbr*CtX&S!`~+%qwvvVfKxU|DB%q(FL1sll)6dnwA2(W3C}?7;XgQzw49jgt{0_`({nFt}Q*Yn!wgqbge>ui1P27CRH0z$EJi z)^AO6lu44s%L(hUPiyB|<)gzin|Ve%$F=WJBK6ANR)h7T57%AeH)ij)SF~5=qRw-{@3U^Z@l_tN zC~$wh%!9R<)+;&|u`po;o8$^{pZ6lC9-Xby`bbu=zT0f~K4uk;yTpbpZQz@TPh;JW zkfz2YSk?-f35x_x`lxNNPGh`6<($q9Kr5|~Yuq&uEq_a*f=}3ccvU+q31YKj^3I?` zt3%jjRX3W=N{|D8G_v;H;crgU?Es`xxQI>kLC_$uHD5%LZ4m29NcWb>c(qY?JCgcG zNC1Aznm$45{bhGd)**Oyl{xkEc9I&W{@l+SZR_u6$XAl=7{u6AlJ zH3q3V9P!OLq3PhUi?el$QItGTxjwz;-O`+;%~us|{c~yHKufVdAX>CIYN-hd0btYM z+7qw1boo7^S}{yOmwD_ z7|x$ht&uqWHHx9>7*oKhFV>v;JP28uKENrK%l!u>TKP+{7B7)ENE{2+kj{9+2uwl5 ze7?jZZ%w9#v3X|rUg3?%m%%=(5~^q5Udxskvs`VgFrmq9)fg zQeZ$(Ka{4uV?C=^G1cv6wR7Q+cRtp&>wRo{88oXe}&)d|IaPi zDbwXg+xYUB|9ga&Trd!0a%K4ajHxlAHG_pEI1$z;^y&*`=uPvOu--Ypux{(WHD_9E zS#DY-8J23w^~LAxMa!?-P+#^*FL(=rC6qRgL zg)P5|C6_xxjxzk#P!r z78906xK?~R9_i>Hb>d?HVTzV(|>|qM^M1&{&0Q$d%3C9fcmZD1%2JZFz%~lpxhbqz}WD{j`SeWt)yJ zefZN(1q_*15EjFLlJWSVMT}cVe7nt561^#&b|!M4sShxFw8fvCjIxdEy(Ws zHAQw5Ues6naqSchcBaJpdSQ%jm7*FX?>=wCV`2`)xrn}e+FN&c0J>&i9)XdyC_1gn zInTViVWiZ{nzz)gXJ-55F+EemF=&Z+N}R*a`YH`K64JDTWY8(iNxC=;XYv{g=O=7O((qZ69Oe&>renU65-Cluw$vHF=uoLP zFq)dmGp7mjS12RNF~r6Ab3n=5?v>&Dvg&9~tA_MNT>NC2JJ$G~-C5s$bfCSTV5F){ zzPYZ)A2?%;!pi6lBi z6~$Mm(f^oH&xI$%bn4_mUyVr0CY=pC6GgLUywHjiqY8eH%8pS>?Wr@~Y1Lqw7{Go? z7_vjC73`D1no(oMj5zG~`$4x9|Ms-9x3r6$Y*8jfwkq6-dIxl)wtthl2j4qUxc8iA z1f~z5)1A<1V{9;4F{^`00t*jQp+j`Qd^YC*3g!i<synUtIXUCdR+;*)~vz# zas|WC!1)sfA4jqbpi2XHw;zE+F`g!GuV}s=Z>QtmMd(0g#U5@be)Iak^bB%U*bT&a z)KOFHIr0R0jdfD1kB6@<`M63#GdViFV=*_7KbD&2~+!Keeqm-9VE3nZ?>?seC{Bb1{(6Z-{SwUVylgq^RCM-NHGU^mM(roTf|8q?XQH9>ow6AhYSQ;U7 zl?V(9BOoUH1R2h5z{`0rk{<23^ADzGm{F6OsE(A05=Cptx$347)3j$v{(x`KyDP9G zeFuh2Mr&pAH8%nGXPu_WK443kTHDDv3Jw6{c2NwXYwjRTyHJ2Q<=x%X6NP_@eyxY4 zkyIb4;w?=uf+uK0666WLyrLMyF&jV6q9@76EboN|W0t4bAyz{p{-36@;p^y8ja^ag z9>?iWGEe-s?z3SRovtl-28`rzv;PMvRj7G_IXs40G8Y$k@%9|A&a!+gWY*BN9oLO^ z960`8v*y!4IjisO8f3174nLc#sbQZM@@IWOQvG>Uu_DB{Hq*b@EgiVb3ou*) z0X&WS+{x4{nTj7T#Elgocm5^$47;AgW1;Ihd6`OoaxZL8vrXNCuvHdWS66xKq~fiD z)_$r;%R1ueUYa~#Tx;!#U!VcOe4t#-O=|GsS^}RkRsNHU7rOSy6ha7D>vp*I)m4M3 zYK-i@^*__^>)TW}gohfEU|s_#fN`d~G@$cz_CK^|&A*jwws9c={TPjW#LjBNnM+cP za&GxPve*VyWyigm-%a?`-1wpmC})z~ld@!w64V7ZRS_ZzUZzB~S3Q-lAmAejRg-u6=S$3d8M>ZqOwM?tHheOz-QvS%sNMTDJ5BJ%62dC zeVMx0!PdlkA^BnXn5Oge!@rp05_WCj$1z&M;*JFB$V-NF^h|Oz`d{HgaB|`Nx@-~j ze?3-19%6mmPG&lG%Hmtj&!Z!WaEVx9$~$`ho;=RX$A|@blVr}?lYc0_?Tnr0gqBoU&0~d7D4hDomn??3UXSiC=YgiQeBfT&I?&^e1MmwiJ#cv*K5Ay<53A+#|78vPH) zMR1l_;H`S(!MgzT>)zRAVAu;2&Ko`x=~i!z=F4*q^+;V762WW4rho^m4fTloi*T;A z)CK&Q`Pm2EjY;^)7p-$+YDc87SfEcQEklmz4H3%_aIyy)2BYW0|N8Yzq=ZLOA{`ej zI;`5A=139(Yn=xywVo9Xt1Do#KUD%665^3EZLBL8Ev=8@lgD+?9WH?pPBJtD#Z|1)KnU?GtJP|3g?bMgY*luX4H81TWyfjAB?6oEzizqef=E3-;tX8Vqf9Rx#@irrdf2?T4kM_b zKSqdU%O_z$9!S4((S?!(Hs8R03))8-3?r|`r0X1Wh>zKj#-nbCk|XIyh%gpw?27Na=>u3 zuq~*g)U~b5wWFcgqN62#AXK3lBTG~|-k$D)vKm`=Z5=QK<>&6S5yAt1Hy zo@Hubic4>8FrwNo`v-C`2u)LPN!iHb-C9@s&aSL!2;a8)pK1B8uf>OO0D_(B4fgPz ztG+RSVp8E<)f+S>p{2%7yv7t0Zzh;G4F@0^?DJuP^2Ep2CF=Ik~!>FCM&e;hBtg|(Lg%&g%9YE_aB zi!dCXzAN8e!|_^ zHJPHp!vqq}3);OH!p|J46?qg<%X;U-s=YOlaO;9us~f_rG5cbN>gsiW>mcUXV>9a8 zUUdL#xJv~6Guikc#TyLYJt9+h@PhHTOH9?i9xENOxPHe$U^8?u-1vka{vM-UKAuw$ zCPrb7H#NV1<;)Eyk@;}po1QU30vuySMLF~J7`4J*{7y%Y4VREPda%>n#1|RF&UvGb zhdnPwJWRGTZMOe9#?8qjr<^A-CKPYBMZAwwVnZwV8NxtYD8kIV@*#lukrqZFbiM@< zCZyft!??GS{X62+4A~$8yY!Mwn&NfY>3k#uWe#dR-T=3 ziX&`CrZ#t2(#rJ|RX(Vi`(W8~wSA>8tR={t;RH#pyAt~m zYVN6U+7BG_yv@X0vKP%!%MPc%_^}3|-`ThZ@;{`KCFCXHsM~K(+g0yaNRi z)TKL4>kGf>@y-e0S8zLIZaDjZ<}@U%`*zkQM>@tFC<9S#9!d(llT+NtA9+weikj7A zpc=CGF57z~vhkL#od-^X(cmKd&-{nom>~zX%Pq!t{OA4Zvywq!`1RxD6B0xG8!>VX zY)&QE;S>z5k;mX}0Ah#y|7YJlrk%HLEgZ)`EC=DrH9Sj!0bRlKrW}I7BUj$|Zf#8i z96yIY58D%Z)agr%8lxobWj6UK3*q}$un`w%Qx+uIS7Gz{Zm$Q+R9vayM~@NUnzg~e zXky+WgS62q`{Ox3OzQ>_1}S{i?quh%a)skV+qR}5OVMk^E##Oa^k&NBZz1Nj*Hc=X zd%Cs099Zu86iv4V-g_i=de8 zRc{QLJuiA+jdF2~O>cZO^qz0w^dYk+?Q*G!s_KLOLF}WY%a5Lk^hs#)s*{?og3EWv zU(535trzd>Zu;0q#VhCXIDnPgc{!oq?@4mi@XLSM_4sz55u?^6HK|KXEf$XA2-79A z|NJW}B&~^C0MT|AUI^Zc(t6lle26Yd*QnU5?nul-y)A{dz}OtnGl&9Wd~{&GJ^r!N zBWJt2=5uk8ZlJ~0=Xqu4wdqsxR&<=xTAN+l*CC83zZ@~DrN-*lq^DYly3(XYy>}e# zFNEJ;SQZlb@~TgQtA$?P$kxBL?PGY9jz}=@a#wwFgO*0Bpc@k1g-FGyhsPovE6K-{ zk%jK&My`r+epzVv!uimX6Uz<##~(bNYZPB{GbqBr``+kl@F~O(*IO6Elwstp9V})|jAADb|nRKxBfD?8OyzG)thB$EkUfR(+^78NH;%7zAOh z@s=SAU1EenEaZWchCF+Pxb^A}dY4zVHO>^f&|3h5P2V_vNT8XuscFrFWz(@`llL;} z`Qo%G`<9v}`@AVS>I6~AhFoC0At2`U1NA<&w?*{MbPU6u^cm<9Gqe7ymL$CFg|ewu zQ(^1w)_4*@EYUklr-TgFiHe$rNjvGOb1iyu%8ZW2p6$wbIvR3jBI!Twub{PByZJs?R-Nf4@WyMb zI<@dkb{dQ(>Y)T}|@`r(y)(2TWyE?_GQ~+gj+iIG~>W=72V-3Oh@A$R?J-NqOTc z+GbjBouu9Ab5uXQPcPFEzgZ2`JKP{rf0ejiPATl;EmMC*T-4#cpF%k+59D{gp1%#= z4_^2S6p5>z1o>>*IKIBr$G*0&6@3%^VP{;MANkVFb0fX!CkD=PZ`u=70((=EDeeuj zl}+s$-!oZnYg#xPs8BrsK{ngRYP#2o?gnE*2S2FM5}O>4n)7Saq^IQ6K?(|Ih0)J8 zRpgjwNXs&woLR>NI01Gy8xhPd0Juq6F@ES$%vonExRa2>xVx2R$l}&{{UE>c?d2T2O224m$$VJ^M_Aw7ZaIkhA-z- zZFsoNe&O+f)a)|146@$xIaRuq?f7u8#`S%a{>m%+?Yz~z8NEF$Bb^gsBiH7-RySN* zCl)}*YMSf3Ol}Bw^LMC)E_{c3{`K0Xwg9g{L&J~24^pujulWWR5tir;%G zKX!TfBEPx+mro|M@mLA>Sf@H@NYIVMQV&Yf3yJWb&0uTuSyz3YNf)k&@>wafBJ-y1 z_8v7ZL% z8@*PzndyI3xLyY1!DP#(?u5B|fT%9nF1AX+W4_` z6%rc_dyR`vA9YL8^Du{UNw*0z53jY;r2kzRs(GCq*b71RRB7;rQ5Uad6lYlsWCIqR z(Ia}V&B&I|Lqg~MaTK6!fce*wt6Fc{_l9{!W;+OOa-Zt3pcc}88&TD7lMt@*!Qzx% zcCx>@Y1C5(0W|v?4`N{RLL47%fa{SdonStMqT!`PTQ4_F+KDby{a9+%XiN)8jv0v$ zZN>ua1+E-x8X*eZRhLaO1A%06$KV@b(sSag@8n8#q7%kFC$2Dk-eo!ANx>>fGvC1b z8x=f(r@+~EOTD%biReuf-cx8{#3S6oRNaV|C+HG;9*0*1&ckQT825SIQf4B_2Nkfz z{wTaFN@xJh0g%4u#6N)wA)|q@*dom*CK11TAjt_mTC$^s}AA zk^ch0?D+D0Y7eCb#7IAH=pGH?Tz`KACGsVkoA%aG5##_?trz7OaUS&?aaTsK(no3p zIbBkw+_IY~E|@6BQjXB99>0iNyZ#7)5#qdw+yO&;>#RdZBi}<{d7a;P^|H}t>Jxjuk#dv zsWY@%TYgL+lzG)Lnxeqo*)bd8XNaaQV+y!HYnsME|F7*%8WNUGlXKGJOF(?a;AO-l znvS~sFiv(f9EQVWh-lO$`A!7`Ly7YnAOk8Xh$BrI;f;WHYEfc*_;P zU>j(F(*o_%(YBFiSLIW;*20sVe(QWr2{gm?lt7>w0)+NcQwcC zu_O*B&JS!lmSz8@NA!ssel}6RZ~Wfwpo*zu#!IhH7vAf>u9vPpt}ZC+#`n%K{c?UW zojlv?T48+mxd-429(Xta1o*-gqphCwdSUMpyJUj7iTnTE-HO&Ssh#F`vayrafL=2Ojp!UG8si>{`TF_s8s$C6<>-P!PG-a)FOg zTf_tzL@b!a1jX;(8VWYgjyu|FwD3Cge$oSq$A>7hoZ?RB~ zY3#snv)gIYO%~IWND&#NExBb1fl@RbzC0GyZ;xumCvBR4AkVe*)=kXPx&29F0xN;u zI$C*bV({5HuUB6I0nA`yqLQ_tMJJ=m?BcY2CniVw#-|O*7AV3J&=`9IFck&P2}_CF z_ALX9HTMlTGnkh$x%jHW=B6)5yu7fTK|og~WmD!UIGc^*O*CuHE+Muf z;fgH4hl^P}9fJL6GEyNZ9Rss08BvZ;R?wvAA1pF1x{OueGedomMA3y06^~NoHH5CL zD~@XZ{IS47X36u8BnoxWh{k|wRU*Th~A+ZU=pULt7Tm$2Sk@jd>y5o^dYmv=_8MyzG zUELFt)AfU)y8eFi0R-659iixpBZfcrDUn|r2f^YqD&LEi+z#PzVGa}O9$`exZa`YZD2CM2CP${Yy0CkgyFRo_+Oy zly%8aUl8K1pJ!sWG1KY97l@}A^}q2Dvf`4~yPTk6W)$&J=Z47$Xb3CEoRKN0X}Bg! z@$I617>!FGmkbS)TbqxDQC=Ktu?H!dk#cK0cj6x;(;}hCpIM`&V(-By59UH+CbJKW zwD#|5r$hP^IB?Vg}Na1nw0yv<@S{OFDnD%n95E%olc9cT> zhNGnEkJ^-rmoOFuiI_N`FYEG)bZ|g4hLuZP6$LfTET(LwgoC3)T~VJs{s}IpCX^$&QIsi5_JBPb@VGG`0B~fD%oGxKbI#SIB-e^y&GxHcr?M>Ox_-k_e7dS^n!Ic={y?A7B%9AzwhfW+TrYQD&dngCPAd%nRwE75z8d*%6$ zVMo^xr-3|wX6<&??bG32hh%b6Z@^rGEV%bczUJ~o^j&PyRCDc24rqZ5ov$f9xQFqy zLJ`W@f@Uwb9lqT6iL0NR+KT3Xa3~MoKX2yl2(b)Z?;IgNor(Tn^xA|0`H^X-f(D)5 z%*QC;=n8erfZxD!mN-hoV+yjdfoFH4L`RP6-j#O(-AA)^!aaNv`YN!w%wQFRbHIy?s=yvCEXE z64=kVTRvY-!To$EXF-`z>PWU)&74k@&R(Mwr=Qou1~}7Wm+;sJV^Wsmk>H*nuk;}nYFW3UtX~T;{*=>cn zC(vE?lASa$Nx=_~0Vy*d$oy!_yt;c1jfLp?pT10Q=_>m@(6m;#rT&262 zpBX9~_9r-#8_OtYdiH|m?UWBGofQ|dw(af}!&f}bJ4+spfP_AKXn*%ck4ntsW{k=U? zw*xg2hzK}v_}p(JsgT1tVJ@jj4axyxSBtB(s5nf10E;9M*NJ)sWEA6TNcIBNxKNG~ z*iB*|%e;&LQuFNE=EepbqG_v8#n<^-UghQSY=qBI% zDF8b-69+DKL?e;e8IpzSw20y_wT(?D-otD z|4hg{@erdf0_}(|8-1fjB7vo82<3+MdCkfURyKO!=gCu|e57NIUcP92Eh~F)h=DPx zeZ0M{+9r&Wf=q}C2=;l#D|Ej0D_gMj(wUv(DtXAmUK#u{t4*Vdf3zWMO$os zy0{KHNR*%AojnettG~QF8E)7)z%zeEHNZ`mth^bl@U#Pb)Gp)q3klUJp~! z&kz}gZ(X4mOM*1yIn$hj-Gi$QW)+*~&nAm(TKhoVf6VaZCVJZ?lAe!x%0Fh69*Ct4 z`f(L^GQ?$h%;2l`P3ddNX%i7AEE+h}K>eqq9&3_zlp)Ru~7u!YDv_sR1 z9H5yC1e8{%^QX*-1vL6v<$NSqV(MU>yHv!Haj-J%a!RGZmx;PJ%D;P)dntzUoB#OsKlluJ!rJ6d2xO!V(y<~wgXmnMin6Y#k|_+M5SJFQKTgt>^aHA{Fk z!`(R|*cGSP5$nMhhf&6z?fgq)AM{_(e+a~-Mp^d7&Kf=TuCwKV=jyO;>H!Ew9UG}4 z*HOjmgecrw&V|YJx<3~U%Kq)hWwbKv!WZL*jq&nXDq{djP_2tPc-Jsyt8v74m-SMj zKhf4v)m1&mv(mgE@HV!XZXvVh#az`Hp_~b`dY|)*?oCXyl^jx`d;miEqWBm~UO3MT znX0HfI^y{ZG!P{lUqoYz+sE7R6m-Q}!#qsrK*iI5#C$i7H~d+drmdXr70Prea>|mY z4uU4*cbS2_magn~j0^z^($UDxn|vI97r_<|6g$tXgvL zGKRazmiG?}vf)R}#2{&zI;42|$6^>M_w)MstTEa4l7Z#09IY8&`(2l%$syuV2s^_SbkyfZL zmu>RopA8}bC#GcDsy6jR>CpdtaL6CYR~M&T?1wQ%z-;S+496@t^?rbICWE0rEbK3) z{*-}5A8}Bt_q2P!7dD_UfhDA>pTuySQU`&v*@$neJ(|rh-2QEYRZ2I_jtOb=ADcAK zbV^$Vz=h!?9$wGneB2zzb@Y8ZnM)PdT@js8yeG>bk|}ZGo9_Uq&X}^nA5&}s|I0(# z#}4mG<>U{&cR0-Kn{#wteMQ)c_iYXvxmo}Q;8Y)w6HtZNqqHu}m}=fe+#_eGe>drB z1dANF3g0$&y-u*YrT~@$QNZWLdt1)h@WF#=@iUlt9~G9sgkmE<!Uju{>h7SPs;nI6Inm8_qk)&=>tw5o^Z)+Wr30)0WnvdvaY$*yj3tehzrT!BGbh+0$y{A)?jiy|rd z0yhAW*V5RTbd4A__2`=@CInKQ&F$$f_51wed|@6@BTT<=I0Ao!suH-a8DDxJ`_#C3 zre8b-EOAInXP-=g4PDFjokNo{rcepVI;P!Kx<5u9&;|x`l(G_%k-~%i#`@kIetbZV z15ps>gVMtVLC$_b@B1I~^}F!FUM>OXx>se{ruuTMt_p$|GFez_mL+1B@zkMpbbpxe<2<6s+vW0Dd)5!<1MGxEEs+w2(A&n)A|LDwyWl8P-m zlV?C!H{DtHOh0bQ=|CZY-nnpxr>~{gLuT zPf4*BwVS(MO2{C$z{kYO$nL;@dp-_c$( zx}()2xuYeov@m?%8IQ>KPfbyyw$Uv~w`9*My%v+kMXqhPWw_7xtK;ur49$)I^8N&1 zlWo#dQ>K{1JByZ)@>r$Z_l01s%zXtbFL;)~py&4>F*pfe*;>nwW=61e!vgp7ji>Xqn~O(?pqrOpH;)LkW7{gR~T zZEloNTArDV!uKOIamVjtxVVPF^c1;f9`E^r0F zM2ltQq1MCsBtiZR6*jv`e+5m>rMd!#e7K(e2C$t+Q?t)a!gpEg332*#Opr$;&LO^Y zO(#F*@1f*^K!3loxd;%z704XEJq`(r>msHjETEUz%ek&2kS;upHv%*;J?KDm+qL zT((_&NqkwSO4O_|qz_HbJX^L^+UGbSTYxsxsp-=ubbDp)X zUayT5U6xPl|7_9Ae0=-tJA7g@X3a^8d2b&8rN%EFEv+%Q-A$IL-PcDR{j(E8tb$)_2Aa*EAzFFz4m5@UMe z_mn+p?&XcS)zQ6?DqCgdhzg~ex60C?pBWCfu}adVN=)OAXoo8TOnT0 zef7xn5R=+Q$@_W3Wt+chb?m<;{og7m8a~O3P7rJzf17r7K)G;xRG5bt8*|nvz2AYg z*n3Yw#QLA&sR6I#8?u#9E@ z<&B$^bU|N3U1=RVqm3V~$S?o4e({sMKjLlVkmT3yG8QjWcp?Q6jgk<8#d)m4(qy z-U$z|i60%cL=Jn}(f&Cq>mzrd$?uEPN?xuRX{do)R}aZMc`D|`#*ZUX*{ddQF#m!h zjzzDQJX4JmWhEgdHxEo5E0@h+?ANN<)m81I{UQS?!0y<6;Ywb*m9-jB1I zH@pb4aZCKdJ(zuwgo93RbDVwmb;(0}L-seSM^96&c)YY^)GVdTU;J8lNqg`*qM)Si z{;Q*N(xz&j!$Qzi9@Ur8_dEu8!`=bCJV-?ehoH zKjFGfQA-M6I5PdH$<0U)alD_W`zNOqi-hNK5g92J9v*YToXZ-9Hs@XX^0mW5QU9gp zjrjD`IdQv`n!TR1Y2X58Urozy_%KxBGqT~!pa#>=Zu4r@!MKwRJ@n zxc6gLFLH4{CA{X9mAE+O-NwEZ?FzrABnl=h*#AgD;!~8GXtmq5KX)fe`!8zt8WHC+ zr7nuQ&U>UKLcPP!7St)9ZrxENS1g!dQ2#02M9W@nwe?(u_@u~w5}#Er{c$6T1!uqR z7-xqkl|5J>d-nbFR>C3+x`7a${xx;#UhcwqMRCbbt+N2I;Bv*hjo#9&NG~^@_TkI4 zIGlIi2tq~t|t5ePm z>~a;_t5{&X;jElnY1cnSHgngHe_fdh7?B#`lGb4mbl_`)*tI1&)1tkh%qO|(;O957 z&KfPnv8`>Xqvw~T-r?oqPPkO_29Dd>BYE0G?l76cGreG?7kw}OxF{=s__jFvwY0z= zCq4n!yn4h-T%4G9+{O798d>(qGF-vVx0*RfdO<0!-Ml-evPf6s4a!@><(O{WV^Wy0 z;BXts4KCIQ$mG3i^8-aswzLYNKWq-Hb(>Qs0bnA&9rpS8ktGA?9FPqI$npo^# z!9Q3u1xAfi&}+@^_VSibdrJ;Q_tVqws4l%$J-2D3pXbPim$*QO{_4%doWy1;Gbr4} z3*B)c{p?Q7?!DKNWiYT1DMl1rl0PYu=I2^FX-iM_O_>(Jc?eb?c#{q}bXyF^<@Xe~ zLu+F`#hkz%CJMGOG5G)ZdJCXBn>F07Xz%77%+dx(ciQO}7Cot~i4UW40~IqG!CP%d6_bTP4;65yKL z&ktj5%3T{Huafz8SdqYte9mtP=u35CjUr)4*%jyb=r&w_?UABOcyoKm55Ba zH-tPso}u1!Z-OX1T)EP(c=Dn60f@ zI`LK@tRKL4pXridWVPxcE=w8%y#F%#0S4e;(oxSit1JD%9H^m+7yj5zo&q-jqR8Jz z5&abZkZpf>=5YkkIWvtHD!*RyilIKdxagJg5=ank`LE$Wc}a2xTW6XCsG`<^#B8^# zZQH%5dpb1?B*Yz0WTA-Fdz}U~2oE1RLzv;vlgunlK0K`Aw z-fU#aK-~EkeA5c_d_~c?1NReSpgM}R8}4ssVMzH3Wan&sxrMkydKNo=b@ z>j9DPUrGRZtlbrw_b4i>3E84#?-O_f0Dy_1OGoX9{NhS+Q zFo#+}2hPpoz{}SEoCfLwWI&A#AlDdBr~`8CxrmQ!0AjoX1=@Bz%x^(Ky!y4BP=t>J z(isO3GLFP8Uww_nAI26`q&xq0Nx)sCjLH9A=QSU!6#}&sFdzP_XP4$>HuBq`zk7xO z`7x++3(`P+$-iXRpr(dB5*tuH5TI7vlzd;U2I?GM#XvVbb$9vG@l@=|&^Jnt`C`iK9{*OjZ+37}Zpjilj(lpdYn8;JNamM_+XFRFOB2z{ z&;!>|n7aT}vIJ+8v&w%Hl9GaS&Qa$|&MYaYqJDS|qzO?tQ3gE}2I`G}Qrl}`pI@y7 zzbYbn`Ht9z4T2NgDD8v2Jo&foH2x!#e5B|X-&~DWh7GMxr*nsL{ zP{o#4@bK8H032K)Stjz@78oAB22(XhyJ*8hAHwt37)EBh2VDt7=SfGklNj7!KBKm$ z?Y6du>r~~QZ-%ag>C2n9i7+oSEdF)76E44ee!2SH*oCl^L)AU)cM&9q2?-GXF_X6l&agBd@FEtd;J^p6HeyONsDK7V$dgH@|0ly{Oam z*Oes*WT57n5UA`xFtgQDDmvIGs9v7!V0x1Ia6TG4Lbmd+e=VC4S#c*vH#6Sc5J%p6 zK8H_^X*4ul?H`{7DlBo{Tr9S^JyqRtMhZM2cwUR$vZg;B=TZ>2JuiE@KUWRCc`;P4 ze6ecL4=9svzA=w-8Tjr1;S%p&Y-G|z7aZ7f~!ctupi3gwu(wU)m(QSBi*wt3jem-fo3%I0u?ik zcbQlSb0J%2vw4R|UZ~+h@%Oq-Gt@CU|2y1ihd2~ zX%I6b6VIT9MBsZ#vfZ?TS2U&_4Sa@hzcs}?@W`)hWXQy&l3he{g*TQ_jmciopT>^0 z_nYKu9*{SOI0+@t3Ow-5!yx37Ja`@T$j+k7UiQS&wgGCi8ETI6Por)@37(ZQb}or)-fVB4 zfrCzULMv_ImTLx`Ih_7U&uSFzAM%dr#e%eP1H#u^^9Cocr0r_~cslbFMjl2LOuPCv zbd&z~Ak@)R)_M>g0LFjL9l;riHo*UyfXL-x^Fan=f(Mz-FisdfY+$TuyR#b{L%n`9 z*s%Y}CDN5&o=5jSh&Pj3M*_cV3yzd1S)r`quJNP2<)z8Z`P>hAKvDX>oP9z{)_ufK zY&4yklKm&!ae4c@pFm^slkL-OVREZwY+0}4_IeUQCp$_z?|Nfge~Up3h}uXt-t{YFSxqcCr#hIdt42ir+f6 z8B-he?h;$NXqjJ}S{jlJOBZr)mL}Zey+1x7SOd2(x7)e(tBuId(tPVoLQ)PgAX-JE zi}cAW{7NZM93YaAL24+aXtjqBMP4_+$HRBps92(k;rS8X+JPh z0Q5gpQy2tJLlE~9z)5YHmeb6|eJIz9C}1TEouYe+-`LP#a=^AGbk%~xhwW-S5Ch&f zO87ro%XjWEW()dlcO*17w=Hl%3rhtHB)_p8k#YfM3A{?@zKU}y#v$g4d>z3jWd((s zLNo}c*&smjdQ)g}?$j#3I!f$*idBR`$*Wy=WH7YtcFf}9Lp<8u&1yCjM#3$mb7(df z3(%IIJT^_7F299InEKI}tnNwuo;a=tVJWwcd%s#(lam2}!sYVzRj|rmwpooM9ltRD zf2&d0-kQ&A2O*4$9`Pz zFScI6S>x~VF68kz*j2lx&reH+T?K34%L_SyBTWG>+3B%^=~9&0@KL}{=(XQkKl;78Biz+Ob7OHK=cl&MN#+Grd^yn{|! z@+2tErh7)ec>Kox%3$`%|AcoM`!DD9VUh6s)2CmG&c~k^3YBe)CBzhOJ-*QJIgw&3 z6*&*38~mKI%l>EeEP=OA@%F~0;B+Y%5M+HguJtDL@pPCA=tTWd#Rh~)8O*ZX5c zAJ4~SR>%|2>%KD28~Wpio$Cw%)l#Z_vy*WtwQ^NIg#V`)<_A1iwDd zZMLQniRl<-QWyVNCElfZ*ONgO+_`Uipdb%Y!Tpg4B)?u3s`N7InLxFVeZn;{Zh2Cztk z0+SIB_$m)x%!9k8LQj%M-c?17s+=Bn+6XrOe&Cc&B1nmfteFwa@s)+a^Z+a)0$2uc z&umCF;GXypS+6AW00~nlI6rVV5x6RVu^PthD|s3~KAa6E_j*VP9_~BS8gL;BN$j!g zPwD_Y9Xu=`ClbPqwm{BxWz*U3HjR18dfkc3} zDFLZTk>Z4REE{EZ0CtbIp{Zl;v``;ob`bWa)Jv&=lP^?QlNQifyAnvwzr^kTgV+V6 zmv^P{fW8ECK>B*8B+Y`HT!^U(DEucUv(l?2=w7u~_^LgVS4$}V)t=-)(^M6;o>C2h z`$eR-4)NJ+t!U#}d^N0T5su>bqrmDSKA>#px!>U^ z0}X~#W5mQZV}a6QmiaBR7kj7ok46eq)u&>=>Y(!~C2kV!#F`R`D`KOKw7v!B&(bZ+ z1LX59MYiw*<@REL2IvlG@}dwVodB8pD@zf)g#zq2|BeZ~#RCXi-j~LrqN!CvQsUN{ z{;F37skmkmSvR#eJgV5ZlRw_c^@UU)Vn%|+V(PQaH!DNeSwvmhfpTfGo*EFM6cY^R za^=fEr3hl@RRo|##QPV>c|K{rf}i>o{F{HlUr;@DPA4(^*I^Vu#`h`3 z!&TYezbe1Gx4CR#gI0{+)V%)1V*!+HNU5N`FRmYoL zNIec>S5Z?jTFf9Mrzy|k>&;NencI?lC6fci6D`sjN-A4Ji^GRl5PspNQwRp;VW&Y@ zNmMNvNG4Fj{|YEe%cq7i(021%8VK+c>ahykES#gDJ=P@y6$B0VVl2Yi=49IDwhV#m zjh7DKwE>mXUaCAt54q7^CC0gFG-}}kS#2|_={G$fm3NRd5u>XN94SHzsiPI3vxQ@-vuB?`|{yck3Zyq$O%P> zS#4(Mhgo8%i_pZ_=SW>Tl+Am=_B<#v+5;Hcr1#4=J?SE{=W}{1TZ_Q;g%yBHg<`A$ zuSV~efqm8Vv`6Ywb~9Ux9TTU=*!5993YI_Szc=S1_~L%%eEXV#hWolIMmd-qCW+<# z!J?Ia*yW^LTx#0B$H{)Kx$grpM|zn{_Xk3bRMzv+&lD{%I%SkQ<{bKEpg2QuZD!jl z+B!6GW!10!ty^0f`28MDrygvqx|moNL#-WiYQT$En$TR?xpk^gU8lps)1%=7s4G-r zFWB)bQ~(7W{MXt55FK7Q^iOf8zF%93pDP-;!%OD*%F@|F`$}Q!02s$rMgN}*G*$p` z|91k!UDp~^&^aG%wC)#h3rMU`{yp^y0A+AXO0(sN=plf;rPuq^l3DGT0jMFSP-;bvM627vc;f02$jvgrN-0<{F)^yb{CDBUZLUl;n< zxbg7cNm3jb&q4CkezaMZf>SFDS1lZ@H&eN&rc?t`vd0a?o;M z=&$2YV7&YjTqm|dpe{<(!xzl?u?oG02QvdyE6*#c%`|1#$^2)w>8HS9pe zD$LyIlbYhl6u#Hi{WSiDI<7pH(nY(b^w3oiXKxKlwyPq$tlICwEnOh`3}%~Uv})tl z`T`-9I<(MbFk6`s<{y$ckrG`b5CL7`_WMx0|FI|FNLQ1J%%FgOKpSuLJ!nR|5hK!v zlzKllu2MkTdU0nC((^5zMOi%It136l$;n(?a!y~-h^u2~OcyRz|gynp>h!O$zb^vLp9-AUzzo(pVp#K^OG8hQ*`UTn` zF2I4q3ZxL0V6U@(c!GAOyEb)5!QBAf(SlP;hCA?}%*td57v6DQ(;z{}%BS)`}@M1s}x&W_Hr!OMx;%?lV9*vkt9n4Ba8 zBnB8X7%VV<2bN@VvO^3Bte}8_;Q~*bEf}4wY|ZUVjEwB<7+?P|voJV+vq)3bvRdcD za3?l>`M7x#!}SI}h{;THDmgG-xhQ@9D<@7+O1IjgV9~_mO@pH_xML@!uR6i-K*Q|K zMz`_Z-3Q5ZvMo|Qm!Q-Bk4Pg1wc_VmL9I{d%Og=_Nr{#X~dC||rSRYR4ao=U>Tt({98m@~q9~d}#Y!N)a5N z=H*7SGd5+&s^4doJaxv9M$^saGsnC8HKj6MoQm%k$IUQTj%WA5%0trNxXMMgT+0Ew zZy2>7acxy3wFFnuzoTK#Milm`^sfBI*6E0V!SKmtQ;uIl!HKvG&NU5cUHT~gk|(}~ z2D_Ycc78uhvIbvE4JL?k;Pdc0<7<=3}@F+NI*$s&P4X1neiMfXtGsVGGO<0o&|u4*$Z8tcl~ z4#Cxn2^02J;8aea-QWl&3^7n3_0K@mv=l8C4sF7ooES;$0xAwI{OZZTTEg8#feyO3 zvgD`?(k00+L5xrD@wCCp2JOHK=Q6&2E^pisTK;AC*5pmRlctO04eS<%N{|@7H}iFw zkSqmkr}`8abv<;6hR}xjxE-yDEnjiy&YyJ#gz6-zez99`;D= zv_^&}r3)3NDkfzP1{YYuvsZ9XWsC&(Z#p+5)!P!g?HxV;1P_G$o-cz@Zw1L%DP$mE zGUIGSn18RKqC34OS1`af0P$m?WoN; zy!LQRT3jJ*HXk1eN8OY6rXHi~AQu@SJyKnclK>|>IkG;Eq3g{@wx3vvPH+AQ73NJC z!-Feazpj$I)l1)jE8M+Kez}|VePtKY4bgeKFN%l|Be0a~>3yYZh1xzUhHQy3uG1d= zG6nSw4JQdLpWC%gkIcuNz(k>=T~Ubd6SU1wUtosb*^VJRV)`lT0(X;BVy^2=c73g@^_VZvwvL9E%>9Z9dQ}miy4iDi-^3(!P6JxF%of zt|Ts+X#6GmK@Wx8L&#-s27zoo@MEzup8;$1x3|jsDW58VHwo!{bIw7s5Sa-q%{sTy z&@#%-_tNjME6qeKIKY_S9csjgVX#%bK@T?B<`chtyXI*f#q20q@Fy8VqPQAn*yE_G z1PgSDz(WNz4}d)p~Qj*P7@CmCbVWq zl@1I>sy5GK!{*H>JQ}5L{$(YPqNb+< zq{jX%p#x}U0roVFYEeK;I~mur1T7+Nk1(#baz?mt=&{;W^X<+3aJlija)~`57ORHtCc((^?2njmi_o6|OULAUx3aqZkkWY- zn%QPWnNj8K=79X6dqHHr`q}JG;Qen~{^Qm(#2Fl?SA)8&aD2OC@hJDFUJ^$)r<(%* zYue`!Oj6DR95f8^KRYPftAi$LMXqyT1f0-b34ChJBuDaNL{;WBOkNI^P?|p0cJ+B< z9>Z0GIGn%mvSPpshvEwxYP{a<;_`TZd+U3bcSCxEr1-ga2vSer6A?XYtML|x(92`X z_Y@LYnlGi|qmn6E$TSmqJtu7=k($i|ggJu{!tc?m6$(?JyoVjDNhWtN>DNXALVc*6 zF%|`tePU|vzC^>w<3#xQl%uJ2N?q!mjszI7ZOyl4tFp(g-$JrWGJVh-gQTw0@Ih=r>1t^62{*<8lK2OnOVqHj?x`FUQBoN3vC(KMLYt z{^*%437Xto-15a$@01DUvi%Y)LvEr>tGM5erhu~U>@Do}Fx+9EycrStv*l42(D z^u6Z((EJXS`tU4*sOrrix_xZcnDey{Gdz}Etl%o{hrudW*_{pA9jp5uP7^9fzhB%V z_QuYTArM-Ve6r)S%)c(%pyBJl5Y*T2+&}6hBRnfOn>W6D(4=>H_AQxa5b_<5>{|m9 zV>Z)%?upcSzj%x>Op(t%&#dA3OVK#0^v@s+Gh6Z*!L9WbeC`h6FMJoyt%=IBZsHAV z9vq0Rc!?T)yx?XFModOC2ucEaNYP=ztm1c5v27U$IMiKUmCP)cKgGi~qK}Pa2g`E> z)fAv1Jkk2PCN{mF1zmgJ#)V@))+fqKdspUmBa1TSv8h?t84AhHEf^_^P9gy=W zx<~W$CyWAN?-%7yjA_o$O9#o|@3U(%Yq*4%%A+9B&>qTRcRJowvKL{Fm4X`(XoVyw zL!MbMli+EFOcrIY5;PAo^o+xSYlPk+lN0nbx&XEWl*Ft9kbf`j}hW9g^trgc~G?* zewo;VYjOE)-}C;~@6+RqFW!y#m}o!s&d|~`Q2mhWaMQ+2#EGEsS1OWT{N9ONC}Ci_ zc%1qKVIad^?#Gt9D=nvtnmHS;{mmbk%Qm|)mOQ_yMpuwPkB+&jvw4xUCZz+X#0bnP zHcqR1ljEss{&|KodiLaN@;jo>)X89c7;>4}#ou9Zi!AjIYufYD=iYRY4<$-BnvHa` zIUleWw3{)qg)rQbmWet3VtyO9w7vv;$Dy!%&zmem3i;N4V5fOlJ=!E`3VD#7F| z_WUwk=&ON)E~d0G#y4R(oATN?0u@3s)WmaP2QM z)qE|`iRfp|j3-|*61`L_!U|LX*UpgP|Mr%lpT^gw?GL|r3-+5;SdW%Qe1((CxGF{K z0nR}fTU`UkKmnxQH{$p)yw62U^~A8>b-#nl=I_1;ciMCTuD#;f35_VVNI~gZD>Hsl ze!nCXd_~dx7W>}z`p(yQirp7?=I1%&GWqTs*$imvBx&jAN8L;6vEvWv5wxS3SD~`w z(y)-?tSS55r?40>Jb7vfSt3>l@1KSQuRf6Y2Do_WTqIKZx4~LTa~ftAaF2OZ)+|s^ zBR#!C>TA&p+fUTFJ0mk%O!w)5tfBlsc`yqV|9+FUdrPe1m}Lw1bZvi2ijl9M^IU)M zr_s$ix~oWzI!pK`?Z(8A9VM`OVKrE(WN$$=pw@lfdsEHy@5i10LQ({pcsGc5GAke_aVNzUg=*=}z#OU>SRqB75h#!S^%$D|{ z42a9_z2FJREb$cWgws(pV)MV$t!aUmi_b(!Ye z{-I&&mDgaaBQ0;}@XDXXqGt%X|2DB9BEN)1znsML=7UxU4*`1;7@dV1u1H;nD4B4Q9B#!={u2AqDf4gQnHWf)Ca~7VR?A5 z9D3AJt>=Mo%)agUC>%Op%z%=Kb3B(fyj)slbz0%l(K4 zuqE<1q&9?AU_T^**mo3bCqz?VsZ~ora|BA@u%r9gD$Y<+0KLMUh`2%HOKaqhV)*Wn}JuBMPimocvW#seK1*EFY*?@y=FHotnl`QLmuXVCB_5(*4# z9_K&%E(geWi`6u&esW=W=$O7hthc;DCn1+$N!gx^sHQDZc6G`1BhN=6&EhQCZab+M z8QI~YPnKavSHHRFJ9A>-cihp@uKMj95y~@91nldio1|6N)9XEf6)wN5sKjxz< zLGig}_nM5<;FqC_Z>xiyn}!krYRrCQt0%G4+B*{pSeZ29U%E|Iy`Q$2xf2mJun>O? zb*`W7xuI{(<5CmFuobL87ML1N94@ZKVXu9JKkzWJ#KA3tdbIoVQtuLuLuEA>lixq& zrW5WpAHy-VC0kN}DN2v7^+JNTtuFGIW)0)0I2xJU-JCGA*WWAfdArU~vsC{&?htF+ z)A7jxLbg}n5Z|>+;JeQ1$d+58SKwV?80iY*aG8bU82FU>s0i3oY&WCPiR;h7v9_KE zGt9jAFkSdAe*BwvWPu*OoQrOiBF0uCe$VnaP0qypIny+8`q+VJ+Jf z_!Q9KEgJs5EuWdE-gjD1_u@OPhxRXiaV0?3JEjhhei}6qAyb{tYw71!Wc-c*wJV|j zUAr41b;V2n-LF0{#*pQ%)_Qj~(}4j+CwL0U4c74nC!X}|$DcT>eS3K>b)51p z$JE=E2U$Fx3l3=z6uMqr8v5T$yFgslc|HfrQjzS)ec-r`Hlq#Rqtg9zmml^8p~@X{ zK@Md^&~Xnc1*>AT?+eL->%Bg|mDPa@e#L!``HCP;Mg241a;>r3z~#8`x;SxfuSiW=Yl` z6+mPPZZwtCOJEBA9@dXSD+^0xK`?k<Ejw{AHg{ryjS!^7%xV$+DQWrq%S zgsjG94NCIL8N=+-)tK(I(1w-D_k0aYDIiupf&Hj4Eh*w4C^KNG0B3^jMu0%prMm z;*c(0Lcff)t)8OhWuCym+naJO^1R8#?ing0$d9&lPd~fQJ^$DKsxK@+Bs2vKY*Gmt4CC+1s&*!Nwnl~u_O_;$ zU+q8v{LuZtc1bj0`z3tNso&_+m>hccZ@T^cT6UpeeM#o*ValOPE)GWwUChs&c z5{73z*Dw6@9?5VRMNvB>HeVBAA}pJNd>>gZHai9u8y;^@oLF_-oPN%|_04p=&U|tZ ztM4FB``&RS%i9(fd9!jD#AV}Cuo39}Ff}?E?)3b${PIXF&}%~~#}VYY&>$Xjhdh?q z7mM$--96UXfbV6CDauOKkvVa7;Y`#p%GPSLY`85z{B%`TmN7=aIENZ*jY=+X6eh~J z8sXSYditzdPkdQb$GFlu?{Z^s*z&;aa?>Hcbikzke9Px@vtf59C9wMRbP)Skr320w ze1R+wW|hsw-JH1v=jr5&Y`4Eg+}$;`805^uq5Xs*+V;KUlJuq0jYukz4`OTT?(QL| zom-%-L1OrN&EamTSmgtidcoTyOgClrl6*W31lA?@)b z2T>HmJgq#jt7(go(H(PTv13$iX@o1d4!`^;#7Oq#SVmmG*n^X&RJWR7FVW5F(+tEZ%%rfVYq(Byv6QtkQQ0HXHJTPe{8U zGvTHvikv-+jx||6EJhiIw;3kvD?gD)5{Yp_5d9trrw`+QBD4L!$r}E{X*T~SS=oO& z&F=pu`wyqB{@=1${fE<5|8Lo>{@2q!!SqG!#EOC8c5p%95W9B#5NKnTv7=b)lHb(a zkwwQ?3w1I|b9~>qS7GxhlfUh!SA@?LH3!`088VWG_?}cIzJ3%x=WR&_dUi5@o(*h= z;t6_J0zapt+SN{7amG$}AmmANo+Xm|s1qRItwL$CMs5Xzjvu8=`5Ja&g zY@CrnWrF$&%?Rk{t%hz7@1wse=9ZiKxb!9`Fd<`Nz9HsD^p{N_8<#uB@TYr+EXf7H zr$!=!e_ZbNUfhQd_YW*v+|uY2MZNL>A-jrCKunWXrQgzTTL28^@k8FWm1KFr#i~BM0k2-}4nkF1P&39sAh47fM_at{|9o%}> zGB|1I=sTT8mK`?!5Bxl>Z_jCcE*os5%Q6|0ZxSybs1Tk92ru}3Jv;wwK*vM#@ES@k zu~IN_<-bMR_wnw0BG-appymdLap)Ezw2>2|jN|C%vdaw!_p8)nvaG0v@~!Y%4&UA; z{anH_{FePGNplWm)^uTf?KFbL-s`M~*_8DMY;OpbT#VoXD>b+hxFc?!;TDNzl3!I+ zIeIiQA{px4xEzrwdc#Ua6ed~#Wqb6HG#U(KqZkRwhc5?m-!V>xHRPW-YWO~Mg-q2S z_8gpZQy`o-c-y5&S<1*Bk8B%4LcAwKkyEKULp5-;?oMJPU^a$1v_tAER;ln=fk|V= ze{;9Ao7k91#TCcTi4(_9Wh0a1>cK~4bDGwxcf2E;^x(qxb>ZXcSSCsg^@IP8lq(Lw zcE*ce^9~Gu*H^y0JG-%kw`q6}R;qi1DGT4i`tmL}-mcqx$I#0*fcea(?a}&a@yg)7 zC|7Gh<{Khx1O{zwU>)zmZ3!(gWvJ zHsBc1zC)8C&`BFh_j0{Ba3!89!VmR4i*185n3*HTFJ30cM_3_m>wh~(d1u6Yr^I~c zz}^ceOEF0a<~QbLC4x11c>d-XmVN zZU)OLmkON5cyfK~3H)4!ZJ916mZl3{MXxrIC?yNEka(P=P_OoE8jok8!9|<_UGPOMM+f1np$6m?){cx+Xjq7#JLyq|=F}JHn1QKBhePg$P7NaC9CBzl?ccMEHR*#CBw^j)X;K;-Nb-^1Nu@*HNvo^%psJPlW& z#%Y#i2e!l8)?$rQrDdP811vX%x<49Ke{Op*fj4Iw+kOxAKk0$vXLU=1gB4(mVRR<3 z?AmqOiX}_ySBe9JTF=wp?~UzGEvosgaJvh+x=ix)(WBmaN?adRyMT1m$&GfDg0jgv zdKf!6X^Bhd&wWMl(e0_5g$3idPhd)mDwhXAh)CEq#gFAcw4^`(1vH=b|UfjLl?<}CRbs+`OTS@PFmh8X{mVQ z#wky*ba#7YB6cYAYw*-(4pE=+thEVx+q)zM3deIVq^`0fnpOUfTu>{1pS}u5`&-Iq z;d`BednXx3$Xucd)(anzW`o~(Y3bc`BFitdP_%t?t#H__abR%AA?eG6IlfLAf7(z9 zO55F>t+x91{pVAwpi&A`;_y#2)%FOkKl1en@8%IYd-hmfE-$-K(Y@dtOxnMrm=zda z*WNetUNp1W6zUHDwbT3F<9-@f zBhbP(`1r(M#no;Vt~yToEPUNnkp-(kHSpu!po{RRfn7~itWNF^tbsCT#Z$~G`g0!{ zb>9pAN_KU!@)DP*k!u`ZgF302evafq3jDNipk4QF_@x%D)bs;H5*}Eruu#&rKwM~eyJ}Jv#)Ws~By}40Ogh9S90fW5J=~)%ZT_sPOu^M)2 z%#?{pDH#?OBtp@B!R{xlQE$UN=o%RjVP`V-S1dCsah&3svz(OPz-fj{vN2hK9Olxu z0yie;=X_&eRaV_=E@D!(rAI5QfgFaq@Le}-dp z3%@}Rq=9W(x6^kVxIao}Swu|^yqW(eB`c#uO?(=k!S@r{>5-=U0#BR7>^*K7>u^cG zWfyAMnXY!ON%5mShKh&5@@ZNB5uzl;uHHeaE@c7C+ILm;F^au%s+1jWf<(WzT(8S_ zHF!2V>HV38)uwiO8Y1b=1ClQs;@mXw(iN_R)wFssZax~iT`HV&dxD(5y-=~$)Uv=7gab=GL*tVqC zr4Vb~wwpCaj0nP&t7ly&Zfb0yh6Xdm;SR3fQ)lZP${)3AVEJ5c)2#>{glQ?tmK;R( zI8XLCXS-LfJ14Kf6`=T$OqV~xpRL4KKfHhWCOWA48Jm>r*Eez&DGIw)t>Jv_O1e_* z7WK<)sN&z1lC7DX zDejj0j{7--(SAv6YL%j8JWQxe)6^429E6F(8@}r22|%v&IEjC1KQ?R|au3N_ZO&UI zh>TpntN5Y#{wZoakOb||W3!)+8WtD<9@5}%dW$z+d~eog-#9^0Yz+o5s{J-`iSA2m z&O6YYa=#2JF44ANWHK1kxu2BQU;WB6);ebIV$|-0F1q55Ltg(U92@oUw_}dCINb?m zSNmCJPyzPFxy|~h?pe$ZU9j!jrf7ANas%%pcs$z;p8Ba`KX1YGoyt2SN~QbMMCK1; z6W1&{h>@q_94(NLKb;4W-*TqM6QR+18FA6Dd&L!Jix=8+N_eX_ehGT_u^o$+MH}z8 zWr1My83prn1+j+Tb~|2IBCSzN#!8Q^$yJ9sjOYm%K3K8r3h-G)wwB+z3n@DAen-Oc zdxr>)8>48~K1{W~A`9J^5gbYliby!97MT|YN$-k}acJXbp7nAa6axy!v}rkv9Qss> z$cl=J1_`156+>>l6y3%ch zr73U${1ZWcCm9xAzinjG`m*mJZEKc?+_;jIvWkM#ve{sA0oq~F4E`vO!^QD*FWZnv zb2x6odaaCl$ReHAbmIKSR3|Lef)j;SrlZi0mwkl`=h!QTaTxXju zNO7ujQ*~gpZQ(E>IeU7E+qlPECPM8D*f`&-aYzD8jPR|P(~7yd6SkUju2XpXD%0xb zTxOO)^B$(^?a>Ol9r~Ktzw?Nizw>}HcBg-C@VZ{5v6W6{lxk2zL}Qev0IO%LGE%+)Zh(i!GD1s$`-9b9P>EEyuy!oHh)J_)0C7G3kLNM*TVy@S zO%cugrQ^UleB9`a6cEWxwKl&)z}UM3rLK;e4g(wMlkFknlI-gx+`okPU=tLjz)H$>**H8 z&z2k_fV2@NLvvAszsQ&jd?zNbbBv}cWyw(O@?qi|zufp0i+*lV^ zR|%o@6H5Lg-5nk)kAdO{r7V-Hls!DWjD*oxh+9=ex(&H7cMc~i-difEc*tYw7IkHH zG+GpP^hIs~KH5V82A0!T_CQz9_+my1eo&Pi6F=BCUUzQkgXvwkwSYH=5nO3zJD!`7 zT69?xO=A2q9KEeM2MpU#;YBI3ao$X^0Y0y*L#W#>sPfYCf zw$`G=1dl&*fA<*^mASUcp-Bl=u~x&MM5)o}Q1QUA2qoX54qm9xerOJS_DK1i+`J{G zkK$fJMN`RQiEvisG7V(GB)!3+W}Sw=pbWg?%z z?t+q{S+>jUMbiCPA(!LMFby!fk4RGV*<%7=#UbLdU0uz3%JUW)Nc-j}n>xBh913H= z)>!64CQpCL_8f%=g8f0N6^6B>(YJ7S`|&M-_#SRY2J)S><(F9FpQ6l&^2#%uc7}rE zU(*VzwE2#oS*;x*`z8fYzp5N)V5U?A1VwDgi_$RE5&5-G;Jbe^Xz43e?_rC7V_rd- z(NQ4NQ`~{{eU0jj^(-{(Atm2wiPsMYansZ*Av-XjWFS`aYay~eB0bgwsUU%dn&MQh zj86%q&z=k^_OUN)Nl_3>{SS-aCB|Lsiug>iHOPlMCbQFuBeGiyhiH_%R$3=M6i?hl z6?Zb^;!m2|PZWW6Imjrms$$T}mP5!Lz7AkIxI@ZS(w^@n-gh7FKz<`n&T=9{XMouYkq|`jkBZ-93T%>T$nUuk$^};iXEVVwlGg4yd3n!d!(ACh4Iyvk8mhq{DKVK zGC6Vn@@EajQT5l%3aaHiDW)$!-Ioi=B@4BuvC7Zv7Ka+}>WwT*CU90p0s37UB1-fJ zZ*&EU$|Agc1Kjh>PQYs-pNl+~ImOC{*nl(u!$tbSD<(H>|hVU-nk z$xAxN->J;x)=@XW^*oHnO_LqZD9G zMERF>v*3a{uv14(AUfgF^y2EG06wX-a($U+0;7T3Cf<$gh+cUBQt4Q(LSirRd4N2o z*eh{6eCTxd&<68#@{tWU!=7ccioIl+82eNB>ORDEQk+>QkiN?mM$AF7{ zH;-0rWyMx!O;@Fg&VcsD{sT+1!gb?3l{GPLTfS(m)RN%4?4ugUt+s!U$mQw z^T~g?gr+4LA1~0^RtBFt!2&aX-L9p5&p8UK({PXi8IluozSqFxtmcA@>2Y(ClW#kQN zj26W$z3=RLUSf);q0(n`MAK~lS_Tp{8u_YA;MK1QYt)B++>$nm_y|>X-+lz8ppp}< zjutT&?G96;p9t5^iZZI;vVopC|GJiI=UCqs9teNA0VJpCar1GyUmM;&8M`VQby0% z?M6$*hi8{>Wx^-@)HQC8_aCP9+U;UM8*V2UKGz@Wg@#G-=(^%MR(92`u$iZ&aK}m3IWKE6R53X0s#;?B@5m%6 zp)7l1_*F(Q6XXMzd@21}5WmWAiOxP%09pp1C02l2kk!x?C-y-5hW?bzP&@<89A1*L z!>TQY|ChfcrM=fjFG{~FsRVi0`3Oos?HXF(YJQ=B@JlI}veI{RjJTN4)G|fm(C77O zJLS4d0PZbvaZTPObxOst%@Fd9L6&WMc9@wuYP(AllvHCs=Vn@@DmCKw#MF*{&cL(Y zj@Hf=#T&O0TZ;TLJ;ov7{%?n~qRk4K-@aT@PsN4%sgCDP)W@3lcDvFP7@b>os!yIM zJG|qmy;FY`KD-{8d`z57}2?!>z^-6=B^bv;v9&s}*sb1<}X7 zN#dkzKc8m6k6)UEi{;A~MDwv^Bp7A?V0pXx&K~189pPs?ZY`DbvV>i)%~>H?TrN*KqnhWh)6$1*=%2mb`}U2=PE)R*;$;@MQI{9qN0WoaVjV~76FzZPT-lD^ zrdeyJ@R!6v4f}C6e0sxC{tYAF+0J$3^$AxL4B0N!0+BI-`Lv2&lkQF@rO|w6mGWF% z&29J)KoJ(3hdZ?{QqzQN_=A@ag-_5I8wqx*Y*(;?ypcsrsMPoSXUl+9*Gs%*iOIuX z>s$S-BtwGf0^#3?X?|Gul-!hYL>$Y!7iG8GCab3Nw!TyPuCF7kmvRLgezM@MALxtn z-C;+lOyjRqV?;^bGO}6(JpytS?xZedQ>dj|oHsihC7GeVoGkjPn%lMv-L>k}H?KKYWocPAyy#7Tk$tH_Aq2F-+Gtty)|3 z0$+Kveu-W)B`e7Q7i;4)kIf&V`gR)aJ$^>kC8nJ!HE~x+lgZd$+J6njt8dEe z9bTkR-D`9NES`E(-r~p!cNw^Tx$yn4tXc`UI~pZ zN~(wC_!}3p>3zcx+rWZsSi`Dt@Hyi?Y%mFG#6W7;0blr;`e7q zFLB&EH*%5XI&6+hiz+5YM1Cb{Qup4=#rDNt_q9{hz9?;fe`+C6G=4Qz;X;iU??MY_ zWAk~bZNUK(iE}|KS_+eD&DMsfD^r{`%DtT^i(^3;+zt7`(I8&4%vDqd=5l4CO1;}oN+>WiaVJPeAk8_+Ad@$H9MY1+PZA+=Woz9zODT9#EEjgbQrl9aiCEa zE?%5IvOK=9l#b3R1Nz5D&7(TFgZffpi_a)zc0pzF)n3U)%u~ZSxvuYL(@~sp2}b<2;i)?A0Oz6Nuf`= zBJ8!MzF__OAe-HKZBK}%M8*NKPRX8iO+`1c!*wI6IQCX+;eBr7W33DZI5tg1N zG@$|)-8bH06Pp9${aDI!bnEsLx2MKojHROKZk((I444R(TtN-Bn*Df$I@oUUK?0I} z*Id)Q54N97p)RMOvWbQbOrJ*iqxqu1Jb#J^P7W=6Uhf6Ksqt6(`}7QO(zcZ)8iAZj z-%-5$08V*R_~@{2!D$>12@VPuoOWpcxN`)@%jo(AV~FQ<#b+zNbJe-OGcauecSRQD}CN|1#Gw4UUoOY}?P~TR_q;8hsu+Oz|(D{v}dK z`5~*AR$%N`5Gt1;<6z4#x1XPgTEHai$1@=YD^!_l#*^2Fjd7z$j)y*xTF{$LWuUmF zkn!=;^H*|#3i2Y@*j5A4#Rf*W>%nN`$0-svB}lQ^LR}xR@589;Ua~9Qq+%%(P|3Yb2j~VYP(HnW z-+_cv#7{=ZSMaSvNjlioHLxpcxvs*w{7$E9;mqXgma?|{tJuSsaC19bSfi@nPb6 z6)A(f^@&#=_I7RT+0BB10g}qc^i%@b!!Q)K-n}`ww_yXho}Z8p2XjrjBdvH|Ma$Sc z5ovT0Ez@)Jkmly*A+7WO6qLI;WvsO+c%RmUmcm4sk{Is6Oz?`2X27fNy>doSe2eh5 zxTx!S>`x1`!74WRNTv%|`KyTZKyLyR@Za#1KO+!{4UxhrpTrWK&E5KrP`r#@hVyli z?3@0{Cf^g*6e;g`_65Bn%PKqhm3tPHRFkAAE&+H1vq))CG)PQWy-!m6OL;1m!x!&luD=FZ)mycX678U| zP{`M`xh81TFn2t}bkYTbwcnfayaH+2D>iFrd zMp^Lh=LY3_w)k>q5tMGUWziq4MI$s|^0y7^^^)u9diyn1M6d46>XrB|rGMAnWh zybClk*RgwEq^V4|6ax3E1V+%bj3+P1U@JNCo&REn_0HDM#CJJ2N+y;))wu_EvS{72 zrFEx*P27{UBs%GnZjmtgOeSmnn8SG2)$p5Pcl~kKK2bk|agzh`vO6jB&8DLgPsN(v zRBpz|zkjoVftfoy-_{nBq%*zpW)r)r;bZD`_s_ujq=L=0F4V(lPKh9akC?~F^BUs# z8}7EB@~s0?;@gPR#_$GED%$ZGHNZtTK4a1VN@IUasluEj7y0Ga9rrqoHEBCROP1r9 zY4fn2K{5`r16GlxzpKC75P23|khys^Gf164U1_v0`0RR-tz= zF-Ko0DC1;_7?hpS74tuo#jcZ)*L5W~Ynw~h9DUU3cZv0rn@@C{tjXT<>-4L1oLv&Z z*31&8yo8yDdGgdiqt9J~9vo({=SD?ttKbIbI9^?~CDvaTz!z$24Zj`Aj~sjBH|dyC zUQ@PVsj8`JWI|Iy*i)TfSAw!qJx0Z8U~^yAB6X|rTGu*P$+2tYhR;9gqFVTBS-Nm9 zwDVj5lWpJXi*8qn@(fN0{1+L{lmj^P1LHd8f*6V3`1u=Ts4n6_4e_Rx^!K{>-tQg{ zbfE$-Vb1-1o_g89uB3yXOdw)F;=><*z_DS-a_lxiKo@7IH$XD$;PYy^DzcG<0f)xW zVO*GVZ{RpqTTO=?JsEh+@yDsbv9inLi;v6TAE^~&o@p#de;+(6d3m&OMLf3Eel_yF zw~kL8dOEY(|F$XA*)(2Q!YxoYC!BMvh4(B7&1ODdCK>x%Xjd+o!kKo8mrLvM6qRDudR}B_(05#Zq)c7ySGggbr?X8d5%YUV>?K7%)2Q7B- z^}4d5!aao96eJDruxave>z=-K z6eN*=aWI&u!9_WrH(6tFSlk|$sB%HEUvYD6 z=8?@;r8t+Nh?i6%b-ZI8LCf;#oLjA6KVqUwyNpd)!|WhD{u=2am{+Efk#CrY8 zoLMBbk9*0k29-G*C8{6us|1ws@NO0Xs-;%ec(k$$SQS-`&tnwQPB`|MtzKpQNfNHK zW&Se9&wNHm`!M{vCn5%*B0lG(}a0H*6?44}G20q~6%2U%Bsv|wVUc1skH_9nVg7sv-+#-xAKyc_(r%%WIC?_Ez_oWB9xW zqjkNAWix)w!s}`s#QB5Bxl$O*%btCP=2LC)iU94!8WsiFkjNQPgbAgHK$a&VEBpIx}K^! zY0nbcQf1vSdSS3-zhK_7ydI}UD;ARDDQ?M|Aa7sYj#H{7QfUCqG{4uH2_Azs4&^-K zEa&6cSs3DdXtdfK^?J2N^vcKHX%zh@mrhIAr-(2<4(#m~B=xBQ=6~y_50-XNG78l8^RJ# zz0tm0MI``Z>$E0U7i#oY?CsUVpPl=0n%r3jG=`4$nGF_g{jJj8oW?P`-G+X3HF$^N zaB0KF6TUsO*v`>_2Wn!caT37G^5`vl^i~Z%daWM4et&zDtCN@KOg887+ELJkMOQCs z@Y2*|U*yuwYp%G#=;q{7o@U(3{r^;JUuyI|Lvh+pk4#9bv-pLH} z{i-T?S&EhCS-aAT-$G9;9~Pk-MMKLM)L|5rNM^g()*Q?z^UYa|M~OK@LvNRft`nj^ z+sqXLLTT#}8D5&#G7I*i;VLsj19W?mg&Va0l&(|sm*KSJWsb`Eg`CJd@_zR2mj}J5 zqO>9c`N?+Zkf&WtJwIisHu0b5*bd1-8AfDfC=RiIgIb{a1L4Hile1uZh#n1+FY1&a zUavAz81Xk*Sv#`qo7hhg{ZQ=-BlyBBWBb@eCNgY?BA=2!+hqnHRTMpL38a9@L1m2~ z>Ej~?FI#0Y&GS-b;-jB1F#sk5>UAc5jQI5X;J-ytJ(X~8uu<04fkW0I&lfS9)K->C z@0o%(iX4*o8w(<#n7wo)Bu63+nUJ2foqn?eUI|@gyWtl&uDUGIZ^~f)b$@v)6Egj* z@QaMwsl)+0tv<5+py7)>FL3wiDh(-orSak}o0Yd4Hbwb|5h5%yE{D2kF_ReN&J_X% z$+#8*$o=Z(k3jCSL@{aLrDeH{!?dwmW;V2%slhy?XtE*G7I?eOQ_C$_eY+`Td*yW8 zUvBkXVUW#G-ldv-7$I`uw_>7I;5^0a<*9lm^xUQpnjfQ1$c*O>b)(u$7w4JR{zb;_ zW=+KX{9$tfilcgim#e4Ku9sPNo>9?Z(o=2%{;fPLOA*J}R)cJU^RFh|>}fWL=Sp_d2rl-{F;fcyZ?rDJ93_7S}N<>~enU;HoRUtR=!|H+ZvA~t2<|6YJH-ccTv9g-QND;VSB zUCOyY^%Cp=>Az~FAB(@<{YP<=V}S~!z~RGyM!uqk2HMK@<)p-Dh3y|{=B|s^{)jG@ z;5X%5_?cDv!-VDXa5QydzCywkxrkNR(=GxWLUT4!wPwK;zN)(DqX>?yGdYbg%FJQw zfA0%)``{|Jp*eiqO&m?ZWvGEOGUPD&7-Edy@2dOHh{s)FZ*=ilAx`(n<6dGCe^J!# zBjHL|;*V1e6Mq5riJBkC2U6c$73dSKtW9M~vs`|<&Bf1@W))6`&ZU?)wdT0P4-x

sK)gHD zz}5v_l5yT;%MU9rj4ox4d!n5C4Xki;TF`LNdnS~b)5lLqTI-8OUDX^_ie8s=aPV*u z@?uo8Ev`Y+cZA^7U<~8)MmO@Xr_5FdVmfg*Ig4i7?q;xsdG68}*lY*8vcYvKVds~G zOeZbR$?M3jb;0unr3L9kM0ZMza~`BHpFX9pk>>4$K}%-o3Oo|WhrC@~n$bz34yBLM zpP9(&fJ*8rrq3Ak;5?{$qT+d)^@JKAl^$yT)jARDaU$qNRY7XR_am*jV7LB>aPn~zp04210f0w? z077*_VBQu4%0i&(G6c>oT<;9bzhczr=sQE&FdC&eu19kodLudfR927R`CP|%`u@An z>{Qff>zxgUzKT-b@U$T05%U0s#XbcrFBlEpWw%dUI(oSmmeF|Ru$sJ>^`o#u;8Upj zRD<8~3HgwolK=b?m^QMEbTP(-&EZJ9*QpDBF|XYzjI}GDHZ|kU-qDXq=<6A*Q83f; zLqEDv+f+PdpRWPELd*+#?QaxlboG*QWOsI7GjrN-R8WIxxU?eQ#`Y!fO{r5ogVOq; zDEzGMLq6=i{ZD9oI*iGrl1jxRhdPSa?J#eCK#fg-=%zTzzOzcnpV00`f|-)Vp+sOi z(DQ5NfQZVsyo~$s2H38vgi(Cn7|iyB!vpZe<41$t*X;go4vG&G&rT)=w>SGfZB!Fj zd|k!ET6|XdtxO&}uC@r>-$QFH}{Ud$kevacL#iZUX1-1ZomOA)HS(cy$( zxRP0b(dNwGmrDzfOBiZ{Sq$9jxpys{v||G=zMU;^dr{o)c+{%MG#c8TdL?kPc)ffh z#jwGyX+V3IZx7Yv%Xy&K;;`77abh2YW@_av35QyE9#K7bqYOF+wInxhcuUn*WFm@P{(A!gLn1Dj>p>Yt9ZNss=d{)DYve59 z`>Q~=2fX_mtKSUTyc!{qUUD+Z7QL$_&DdL|!!IOcBK1@q7dF^2_@-e z+}B0uSQ_{0l|!UzzivNd4PEOPTiT*Ycgpa-xZjcM-wK^dLF&%KIzLc{)hp)n`KMOvG27(k+uoV~-JE-IbNfBPpfA6cGaKa%kVT?A~XHe{O;f$-CjpSRxayV|HJIi}@ zfU}GKL!FP!1QvcFnHc?yj}w7$(nL4V+j8h7W*xf##TM2+Lx*h0Kbd&IOgH)v!-2Z$ z)&@dGx=v;LOM@g>e+sarmyyKm>+P|CBoJzc!65h_(MgWj`WC-hUp@x|(b(Jh%Z^yh z=>^)@BLBm-$P3q2`L&hj59t@-ij5NQoNd+K!14g7}_F{X$KWDF={W zn88gK3E!h!D@b<%@>K*}HAz%ru>uJOQ@si+-n$!GXndMz$v}=Ts1D$X&JPnHG*ax& zkol`%bp&s7=iQk{1qV{2RAHDvAMwGR^r>y2$&T5D;^G)B$+~}gs&N15cmYv1l=5@p z&QdB^N>?R5(bhsZesL|Om-1@`-VrCt7{2IL%%>z>TF@E1LepoRd-B>vZR{WY!T$%p z3QI#@^cJl(|11)$`;1E-7w=c3_sn16F+ZW5vTImdUcae+LO|JpcqHn~(`!D224fkY zPcdhFQ0^xtMyrv4-VXo{4FEL&Y*PV{13)b$08s{~NKW_GFNvRhi?mB|ffrjvt(hVV zgny|?-t$t<8oA;2{CY3QMh&@gTKP-%TIF+Tabt~N*=tqLAAa|8R|Cvw;rf_SjTjC=ieAOJkv^Ar>Pk5ypW~I1Y^0pL{ z*@bu8rWEh}xzdUU+h=hME*`kj^#ioP!=0|`{M}J2UTk^rH_Ez*GdBibZZ*=a(nD4H z#r=x(I%(y{#`^cGcyl-By<<5ym4cHyX6}p~9M0fULiVn7w0?T{oYOqXFx!%=`=m4M ziQx}nE3V{Wn*}#7I^^79+Zlz=nUk}w9DNN!`#LB+kv-yx?+@itc*FHuS*3>ApVt@i zbz>VNa&$46k1+bH`GheJ;M#}kO{Nmc3Tk+Fbf+HNef9(w|Juh#UZR;U@` z#r%&gx<{wFJyw>w&!ZDGAyE3U=pWhtQ-6E`+H< zL4Qk9AqV=3=4FT9gg!x<{Pd^E`aexBfF?l;NR3tB|GhN-x9(g%8vHK{3)~a9kMb{Xcn5{+c zs$q>gYlRr7hiJXkY%D>^E<{&3Sp%wKWu7DfV`^OF^nWP*!=0y`%=7VbEAxC9o9p!v z8uT#iom(sOQ(mp3(3W9LKt(?XlqQ5yIttZQ)^x=B_`i(|iLcqCn^pac7AwF~B6rpM!a`dx3e2Lnsso1qG<<&n94E<@Fy7{x5U>cf8T3pI!fX zIsRSx$BGqTkju1~3iLFFTeE$+HSHIEhp1Dvn|0Lg3tndmc;SbPgoFl{Mubm>&LjR# zlEUqqb%N}b^)f@o5oNm`zuKGm@z_@qSAS&`q4K<^DD*{s*+;ef%(qNOTrGuRkj7=j;w)kw|n*YmknYd z4N^iHR7OJUqtfg4UsC+<)BeiOW9I<9`PzftXto)^A~;%HN&Ror`_s_g^ik4(w@m+K`Wfa4Z85c-6LgzU?IM^BJfoEGXkyWSUQV(s&I z?L&L1=i))ZC0V}A)34)8H{6Eyy2-|a3XTK>7a#^cz{nL+0`PeY+RH2h4@%qzRG!uG z>5d&jd%bGHgQ_~Ud^ue|$2ZQp13+v&pDz3XwAXzV9u(^oAjAMMw+HRTU5*FUtjnOI z-7ser+QJ4vm#|##+Rw*A)#I25FHYxukN-Lr3WV|n z6eBU9WFZtrl-{n6DgBJ3Nq}v zNtu05<`k82roWs3Fs=%;BS1S52eh?7y8yJo^g!#yuB&1$QjHkz80WQ+*9l5|8=pTG zFo9Ach`AYfGKX#o-12rUtm}!-94j5y;1gFr4aZ}#z-!K3o2h9I4OJIbA%8A^DVJtM zoJrNsFGw5b7YIiKkK&+$Nm5WuBRHx-OVu6(fMW;KVkiQ64v5HD}njw1;JY^0*1^_A_05F9xh8%no^j)NU z$5fK2==9A1)JXtP1AsULdzlpo~W;5PuGwCC7>7wYE)#buazaWG56EUb&hj0M)MWI$%!T^{7;5-z7 zP5>%H!gSB6F@tm)q$6Rw3ef-{1ArO@fQJacAOSE505!s^)}1K~)K(`JVwBLSmjJ92 z0RRs`ECfIUAVh?Mu-+O{c>O@ta=N~*e_j<$w-xH`oz4tL@q{Bw_wX>(TdJ8E z&hd7LVtRu!OV`uti~QU)03x7L+`tTXaRe$2fS5W6_1>=o#5N$(HL}JXHvotN6?#yS zssSNOfN%sv^M0uJmnuL^lUMJut$Tzkty;L&$Kf3!RWF&!PMeRVmo0ze)0>j=X`4)f z_5)v64wqz&i|)7r?%}!@(#>3L!QI`)TZ+9Qpw0wpnOr`-3TdCVuoP&&kDQ2buAkWQ zW}#D|{j|6c;WV6a(JxMcbqAzX9V2PKowQut5Pf^dbKkoUl$oCVco{pvJ(u z&0N`bx!}-J1d==;kpq%UAQ2J*fsYc9K?O1tA%PhG+V~&UDa$+mv`+NbcyhRbDgD>X zl1m{WCt~X+H!aQ55{DoXy;>6F=yf3iGV@Tbft?(8(s)M#vcfN1l5zOX2}PVI3~Fv` zdgV{W+Kb|e0U-p4h&4Us(rfJ#mS)a08mW^LL-(kFUXnM+(XrwLWc{&k2V4dL(FTYK z2?8>S1TM)*M&|??V_^LWvWj}!4L_b*>dYmVOiq;i3P9Cb&HkP zZPL=?s%Yu%NUi;PxgzYe-Gp{CVAy2{xmjI9L|y~bc2ACXD^m!0b~%CA2@t11ybHvO zKs*SG)G$+V#aGpL-90Ei#AlLz6145U9qZv3H zfn#9!Fo*k%fMMJr&|orXkR43Y4oq?zOmb>{b;=wv>ra3<2E-8Ij)lY}Ouu^&L)`v?p=96G$qU^_0$`L{_&*E_Z+v zg$=&7+~&Jq%KiMx<^UeQ`<1z8(;~FL`Z?rj&l4;qS!l~*blVmo?zPV$nLSUc)v?Nd zfZ7SDu|z$igL?y`sVIR|L-Cc#+T0=f8C@_rAY=iN1=1wge`Tfvv(ozKkkP&;@mPV2 zl?y>6HkCcdY4KrqN6xQ$kqI3pnR(r`^-kJ1*U12I1;CF2fY`q7Qk_h&bxsAg8cy0p z8aHHhD(k)2S59%`m#&we(?9OfmY89i0r71or=>brr|p|UOhC;Dz&a#W0suc20E|xC zODE&^oR%RG+FbR!<-0cin6p9IBB&&ev4K}p&e707 zksELifWsXJYS|_1SX{2T2kX0y^ZG(}7MH5olF23Q0XAMwPFICK`s{eD&N|J3s#7+j zW5=cjip7|aiEB4k6)u;{{p+0@AzRF1veCou^Cq1!qn2Z z!no-}yzeq~so#*Bi|3qD*U+d|6;tfFmD2cG(+ZB3`zrGO)XZQL!R#W?jg;&_GAu?@-I7;_rH@Xv6MF z&YXF7ks)nl&PS~r52mVOWxrQw>v(^=vaeJd(^}0IvURt2bsK+EAJkdcxtBTb_WJck z68{6`ZyQce=IFt%Rh$Exo-U}3!6K#hco+UbCl%~Y@nSt@jhvh|;*?9eV3~FJWDm& zoMr8p_>gJo5D~)lfdHx|Esu9p6E+pI0|H~TJEaWwJ_B*3R#+A1Rykh<5}JqljcOk* z4Cy-WD+UmMZ+fD$Rh;kD&G*r0CbgT<3cOyMq8+`8+JbRlrDyBRnkgJKv#F2O`Ec)z zkYYy?{q+3ilOB^>qiSPR1y4M4SxUdBCe`tdVHa8s3+E2$jpy&%-}C694<8ow>+X28 zp`uV75uKZ^O3G6fO~XUonUH$kk*)@Y8Zb%sP#lgcpWJoO4qY=XFVR(1tUG4SJ*1S- z^{s66QxiYWj7R=C9DuzhfN)AIeEo9OEl`Z7ivO$fdER_Tzu`qjwEK<$l>jxN6hX?k z6fWVoWLuGqi#@-|z3-5VKAcoVm_;xj7Ddj8jAVxCB*(r2oV&PQL<0X<(I<{{bm*8i z21dVcY6^~opLshX%CcyK#`*n_zF+cf zv*eI#v?+^8?=xFW>NTz_BiqF!_d<3Ff`|%L;>~6H=+i}etwFVu&&i!|?BO0?lP@rl|H{sVWYgv*R;)c?55chI$z&;&;m(=68FC&y zk-lvbfVatQ`+PI>o3|m+742k)xRmFZ1B2QDP7s^OTh(+?*q4|jFxFU35StimN(=Zh zLN>7l6F@b85k)T;RzGJ)!1uK}O%?j9QXyRMwDlLdJ9J35S#im$5Hp|i%^wXHB@brW zsD*V*B{=W3-J2UO##LD8gPuDFVVvMztykuj6*!C0^hgv%OpVZ&a$_hBO6c=x>-#kb zdpPe?<^U`F2`cp(%SFGr45HF$lxjr0DsgF$j<#!XZeo0gcS8r9v(){`tOCnK11aX( zn@Kb6<}eS_y0lw|a^W7T=Q~G#r2RUzGEa&O0csXq(X?s)3p`YTuaQsCL=eEK(~`FQ480zeJyFZm#kSq z(Y{8Ch-x&{%RL|VF| z!EBcxg5}-8Z@Olu@sEH1(qo?8?UY#+f!>SgE*lb2imm;W@5*%ZXmD7Yu>s2aNQC~^ zi=+54X*bU7u?8P{zlN4-{<>}}#^Yaj#MsSC+#VrcVRT?xuY3-UH6*#O=wQ1D9mALO z4_dMK7#{Lm?=Yj0o1S|gcQ33~C%7MBybR^tCTQ+F^Evd?y)(VMqTL{LyMDGx$Xy)C zeL_3y$nE*&kWt4Ti&sYOj!Wn`IzjMM(pT(^A;?1?b#M%YjCffT_6^xjE^uyjHPY&14GC=2PKqJ}}q1J5Zs8DlHyH&B*QPVn`8{r&8RFpWEp znnS##j2siUP;X44P{=l%ADZz`nZe9XH@}k?71-IvKlR)AQT)^p6e>P28f3(@(Fo_O z{YWU6mDR&s9j8$rP@^bh2oW>Gq$Q(8S4rr6%MyZFfhkVYxAJqldO{{+0+yHY8uEGp zRoHNKHS_hzr{C1xSl#_o!|}0)Usj2njm+fwOmx_)W9dB|l69+Q$%#6&(bY z$QFGV=CagkMcG3KGY7sP%}8M<3@$|9p*|MvM`Y=W@)V(eSo1DMg@YQ+y3b0zyuN0C zZu`^;j;{0Z+)UDp8{?Sj$^L;!WbmQH^Eh6;xpVepqc*Y1$6m$o=p;XuF&WPaMsPM>8@WOR48pb>9e&#E)LfO-RGGZg3_Wy&|Rn!=SlktbJa@-1v@Q8Yf z&Q+^vD8ia%-1%;{CL}LWRB7AiD{i|~S+A#is=qO2)G*OH>OL;=b!0t zmI=wINu{@9TkbjFWL?P8=dMp!>LYtW2-uj-lQE zBLXS_^}Ln^%?Swmx7>9=;tVwiSi zM2?x^U_ZAWeDa(10;ktYiv8UK;U$J}5!af{$`7d9`fnKOUn*%weVQg9N&d^v^Udj* ziHS*l9VNlGGD`XI(A@Bz%WQMl&w*%y;X@IqSCI~3>sCa$3_qw-4b4kpQZ00s9dgbH zZemB_u~xVn_qIIMd;}?a4hcpi`uGj%(eEUs$Tw1d2x+>NFYt&V7+hdK>S$4IU2?l3{o3U zZB2cU_ZnV73*ZeA<{1<@^ zr3bauiT5#>Iiwd$X-F?@Ltv7&^eT&vD#2hlH}9j7(#PQ*JHJ78Uzd_;;huc7MvnfO z#^2V`NwB>Cuy$Pm>+caT##l=?ud+vyoTuhxKjB%T`-M=`eR~zu*~t|->+dfECc>;o z3JlwnDK_FJ-4iiuinxTnSwt8-e%NneN-A111wYO^FH zl0L~t)KoBEY=KsYCMBxOFgF{lpVc*sg34yKl`3{F#FLbY`aIrMlFxGJ>60&p8Zq0! zQn?{z!@wf;R6eQh+hl_R(l;`(kr)Z7bjNtN0OxoYZ;P1lQ}FEygVFRGQ|)&*57#Wi zEeUCc{LE#59AnsEYq|4>kev|H?mHmSm^Rqj?z$jkAB3zZ2c!b?23zahHwZZlNO^8g z-a8{_xfz4qh3dN3Q)ZN$!Wf19D~|c~Kj%wydU;r^Hv2>Lt8=0cOcaI;KUJ*nWR}Au zkSy(6+1YOT-FXmRH^QHcU4PrQAWea9{m6lpUn6Bg^8E5Pp7(7E^o-Dz^2Lua#ObDn zS_=mo(a+ybBVVO&cdR|X;=7=qYliMT6RzTox)0$0YGEm!pHPSE>{9La9hszR=3LX` zx8jBC?0g@Yqr+b&vE`i9hjE3So!?X!wVOxXw+!cUcdzw{lbAj>m2`sJ=o)E^qi=q( z{Z}-q`2OSiT1{NrwTp(iAH)Jw@m&&Xj1j#Qh{sn8r|X?O)x)Fkw@O+=Lq?yvW=~IT zU%b2hTKSw)dtP&pO3d$`z^E(bV|B%8+HM7S-5KL^*~c~BW;g0F2NX7!qTBk$n#4ns zBRA*#IYX9kciVaoh1!epchT&8B{MDAbXU>h=XcH?*UOixh5|h&C$=6uQ_za=^4Ik| zTEp7i?t^nanulqA*0`JfQ$q80HQcCs%C${#Ot8&N3S3c*^M=%2IeR3NiMm>p*;&dL z%UoLf>&_mP>N@s473F-}CVt11!(n;DJ0&O!hNq6~OPC?H*Xpc@#r4vu6I$e2pQUk2 zW2H?io3uGH9P5lZh^w0{A;__gsCps#ILrUsg_*_DF|VM;=}sp1_gOk&!CqR(?;4rQ z!o;g#>Y3B>gy;DN`*s=_bv7{;hqYsGCr3PKRi;L=Cp7!QodSg$5`S;5T<1L0J8{mT zCr$9PQpPPXRXWqICO=%skkf~p5SHKm5O1*xMo#Y}49;4@qMrF^M{AoAQ%p$@|5cJ# zz_}5gS%c<)hwzeqX`gLCM5OsXzHhNjrr>1dHmyIU#)(wJMSCkX8}EBQfAT%etw+h^ z?ujN^ar*uG)!{H^MW5Amft1q5o#xdGQ@!JO19u-m!$8Yk8jVQt+emlb&g^qlvHMb{ ztE~Xr<5iwq!uG0hLMv~d%y@#=rlm%^+kV-#W0f{ClUeScU!BO@!g!qUKg{u*EOAA+ z5}0I(mJgf!9;+WiIOD8jxfHive#MA>DdUR#l9$H>f!A+tf3e`xR-R^MKvhRTGT!`r;d?0H6owL3D`~F@r&b?^dTA4w<@aljh4cwq> zv@H5OCzeL8WkU83;e96*yiUDPN>|Lg1ysKTF#iX%`~1ij*6?T)53k4j(pk1!Q4P}3 zZPX1>^jDvxyMIsAa#OIVI_>Yz;d1y*c2)p?P0XeyKi`ZLMo*X8m=t}ERD9U$;tfk4 zXe}?~MAvM1sqX1?m|0U-uUbmS)4-h0#ZNv#D0j1a+ZQ zyQ82BGoGK?gA~(VNGFwRJ;Esine3nD8I>Y^CO#E z0sTzr3}V`jgyXeCd+tqCvD{-xMDDQ^F#1@cw}+Hym(+iOhZ!n5_i^WM@ce3*6~LPT z>XuiEI_1>ScsvvFd+V$IGN6=R11U8TKbGcvA4_t-K#Appl8&v>-o#Y8kvpRLgbJry zK`CG1jak6orG3y8bn#B%D;}Uwa<2q~;{GTobp#{$D4$OtrR|uH6g16(a72xX_`CIs z9rNk(CjUQ!FS@h`8)s)#2S5fkMgaB28%P}w@o4h)8R$W26;u>&GucMva)SO3 zd2az%)zw4xG^LfVqiSZwEjWuL10JPUP95N}yIln9HdIP;QBp@pD4Zx%*NJ*O$ z-JIZWnVP4Bl$Iy}NaiUpGXSZN8;pCL!NHVV0?6fO4@CN5;`KjmKx$9}`rNLov15|c zYoTeSDd%B2bnk;MJ#Op~0sZ~AK;y}X0Bs?cD)+4$j(s12Dpo1A11V~~(6>yzm5cGA z^oJ_jU&rjVa1Qy);3QV))Ls{^REseV&Q z_W(C3-xczF4@K_X2(n$UW_5h{(SY-Ns8KT5MZN6|L^Rb3SjFf3<_e)19CVTg3~Id# zTInMF97O1TB*|Y;(+%jA3P;IT+s4=(O+WhHS2s^F-YRsgTe=w|Wky-(*sydbsyIk& z$|m=lVd|~puONt47!c(|W&t?8XkfQXT59V#2vW@m1W~SRV40d?POt)WV}2TjIzI>e z0U&_CafV)?3)By0_$y|KLL$&L`_1qdO!E{G&_&>{&VOKzNm@$~t{Rg|z?ojp7U zRpH*C3cUeT(dvS#WI#p54XB2ELDk(xP*n_5tpO@=P(}0>R6T40RT3}2Q5@`N4~;;T zl0T?2Z3b0?FqIRa3IJ8%fuJg&1ymX6fukA#RW7KqZ~|4O)u4)88&qYpo;~b``3eP9 z9c`e>S07Y8oKG<(raq$b7N4_mkwnYClt_{wq!sR?loyv^ksvG{jgjf% zd{Q@qnG}L1Cc6S+7A4v6fblG7yqG=?nvh$9CQgFEA>)?7S(Cg)Jq!=C6f{wq08P?+ zZY}stz+BqE@H$~8e4t6%Ip9*F6m-cw33K@xW-<(#gu($X$6zk4VR%b06LJU8PJ?reMH%~ohSgrAWA6`1ih3uxcPna zz?qxb0dE5}3Ax~VHk200U|?i^U*p@6m0gd&*tg<>FuD%_mvw)!pGN^<*l4(&1ayAK z|6%{bEeS5UAmtzUKkR?F4SX9!i4Df{tNo8Kht3y8%eaVuM0Y)oz>(7sI|5=(^i&}q8<11&_u%;M*iyfR7t+DOnDYQ8)|+<*m?&y22VlP6!js`P z!BMfHAX(P|6T8Qj&|`svjA3wr2wJsh|7H+Uu?Q>%$FG(_Y*$`;8q;LD7l@1PLcu6= z9^WzNJb>x>Gb*Jn=u8s9x(*q`OO#>~$XJ2lWnjRLMgrih@s%q81kl~VXVJ~eAEdoIY$5Cte>y%o*#IaZ{|BW{(EXl6 z_-XU|Zo$Yzp{tSn+d{B@_f6f!#ZE6pieVlv=vN#7T(U_r7^niUmSBtEm$md?&#~XD zP=flmV)(#=%NeZ8f4FYL&sRSI5z7OU4?Ycmc_wtda&D5umjB~v0F+|U?T=FYSiCHK z;4?(Qd#^z#VG>+ZWe>nL3&Z(garJ+o2!l>Fs>}h{wbYsyj`u1@dbgE@oz+~=uO~~F zGuLAV3p6YO1`YD783O{!1?VGdD<;E`jYLJX0pEb> z_^yrZA}T@})~pk8?<4k$b9`3;-V1Ke z#Vcb4{(Q-MvlMJs&d|$3j5rn*QN^Wm!pRE!;)xw2t-S`w*_$P7M?b(|i7;CDj5D|Q zqA$VGcPaR)^DdYB4t5vSCfGPI(n>l_5#C4ZqPmPyHolsniWVLN8!J6kV*66=zYne# z27>qt3T&{qyYZFrUr=C!k*@)l-G4@bg@AnpxQzQfmOnzMt%%>biZH#(i^K(@NRvs{ zd`$W0%ZT{CR3%sq3D3Xe^%Jz69H9+Jt7*0tmV-Mi?Q0;%|H3e-E`TWR|6a0RDs=)* z$nPclPwO4QeZ3qPaVgBQdCqhx4%J;v*o2o=xp?E}sz1`|=lWtK!&n(k#POR&rC+rr zKy5Tgi;)&1WF*1y3xwL85MuVT*Y1o6?$S!pFn}G~HbG)78sytEM94Te;^_AgI_^tp zP>+k}ki0lx{Eyz{?E(-yMLLqy@i|!4mPzbm zABi`hfll+FV6a&b4|hQKN5Fq%4!H*6>i$szT5YVkX&w|v)9gAM5ZN*)VS&2bK>Gh6 zX;wl=@O@#ZLvclQ40F$R?9|m8goay?5^RRq9TbmCDZlHHyeAmv1e=Tyh8!WNj`MUL zCom?ku}Tq=C%pd@PUH$8dG~LjYFeg_8AQXU3ZQ4|DIFJ8e&*63C{qafOoDKgPS-qLC;|PYY2oVnKzx|FZ~;fat`PuTA6C?K8mD&F}Dkg3LH*y}^S} z^sLMOC!=mdc;m}|6>M5ikJn2d0E9n@ItNt95D)__kUs>Q%L}W<77LV&Dy(!$m4{z-W3;z6=FBR~Y@%V%O`7PJrtimNLyR#3u1JU#zgjQ?@je$5?L zihnEsBV1%1zBl>RZh|(#jK1~vYa!q(8_-1#P|t3Ne75vCGyH7nduI1}+vkjBr~@K) zsqmRoSrCdcAC*Z7=d;`SJQ&j8u*3*ow|j^}JrI@YhRqgelyfFn#};3{b_{9!sWXKn zb!!x(gSs&UoEA=Ha~K2$q;>edhrCga6YM6b2uY8I0Yq2eRT$jN2?wa)@Bo0m{qO-g z1x7@``S1egOol8VoQ13~Io~ucPXA4M68VVSgJHfuVEKrZZ^|IW~ao^ok*Q z97c;~4P(5hHpE%K=dF@U+T_$lJzxOLZ8S$#N{z5$Q&e) zG`|SQJTT0Ng%l+7uOcu44xouXNXuUZn-&sCO91gtq7HEI{~o;22x+|rp^O#YBZG(o zk~JKM2g~k0?T{%_zLvc#kg}L2kUXgS1`xI#BWn2#{Ut>^?0p$u2cu z=sgh_kd_WeUbhAZuoC|yNLbD>Xcbb*;PGh*l|D>NY7;nZUITxMl&@cHo*VFCGJ5reJAMu8K5eXGK3zQc!Xs|1F<;TmVjL>CFRA)Q2-~UPL{Xnp)*RB?}336 zvL0hnb#Kr-#$*6gS`gI`3Zl}_JmB>nlLx&rBYx_Qhgu+rY%+qbYC!!a6WE-B${N3d zJQvqx68UCa)OUZk*^ zkF1#Z`W-^aT}>J#bIHvRMAi}Mpoxc2e7IgGIMj7S?%z6|?;yt2bq^p#S|SZjo#Tr3HckBPTH2;$dmfeCS94f3!1KDaz0E%e8@Z?7ox9EV% zQ8G>-XA?)F9E$>T(%>pTerv|D6|?qMy_2t^dhkU?U-2o8#E*N7zSS4 z?!*!Wd9ibbGN5Jm6l4=CBETlQXJAtpk+vwwiyQ!A1cAPQnB%Z!K7gqTVpbD^t3L`VNDHru^1LG>P^rCIVS!d*dK|Y*d0xHRXxex8j z|Mpz|u}seA%?rV$SBs$^R|~E_4XhZKpO_pP9`u{J9V``I-@J1{ah8pH<}o-T{jO_Z zL^f!1U_>TJ)8e28{i5trnO1Dx`Xxf$lszsMA;fuFLKu}M zNTDYn7fc#iLG|@(hLTsm04Du>`#G3utqLw4T;8=IPzI3zM5}{@>^gB(CV=hCL;xv> zK>7tB-ew{K==ZY&(61R}_6s=F0PxxVqXRNKA7r+QNW%+|**`kqv;7BJNS+G#Z2#Yb zF1z~*e6WY{i8j1ocWJV2L=T-_@kA7OnXjyqvW!peIu0yfdhW9lVEH~VJ1{3EJ3=!% z@T!+|1|y_W0m3-*1lJ@L5S|toUM?7`GPv;Wf=in)Bu^P!+CMtrazFzzcLo+7A&~jc z4luqN%v=i&6^8qx17`jM?Y{*2-I0HFd$zXEBW&z-sy_ax_&CigiOt6SQR8Bg?5R#k z`ofQwqkG!jl5h44OI!QBqpl`e=8B^Wk26R2Y@IgTJ=QyV+*(8vG+CdB>A{;Eww8&% zxJz5|OppGaU3njimv)tQyid#g0E)*Z&8$3Jp62b_P@PH?x-khc;FD_rzzH*A)OU~( z7Ce9#nh5xtG)cISaS1V+KPkQ5*@gCk5WqtDRayU_QrZ}y&Mp*S<*!PeWX;=LfFEgK zwf(AO>tn$Kmfepaeo;mm6Qc(G76dFpm=gEVh=d=uu!V!;-jfBIlbQ4$IPNnFos_>` zxHf1;RwVoYgl%;o@}u)`AfC$_+S|}XO$6RES9Hp6EMCC85!VAO2mo0iL9I&+KJ9;W zKuXX6EU?3s9+3bR%g+u#37}FS2A&0HDBMn=x&Ub<{surQ6ykH z{G;=~4Q)o=C`FU7Pqb8H4o@|5&;|UvX2*!}c%5Vq2lp6vUSDBgPzk2-2+-<40X9WF zV4#OEpRlGmd0mnbxh=yu5*;vW<~lU7qCcA=4JDpIR!HXL07pwOfk_AMLle#6@k%fO zTK?<+v@8K1PU9Xv=I{V5e{{g-9smUydcSd6#L$N|p(S_?3JIMi_@;0?eW{`XqI(ub7~D9j(V_z$7= z$#<~hrgw}Ka-2UF2n!0u$7gTN-axyA-?&sScAofrx+pp6SFW(%5mbTsDrG5x{55&H zpMW=cu?IlUMN)ukdl&%M9FYKe33%h}VOad==v+Dy#6NIEqGF5{bwr|FAe}%ll8>){ zm-pb;L9qLOLICIxiU&5u<^YRpM^?t!xHd>fRuFxFH`5-l zkVYV>IDtZLl7{3Nfp4ZiIsiovjh;G;ZIW6sI3t12AHb4H!5JVmUh$7X)Ve(&6MsPf z1|4BYk8tLJaIg+A%fJw5q98op5e7i=pB-Rg<3W=5c=!l{B>&O*Bc6W^?T5`TG{4y{ z=!7KXv06#M?c|o-=twGg^G$Q09yfCK2&TSR;TF8IxLi;5cft z7C3-OE2ROBpboO2Ee~%3M>u#Wfc1A|KzsnjQ)Cj>SKtv2Ie2hG1`1M8kmywTzyU{> zn&1(RDkz?VLcwEq4*@vBVS)pWa40~50g4Mq%R_7c`~y4)2?{(=e20>--UY!?K}Zx( zAcF!)r%GSvgbg}nevzUNNeCQ}!(YD_rNT;D=Ojlr^bjde>*Kq_4{)EsRsh0!XId*d zn1U7Pijo;TIm4)P5L5<`SHD1kJO!VDdD5eS$DZ(PTEX~0D2JuWyBD%ZJG@m`wD7#~ z!%6x;j7WLi>+&4n0p2eHI97!R4)EH+1H4~FAaH0H2LQrQ{}60i9N+;S1}uy}M4dxB zc!2i{F3b%G-bjzM1D&Iyg+Dn-W@%8#ZEtd#)PUt!QLa->hrj;%m1l)MWW87#EFm0F zxL*YcP!`~583`!duL39`c(hCkWd7XU@5ZpVJ|wsiNDh|G@@ob_ad8P#{}dj(AK-wQ z(+3aVeig8){K+FMfdAa>uizwsRMoE|-J<{OM#Pj_d7#lxJA-uefBDHCm$W3*7P zj`6>*IFUBjNcHAnnvehi)iY~v{}{!IEJ=jXi9cP74G8YdHHdLnd53jQwpSOAo zId?8%vRK+U26T*TOwI1GL^yM-@b@gXc=iRs1JY(*q})1jf>+*xf`JE1^R#?|m#yND z8=uILzX5g)o&km$UrWmbXFQ$D=a{`Z?%i~VnX!>WnPM!{!1pQ*VBEK9R!0iX*$*hi zWEnnfR!5FlznI(f?r?Q;ET5C}k>bH(Rjvx#SrNKlrLpVRkTPyB)kEChSeSG#I038J z@ytz&c%*Uhpv^tWlEnEzzEN;~h3BALmWA$X^33}xlg(?5yU*0(RhZE#!e10KtjPKg zCMT{lC0y9VOD-q&fMYW~Xrb02pUxe|d+>nMd zeZW;miq&iiynu7yAZC`ui`VFx<0_N&Yb;7skF9ofiy4gnD&+p@_DKVB?M_UtOG<}u zp!2Eez5V`_Tx}{=qBn=aeot~+rt9+0ze+DwFg-1=A^xI4EXg=*e=BVLyY%9jTdIvF zMXSr}RGayo!_aR*jmpxDJXqSdzD)4Cgi-7pd;o3{%YwHU!CU#D-J(qwp|fLk)!>J? zoezsPnvbm8ZOU0P%Jj=Mh!r&oG;$s?vZ%5QFQP;+MXY=IJPhx6Ez>~Tu~@+{`yrcy zS(ODq)3R>g1Lo2yq-FLY6N@V4rPak`9n0xvgB0s7?sI}HEt#Qyo!LqXvC_oPm39LqGbn@>+Ui>4}j)oC^Dl}MZ3Kreg@2h zmh2Zb0*9MvFBN7CK7Ez&EOk8#C{}jQ^>u4W*I?#n8Xm7|-)a47RE+BJ?T{t-TXC`H zw?jJMn(z7TGQ!V#SGU~S>J$`kF93lG3f%7r0nSR6>a)3Rs~a=?O?^S$cX2y{yiEbY zNpYD`-EN;NX;kRlygF-~FA&QtHO+*@DygS=lJnA_)>e>Qm@Fr=qs6L%g?z{NT>hi& z=k^pU;MHU`-}*R#-*x36s?k~}8-1t@v~MIR!)fE zBzCQ!o9*jCp)&)MR=qwkcZ4@AeJYue#1EpfF_Xq67T#47_k9%@y22+o+E}8D7 zI2k#(RYebp2f3N^#!yy~#<5_Tew|)_{o?ZL;)SiP%OS&jK)q)x6;fLJYwamvvWeaG zCw|)Q92aNv#~se~R1^j->`bmCpXi2NPseAlg9R?mKF$uiA0AX-@2r~kH;%6B}Ya+SdZsTA>;e)$w5e?6T{j?TM$h*12a!hSYLv|Ke~* z^V)JmHI?g{aF>z6y0+X>Yhiya^VH$`&Z>_jc-K*vpj>k#YL z33$P3S8iN41`FdF1O>lte;O`a+&IwT=2scGXYIzX*(GU2Y?L|LzH)fs8W-EKU#!8T zl+tV(SNSp8|JzniI{h{O*=pBDQNyxju%JWLabxDys9}-2fM9H#tLnSc(a%?$=jW#v zlSPIFc9M>mF2|d-&I2p;SHwGTIc^D?n+cbvYx4|#7d5%u!mOD!BNvVbGb;`XPfCT( zIJC2Pbfs#E4-77bsivK7VhD3Rk&gC_&$>QOxE3Ve?W5`(jt#G!uvWV&=q?iY;&{D& zqqa_a_!8<~bB0-S_3rZI`}Yo8D=qRFR(k=ru3oiPz#>>1-*$i3wD8*u`$q1u#zZDZ zt`s_U`ngfS{8`O%UmSw(BHZ2xK3uIZ>R6iuU_q%9rU{#rt`e2j&oJ%#9rUKKHfJm z=l(3G)oAHYOr6MDC!+1)<#q=Aue@Te0X>({jeW$G<$lwpjd}Nug(J>mf}I5DRln(u z@D+l6q)!GL>JvviEv$tZo7st%ct{;Zbh=gx(LTE7dz3Fj;xGzpwaT?0T{5Vg8%Sbf z8J#anNu?=yuOB*8372v0VD1GIcQlXI&zYBh4X<0d)H!#$VP++#y01fQn^)g#+~w_> z=#82C;?nw!Flo^7tWip3=l8{)NBx)0r)YGhHWBS-3z3a{nR-)h-9mgzR%>gKjbGNW zg)jJm(=7yqR9<4;DfYe>F?R1wnuLAc5`xw%6*V{H zq6;kJ(;K~e>h@StDYMHJ0=4&o9Pi}Zk6Ncl2w$uytmxh~dDn38xP`6yImP2`2bZ!X zytH8Za%pVqP|BQg>0CiJ=KjWe5v#?>>Ap_V=!YRhYd4t(dZOABh+keho9srP^5Huj zo)pOo8)@ZICJ-?`+SbSDSC>%xEM>|%Ak31neKy>@SAAx@S$w*hZ_G!TT}>e@NR(Z7 zOU+ZN2pVjRIOXPVQKc~LmTpn?WZJF4qDro@O0I>?@_B07J#A+b*W-3c_^Pe0VJ&rK zEXe@VnxnZ28#Xn~SHJzWk4z(v7`{Qb-g5Z*4PT|TXZ-*${56oyWWQrA+`2pZzJtQc zQYTLGLDr(7o-X2Z?Lno>dgpvg>|jITuAa51-I!5ZM@Q22i2G=m33r4e6NXZ*_@`QH z>z*R3ggqJ3TO6I;kxG~k*w)s()Ma(+JicIWZS60u-EDQbaywzCy4XC=eT?+Lxx##k zw^&(df6=jaxIC_RLhI5&SJs_xzqTDYWi*if5^C8z0k(X}U*dUH+8Tg7XsY7|$gT--H->?1o%_Xq1^u4HzW zP4SY%V^{y>e`Ypd)&dA~R{misHk@)qer;X#Q zcdn;Com15&#wJt?=D61+x|_~?uNPjKyI9Ti37*QsVi9FU?$@>?&CLmXU9;0{Ub{2n zGH|!2(q;Cz^s>PlUy;>sxGa08wDDtbE)BMjBiw%T%296hdNre_=hb>6k2f(-V?RPf zvsK~In=1o}YrBMVsL=5YQ{ysLDVh70cFwEX$z?a}1m`^I9GB=PZnHzEfm~n1L*yUABM?B4ASe(B zHh(Xmv}8Zv`oxTW{jgiz0T8-8LzXz7}eY#L0`Y;0PLv4B^3U-R5hJT+A3Q zV0-Md8>^JRs?x?K9oA>AwW+tCE8PF4+++tySzV*oziEklb}3^px0b2rQ}qt~%^)}* z|JJ1>lQm!S{S6V>PG+@_Xf>k>N^?j;1=U@qk~<}r3aTS4Vo92FRUEXs^%lCllPo=L z(T1%b6oY)&p3Wf6Ex)N+B36r<^t#LL%r}Hh%4{kkuq-iERV?4nP}tmGlZ+uu%(kuE z+8VX{ZKlW9ecLALsLC#lqlaYCc34HE#Gv!+;MV;D>!FVar_(;xE-|6cSnwPq%7uwP z;2$s@qwTxl5goDV601|}o10y|sThV2eD5HR%|K}BJ=oKzI#$rK59TyeDp>J4ykc<)Hlp*7aA#Y&6$Lq*s)uX6P(pvK2dv%9|W zC5RVcr0NBYt;wg}@$U4eSG^*o2yDy>!~vV*(K{Gucr0e+o{5G<5QHjn0~UUCG_=~1 zdA@0GWZu0j9X|o&g%-|PxoGrM6MdIp2%kirP(QO^=Kmx82U)#&NTMO-z%SCQ12=9%$)Hh*ET!1%E&nb zzum^Ifvq?pG)c3DZ728(X={$q=)6rn-77W0e9~AF2^0-lv6X;x8W#c#1{Ag>vgC|Z z0GQ#sD5b*Z1#2;%i z%b|b3P%)%4?hzvss~;8ucU8dUH^7ac*oP~_d6P?~0FbHR?BtP5$|-8^JGK=-~wJf1tvy>0R&(>j#2 z?*MY@)T3vDG?OUhhvClYWZUh;okxz%L0%hU*<4NE7PQD!X)M$NFzqUb(=azauqI&b zXvoa?1u>P8ZZep&P&FOZxIfi&MgFIUMwWiQ=OO|GQb7iRVE%Y$ys~vPGk66)C^l5p zP3L(D+_Xoobui9X&hWIwV|70av9aC9C_+E~I%31f_)t`dznf)$`dGRI-=5$6BbN#3 zh}b*khf>q!>lAWAT!i*eOcAwP4`soMsEoJayl$$*qpBLunFw}U*nhZ`r=dF zvvbRjY8DJNHO(qyB3^@E9Pci^G#h{I7I0Tldxy|)Cv72F3{R{1dyXSU6#yXnJh+X`2CVah{>vbJGFa!LljzlZ*O{bMk=EV|rSn z0&bfcLymj!kgpHeYV4wH`Zor~M=Xp}D{tT~<*5l@;mpiRus+!NQf1foV$Ghc{|^#Ruha{^g=iQmvnq#1%VZ{-m-`I@4ZEmV>zqcMUc*WZM+_ zWkh>Fa6Wimx2bH4EyCUUNh_1$(!M-x6K*q|Yoy{E<0&cyBE>`BwJThKRA;l*Vpfss zFA}#@rkVHT^vc>qG6^SLRF%=0I9w5WD_8rXmK=_+LO;-E=Gj<5QZrl#HRd$d#NPow z)Zg}`V={!DumWqj)A$>)s;xZ}v<#W)C{w+SvEJ^>E9~1-`$Zz3{goa%Qd1e+2nkZR z{_-m3cDd}F4w;&)TzLeAh-Htp&C+B-#QbWxpm$b~B{bW@s^4_NO}L&4eet#$Z_m=& zg!SWn_xjM_(MxJk578st{XzCc9kpfuJ5po)q3>;9By`_ApDD3(q?{p0eBTLR|Yg0Yt?njf!7?Sw7&99seh^G}zJ7B}A&+{fRF zki~lEY1O@T>{g##vA-fJO&QM+Ot|A_Jx6R^1Rp#^Z}+PB{K=qBrWcBAqG;N2V)yva zL%%hmwDj!@U6qzrjb_Y2(t$8+pYi5s`4#ie{B6Ou^m(ilmA=}Fhmz-njO!ap7xK|? zk;$WBF+v1)ccyrtudpsjmF&C3stK@qBMHs#D_|FyOXq8(8iv!pLRM>P^qULr`l7j= zq5i>O-`MR?|G0I?>ZBs$<B0uAuf15Df=dfb!9v1~7ZT&ju zqmgR5jmfnB17YB4_xDZIeRGb7^?*hU4g$ILw@noAO%7(iZKc2mBn#O039k2VU?Y$? zhQAVbaQ-;tiy{7uhoN=RyjDy2VASo<;7MbAd19hFGCY0~Ju; z1wCTpydCE;=33Ew-n9t=RAzw?-F}vuX!ysEW#6@is1Ty(`zqYNBx!VO8qI%?`XxkY zX;kK&BU}4v0C{iL*O%sd+Q>z$kBhgN7F?CR`30Y+zA{3(*lu zmgZ}d*xd7YA-ZmV6mRN^g^+IE*|C3w`cDzI&M!hLEO?Oq|!vJ4B8uV-nk(<6;52Be| z;)F_a6IBE--DG@-a@u+;yB;3D3y4sg<1+=bIfq zKnbLdBJIy8Py^RHCtukE`{lorfGY|0!@pGm&cBzy6IKFx-=|)S8e-JL+?SB&S{*cC z3DQo_*HmJ}g257Ot~$pL5EH$B$F%Vp9<4n?=xN@LTjhq92*85LPbdHjW(Ul9Ht#-u z{PJCEr0R1R3#fv0h37U@G6EIbL%waKw%|RoyV`hKaK1@#((kC*4BzU9~YR=cyF%Hk0Z{I{&c~abio&r2Pb`2ax(t_D?Ig()nY81GR(B#jrYr1DY-6LrlvyngJhV?e$6*Hkwg z4(mi!{5K6c&QbyO@&>MP6*gA2P!mA-tj3O8h5n0zn+b9!UXo zYG=N#O4YC7j4U;E?k2KJYAJo6hip`tp1~JHgx$H2H7PHsS((9Xo6CH5BCA(Ds$sW- zq`%wo?BpnD%%-`ST)xxTiOY8g%e?f}mY#G%p&Y9V;>_JN3L#NZuE3OstbNO0q6tk= zg%*-AA(;9qeFR^0CC_+$7%b*e?=oP?`#ocs6*b8pU}3JmKGSa2cz&?w5H|FuI`eK-Z}eQat<_>QqAiT?ZM9`21lH#yROdq$a|71qrXiwoz9DfXuAFr5 zBb_la(4=nDqOICryv4yD6_>qHY0)ol)qaj9nEKiC%kb?RW3QnmVns6eI~~3B)MaD& zT}SW(Go2ZSNPNIg%Hc#h`fTGYMecG_GQ^&!*jY9BBTY9j9-%t25$NI$e?Swsf!m^x zDV2KAw}IAMI&LG-j8qp1eU!3cbc@8s4M&8V{(Y3n zLMPnzoDZhGsjT?>C$Sl$TtPtw5m_Hc5>rK>CQ z-*gtC5fYEzoQ-PWY%=j`X6n8_^P1jP*K$AnyCxAOq33-9C!x2*xe9i)I}8Z+rbNTl zB=;-BYa*^3ZlJZg6SuRsbu>Ee;~BS2aLJFbn#Eulc0)gUtm^oexGWM$Qyf2$KB#%w zhNM+d6H|oGBf_)5#fK_4J+#Y)h9%IytC-7AIbIOA>0tOgyo=Mdn`xppuX41`+cvn) zk3+K}Cpso`iSDF_ho{iy^lMuAOOqTmvT3Oi?eE_oRgf54(cx2aZp#?HcRu@+4}VWz z|6%mIU?1!lEpp0eg-=mZ?_1qfF(TBcRO;#_pyXt?%g#K$o=~@tV!Zig=s?;Y`}(#* z3vFj$ryi#yt&u}aJ%ev(NR+kG;X%jPlNZHZ&PTgXt-tXZ>ZSU3-hN%w`@ztvuQ}YJ zYW#)4-N8qNQ?DW8tb40ho5D`gp}I02~}9oN6CDSw6{ZzNZ#=(@$)GSFYk37-B7B0`_aGSxgitJ z-c+T730HcYgUs?~l&!uAJD;lm<2BLj3KdNGw}no#gyreF zTX4i!#W@r%VRvwJPGnDJ5ZJAW(4~&mag-$KYAxQZd&>EkdyiGAJ}V;4BZExyk$)N? zieIf9T3*V!+V|~`@`Q1k4lkBgkwPM#3duj9XsX5^Fo4ewuD|406iuKEW0T<_6rHY1 z3MnaZTqIf+SoN1;M>0y#3vcFSE#;SxiZYu`rw%e;vsY5PMY*yRHVJ$aA0yo&t4!Dn zlItGDzH`*Tk_e|U_?xjZXo0rr1Mn=0ok?g0?3m+FEd58D9>$*D5)PQ6i1aB-rPQrw zrCod-jj8t@F$@X?g(T)teNn+FKsIQ9FwNKb?R3gOwIDWhlZ|ffTc`gdZL7~~TTG21 zXJ?NWD6gN%?Q!T>8O`@p_i%nDU!_}47&{%&k1rLB-1r)PQ26?u)|)b#o+S0xOm;)O2EuVkBJAL&Q}Rv*+^axUtdWM`)so+J!;L z-x0rux3X|OK1#x*>-uJ=^0AD@-44*GUQ^Y z+|PCsIL-ZsO=ygnBZ(XEDP#aRouU8n-fLxJVqt4w^UT23*2Kc-73*L6>?|)#EQ+30 zK87mb2p+>#j{3aKPi9vqxqB0RSC#ZO8F`b4xaiGx?ii8@9PiC5FZUO7*z#&BYHH6^ zRld)5YQ7b)?R#tV%HD9Rvpe>FVW}_C7EU5Om7~uJ*=4xh!x3>@78Yx9q2U$B512)L zoC?$^n3w)ZPgA5(P%vV9k7U%0Wl?1;C6q`jDXLzee4{tn3~4wMSc?cl+8(?s^(Lbk zJ{QLpT2lR@em~u7dDAIPDSL<|MD5#f0l`^#g%?3s6(A|dM&2F_I?{e z`e77SD$0^!q-xMP=||cA$w(28?e>Ixvpn8Lx@-vy3hJVdYn<29VkV-s-%gC!sS4u) zxymD&I}Jk~nTZ8ET>=yJ_s5*>$iKFJwfU#r|cAj>eVJ}ACVo*6crS8Rlg z$huSZne8o7O3%!e;nmIZ{SGSkubCKbLEgn$<8C(13)mBp#Z|K#2?-UR-_`nKrcE3PezTG_Dnl(<~qw zkhVltQPhhucVM6z+@x{m%iFnztfj-ZwY`$v&#pN47hN7pV2xT4K$B>nDWP4mbu`>m zBQ1E!_>pD#l_5bwlcHStXUwCw$~#|FP%ED{!|A`QkF__(p5$BF&^PDilRQjI?nvd* zK-(c&LA>YUg+8QbKRjtFuuGBCQU-@*(*-n4gToCWG zLCf+6;c*FB{lVK=9lngw0{y5LST|@oBvjAI-lbR?8WaLG_s+Fd{hPYdc++G9Nv4nEHEKKANe!#*2&UT62{;)>fp zzUh*Ml|(GGF-u^Ak9Uk^E3P|^=P9`odr-hC|BHoK2SjX{r?*MQEL2K_1V%gq63Zd)Q?Y&eS7%+7(WDsCJB=n?Eq`^9R@0qLH%Q9{-F%I z`}q0vT}+F7{p^HqmGU*tHBi46!)5r!O8Rvb_vaAdn{uPIs2{g#_Fzjb1c-7x;$SU| zycePN0fW{i5DuEIqNEkqMB1v*=bcSBxWf!nUZy5(!O;wv@-#8*2nxa%Qe3@f69os5WBD-+RM zbA#fQagWn^ha&H z3=Vu0#g4gl(x?+h^i|OaABoNopYtp6nu}yM@Fhw5GoKaq%ka+e%D*zu$zsY3HExD{ z=nbxNJF{llp+-I{j!|uzAaOLng zLDJjYE-u{>9gNiKsTzjcW14Aoqu7M4rdQo;Rvq7gSuH@yu^*bjqxiyn7#~*K zABX!WBWeTb7IRZ;sK+I&_Lq9cb~*5zE)7X>7dXyn{CSwzGmvSxF&=M%Y41L{^txik6c;LCrMELJMeK}!IUuE_u4e~fw zIka!fbQ%)z&G=EiG#SsOviBv1aD|f~5z$D>5y(?pXI<9`&#$ps+uXi_#I0$nC;8*x zB6->mn>y#_+Ph9WSKAvU1)6g8iV-eLC% zIfT;9kMs%eaRrjteYF6^6IsQ92glufC4Krt&MEk(bPHeeQ%_rT`Po#l5)E3L zl#_Kze6AT&~`nSVT}!&Us2{TR@!;QhN( z%mq%dzwTRI1|0@NHiYkwF(fh4MZ$$}VmMXURyfKy7$7o;emZ^+{5bp``3X>uN7YBx zLjp-XJVJd%XR+XeajvhC3?-2y{ggFMDej0w$KCXL7wU;B&Eff}4}lFThZuu(Tg1#( z$9M*h>pWFLG&H7BJ!C@35XsM{frLyMse0(ErQ-Og|AUvRpPl2QCL3h zH|UGKVMg5;Yy9HGTDI>crc6H1(yQ&e$0j)m1ePE7H#_N&6nbK=(ZwrkrtN!U8$Ru> z^wbMlk{P{@I6M|!4=o=gh`P)aaZFMgmRlaos3MP{%pO0sZRd3F;9PVblaQU36K1rj z?bNQ-NKLbekeZB-zLunSyU~4hb-G|UOR4G0l^(@iV$(WIzq}s7Dy+}rI-IVaJ5(lP z>_{$XqjG6IyEKS@i{fs~t)WMPryop@2H!e1kRMnuX%J*I&c!R+m)ewXO11~=2m4x2 zBxLT#?pwm#}_WnSX6P1 z$fl7u?s5~WCG0XO2E{wx-56Ycwkk%}tdWMTZR^5$|MSQA<-CQ~3XgTH{vHyF$0{z} zzMD-AaRvow$j3;OpO>dJUQ)ku9nKE>(${zY`B3aR+v4&bs)ewfL066ABgvPWFAG;P z(K#25UURwS39_%tp04ljLX+Xvjl=yUF)1-U`*2A9B3y1lUXE)c;1RxhNgun!uTMRr zwq5bXO!vcS<*f}0(f5_<(>op9k)x}tw5~-{0%l<&(c{e~+h%(%4cdbmR_Y;U8%mBj za<#PS3JWnACtLp2q3e`sB-7J|#V%3F)WhVyC0UqjQo>X3opQ!#nl`?c?=P2UI~f&a z((Tga31(iGx~MuS@8?|fJX16jT8SyTC|6MvkMwo%lnJYP@nn_B8aZfeJN%&=i+Nwi z6rF>n=FoNg98<|1dHYoT!r1uW@M|B<#f)G@T9;Q$&;LUL68r8clqeUti3?rw4tHJvyMDARdds8>rHdW`sXm9$}1FE&WEO zjDB;}CTCSK{G9NiUfG^O^d1jI%nj}9kL@ciTP*Vwxy6HP=bMcw*KvEPBeASylrx0B zbGVFbr#Xg>hp)U`?w_RQ1)RJWAK1m>zy82arokic{jSuwKq-Y(Wj+hHUw=|x(I|)0 zvbQwqULRwDrT)RA={zRec?L{Q!tzUn$g@6ClnxANzxPK;-Pq%OhIh04S~KRhPzT*` z4Eq2waii2^q_K83nN5A1tM^wmlP?KZR{aFa&sQ6aPib$~8k22SEGQlX2%ayjjkcy0 z4((zOW$jWj+H0U??uF$mpYmsC>`Clgp`LfL*p0v|8m$&gf3}!O?qO)8Jbs3Oaz(sq z#Tt)0PS+|Vxo~{y!~f)ULF_%!WDf>vw71ZIxO67hG5;eCifg>R5&_M3;DrOcfFDNE z(>2o*H`X<=0FRB$-q)iwfd6FVb&Ydm(eH#4mM+NP=IJIPJxmv3Cd>WysyZN%KA3Yq zGRn;*{WGNsuRcfbJ!Xd65g8(dp5uoFquz5bO$ylY$sBGr@@6Sl7xu+fVWy^fj(Ft0 z=6l)ItyeIyfGG39nWbGR)L^KJpa|c&DLQ$oWb-lo9gigYuOz(o9F!PsFFxH(ti778 zWuACL^!R!T!xD(~?;qsyo~~3F0HltELLj&h6gYiLJ$V~Tt5>XgmNo`pI@HMsa14nM z*qQ(k{(t+Q%LmPejcg>o+lbfV?XD5Qp5tP}p8rof=l%_48VB%qM0VXtMCFoH>r%sn ztjoHuOCijl64tn^+qe%-?NU^3ONFepO{a@WC22+{<+x@v784@3Q!AR3vPG_2_VH@> zHBawx`~mySZ*$J~Ghfg9eIB0g^D*i2gJxytPPha@yH=loV}|_p13LVRQ;C7;rr4$hiCP|Qx2^OsmaVCg{p|CgZd=WB&<5s z@{Cn}qkGd4b)8P1n#QD&6N5Wwg0wnDvZG;?;zs(O-p+250L{Ddl5fMf!p{S4D}*(A zWpy$J*~2Yf2728URe6GLa`sUp=2pCBo_pZa%rYU<*&d}bIo0hQH{2CFXG)FfUBOMI z!c#Q1RON?W8)tR3+#zcIZO;eWwz{@HaZR4<_pv8e4$qmMD`%#Toss0!PY;$?TA0uZ zUH9oU+GXs%uRIgirxY~%c79Eup}*npZZUQ2HI4z_HxQiTE>%}weh;o-zN}5sq=)S` zP?!Cn(IB<7Hhm)^{x3~zB^J4P(RzuphZ)TIXTuveRF?GR*gZ)4`eL0F_q|6#tGGw( zXp_Fe$W4Z&%H|LsW!j`kH=C#A?HyH}Eo5)LzLeVbnt50s@)`2M{$u!6!J4*%{wS+IasPO4k=)DhI z$zYW;9pf$~hIw5NIUVUOzS=T=v1OFm2cd-Ps!!BqYwODk_j`@^of{v?`IF*K5-nHA zQneD*F!*Z+y?>|o$qcRZSbBGuN2F%Wq3joKeXHHS^)9K{z+77_tGl(m=a%2hg~!zV z;!Ht3ia5zr@0Iqfv8!(tSC^;Boo=5|iyNMhiAj7nYx?p#U-v6pb!A@h3Y*JrRYb}i z3}9%qWCiQ{4=@}lS-HX&;|Kkk^S0mkQKVR5pV@VnAi0DFXVJ*CU*c5EwO`s0SQF77 z-5qns=6y@=GTW^0ecVGjVC)?7;%P7a++Yevt3caEQjifhl-w*oUU0pWn-^Co_Cdun z{OU2T`01#qT!L<#rFljXwXCI@8qY}(9f}^kx~|KdSNi7XiGdR(4PTjN4?mL!rLwrX z2m;y&rq$Zm4H0U=#x4f5+J!q%{;}VZ23oS=G2U(o5&qF$3k%NKfgivk6V)a_)NZgy zMfsv+=DM3XNIPl$pHrE=^{Y?X6-a?NU8_M8L_Ossm1C17f_o;2qrCE_6Z8b3j z0dC)tAqL(7!HXZfU{S25Qp**OY1KP2!x&$Z}LN+c1RUBYS zJ$oH%2IMZA0_Vc6z@?y;08B|qx_mbcY}^bmwfwU?$-$-QQCxg^hD_?rfV^cW&cIb(!NF~p;sFJ_RH zKrUyM7hQI&@Qkf+DLOEZMllJ%+)MhIHf{($i;7c6pR5qyK9#As;n5k5J3~mXtGmlwk6oT^tc{SL3myW6o z6cZif8|6=RjR99+fvB7eKP33yA23GZmQ}b933nC1LNtcCsexiJJsQpcb_cQ0>K$+f zxF#VCgjGBYSW8?6h>3YH5Ek1oV1v#wKumLkfv_fq0ol6C05NF{2Ex)62IP>I0b&Xk z41^UX4A`<01;RoT41n)pF@T*h3V?25ac^Z|D10-BLB&j00!8l$VJO`2#-QnzD}kcz zZx{-lMXw!ZQHhO+eyc^^QGVSoN@0r&OPT3+`Grvd(BmN zs%oyPU2D%Zw}Lb<2nqlg00aO403kr1u$`@wsjZW~iu+Gf zM_oF%A2tMeAV3s306^dJ|L^sG@eE8PZ_BMSpbTBbx&@CkEAIzI@~5Xc0Irh~0Kyxb z&kvOuYx99Gb$!UesLZQqsj8&eA(1w9U%BG^Ilen^SZzNAMOxd@o?S3j{Jq?(!EZOX z-(Ni&SQ3-KJ_ZV3sR0-^esVK=V2BDxt#?t2imUieNO}tQE6_P)$K3=?sX7FIUPr7D z-3sp3goiJl%MD1L7>i}V$pM!6;k@Lv^I5&Og#pDO-yA6TEwxKk^==F%C^PaoQ2MLK5aXq# ztl7EwoimPAVY5_(z3gc1&)n!XA#IkB#=^Sj<7QfisB?9N&(YRiHhKO;^I;Exu$QKr zd{n#;M;BV(O(jCqyb#9})Gh~oz%s!eX{Umc^oksJwJSsWcx@Nn17k8p668C|Cwgm`YqOKt1# zoU_}72(j?6kdNSQ^2hzBiY9~-CWe`_?53NI#MvBtx{NU5Siolf%@g7!C-~nP`}GA3 zpz!}I`$km;;`?uo%y(5of0wB2W|5xt+7uWdz7J5aTtb9KMOwg6Yd+^B9 z;${qjkhH6yL_491x3A;|d}Cxj3HD|;ISzsfmOrq#Pp9|$*!m_<=F&%`KznD!@e{<%`Oonr8N#)A;FhpXH>Y6IlKbPMPz$RMZhiBlFcN z&k-BKhZihWWeZNr8lx-+E+Th*6Punpk@Rll4^LXTj1eUw7NlpUY4KswoChDR29}%g zO!onH$o}$?>ruaO{F1Hj4)|Y-2_YB>hFb_)n+CeZx?lxD zXTG4=wm(QGBdet1}B-B3X>~FqnKBo7%>>z`zdYb z8|eQjO;e7_9r=L)0KmWR=-|Ke?>kNZ_XI6aU6)%IK=7(w@cF6U;b)9&5fZ18ARVfL z;D@3|lN-s~tNpllS%rN2l-am%Qo9&dMjyJ&?Re;L7$L5&2MV8*1FP&Hljn~IDNsaZ zeCsabJwf*bPQs8h7U4i@D6?cRk~}&LpPx8K?^vh@1QKH=<6s?bh>^wuE;#v{N?>nN z$Wo9N@4?Xm3YLYL(-)N|!lQFvL4iy%l40ShS0Nl!dRM2g5WvzJ0X9QRX8WLm0X9uy z8<@Prn=<@EB@~G8FoL>rU_-_^1-OPCH$kH+;+-1<<$ldmpj=Eu+G zKi3Ms8N(^xn2Yr2^}j;+lt?z%TIt3tf!lQ@SU`FQ6ZP(NvmkA-hj;`g^M|Ex0k#)+ zmlWfpZ&CUTsx>Z!zAIX?qUsZqYT-x?n7A-RNpf8qIXg*|w!d~7-FS7vwvvNwdB{-m z-VT8cW--?UyOfq9({}b++zF;i}rqQZtU4bbA9Lpv-Q9 zgIqIZ#RS9R<^ATfh^d6{{=9kQdezIMAAWUWpRz65S9IoDkRP5O-+a#gYWXtd#M4dt zII;ZF$}VfanLcIueAv(ay5AM|`uz2xq&g{~$)S5Wq@Q;9;lk94)1_kfHZJ?2m${I7 z^!napx4=J5A3y%qy2hUxzNJV0;>4BRaS>f?Z@v47W1R2p&4*X^!|VA`Ei-Ltr1jS( z`{^gWe$-X+)Y>}X(8l`b`@{MheemmrZmJtk7hZby(6QUSON*Bq=i<@Fe)-;qxY{Lr z=8rpg!_Nyhj^*Un)>g$svWrNmsq#^)JQ}a}YbO<$dt>~}@}u^f;`2vBYP9|DZ;(UC zk28&r7LG4|tH5Ms&X%w3n^tzYn|1el72d1vPPX*dhwb6w!|_cw_xg;QC-p+*aypye(h(UP_f0G>#GY zUAidl>sDsfcGW7;qdKLZpBB|BIQZq#j&|9nJ&l2#Y9EcuW`AV6GED1R+r~Ah3mfx3 zwW#mTizdv&O^YgZ(z4e`nVtP(n+xff5*D^Eo6MMxy5?x7Dn%cf>p40#P3Bc|+v#qb z(3V18ts@U!WYy$|vla_3Z1>I9z3RW7cXhrnN-0Gi-b7m~(qihgP0`!KZ;>NE3VL0Q zA8-=!br+srKJ8x(Z*^PGdx@5iVof#W1k=$9-1H|Y6a)peA*d)Vzy+D1+LE6JY>%1S z&Q5Nv%<{4pAAVCl-oVTFUk#15SIdlhj%w+<67W(y7;iOzADShc0Bd_248w0YVrORp zA3QF0ifn&s`7e^}Z+uc^n^xp&#oT66i-Q{BxFV^bt%fN1hv~!~zM6hK!o7*F+lv7tRT7zzwM+Llq|*rl(=fRx=04W8Q0MZAi#g$;bp^vaF#UYop}%qUF(z zL*+=QqlJM@?MSGrr4bVKcKq%yT1ljoQ32aPgE#eZZXMCowwmfqiiof-*o}aAkl9vO z&|*8|&`<+V+gM`|?YjaOg0OsxEE#&1eJ>RWJ!mxKR#9D2uGAooQ%VtaJ`n3+cvSBZ zFwh?%>fBjDvk<}7BBzmFZqj`{Vqw^!uW`PrsbNvj0?6lTCNnk+dwm)v!N)K+?e05j zP?8PJM@us>%zJgTKlJLx$8b!qL9=1Ta4P)|8TQSa&vvERQ_2o&zwOip*x_=DvD}j| z&kWl5vuVdV5vE6B1Ej|DP@A=liXctBs#1!Ly;Mfh^3JdQXrK%DH(BzgPIYO9|NbDq)UITQ2dC@AxH>SLp@NuNacGj zUn^2PVgi30g_@+%lCxdeJ>sHu;PZ9ftguKVYi*T=J+FzO3_C;~2HCHKjf89pWTAdu zEsA>r#S{+B8%_1}Sx2-px63w&pt-9{*_Ti<%6vadOunJv~Y< zh!69X`}R(s5I+V0$aCKb$!cM|Std>zi?@I%f|V{gj8YvD4eeAPMA&1S&0N&j<}2ca z&O6SE3b;%%8~kH@Fdz{0C9feaqP9fQ=Zh?~n28|k-n}Q;8VVZvHWFFBM3H}+1XdM{ zC4mqA*}>A#P_RotxD*6pS~N%O!!y1>1v5tJm1k!hHRu~>NRo1)B-<`7Z!Yw`_XUcw z%xEkyhz%LhhY;qT-eO^zT~Z?v(6DfN{ByEptER@_3&=3=(0s#HS1I z(5uwnIe19?_I+=Y7tcpA-@B`-3+fK`xEymq9rGV^*u~Wf`GxT>#CMAmi|U45fL^8* zl0Jv8V|{*}`wl99Cn#arpKtOXu+NEqz<|60^-4h_Utii@sW!R+y;%KU!@7eyztd#9 zB?8rIVS4#rq;ERa(Z5JY>fcEE>iU5%VE2nKr{x)E)ZbSC^cAWiTH!yu`cViYX*BJY z^@I0JVYzwl9Py}lNOZB@%cld{PH2H9AtGtLAd z&SbFf%uxmrmKg=ZHITYb@0M2uwr#!!gMvP^~`|Q%SD`gVptj#B%ETY&MCkh`Zd;}Vr2^P6$L!)4kNaagvTbzWf zQNJD0bnd}!{q9m9#=KuQW|+Zmn+*A(_Giil;rVI8|Yc%wC-6n${Ol zQg$e{ai2_%4CQm3d(=I+0gyq7yv_y740)9RB=c{`ETIAJ24*#sJ?^F!km-#{u2OlS z*VL3>$>oaQT4Iy~H1Nvoage^be1uqo<0iXSF$Bo|Xjlb1;at%B#92>}ez{k-Az(Mm z_N-zlkP8@~(c;hv;*?UKhS&k4PAx&A5zm3;gx^p>6fb=P7=Nmn0m%qrfzZg-v|y0c zi33svA{88Hy9GR?zt?%t5}MHZ2NnUo0|8Fp$)cI5LNq{XZY`*6#p+>pJxPODZU*a@ zF^Hgd=V25h?x3ct%&i<`kPN$l#@Ls}lc$N8)O8pbCZ%a;#2}+&{G88=98>Aw!q>&N zZ|};hl6LhN&}<7Q=C(i3TX{Lh%f)vi2Yn8N9VMAn;UH}O;L_^P_#-i@&YOu@R~B21 zguv`T`X-QW&o7mO5>NEiH)JIiE1DV^SQ;(W*0pvj40o0q!eLM4n<7{t$*i|DPLgOa z^Zw(@Z@FnjBV}9*-$C<^RmhxkW_bX{KsNoR{t{Kx8#{wCS&eF@>oAak4NXjAe!=hh zdWvaXaW|b4YiXL5$p1!QD!y7VB$(dg0kMDW6m%$UFgTLYDqw%H{~?zUzBzd&RKtqO z2<(B?!|KCRUh_$cG^lYAErKB5v69!pcdU!keaD>I*@+pWG_`zz&u^gR#WOPzILhCl9b zBY>)F8#~A}e=V83mBirTHSgxr!vEs19GY%JH)5>FMc8j-XB)Q`Dl(UCOuhe^kOAn( zG2Rx^MK<}Y`Lsq8#JXVC0W@s3+9%Obv=)ILv$`tn=h$K$lz`9J_avAeim_a-mo8ev zW|2GT<{lRr*jn*GNUk^S&Q@HHGh;RY6SCZZX{TQu*N`eGy+i}^gC?S;Xia9p{Fo+K z1H2)X4S9Z9a?J*`5wp6Yww9qU&5BvC!)RF(u9obmP-@o9NQ2z69`)M?y}_YA26i`IKlQwgjST}>7tQAS_v_@>ZV9aCB7AiI)r3wmU)R7e z{2SeMi%en@&j^=XdgWh##=8!!>7a=#N^5rUxv#j!bM0|w%+_QkTIA-;s7ofFsmrnd za@qC^1zj@#Ae{NK&HpcdY)1d}=egOweaa!kSs>k#nXw|iVHN5-f>V?KbVqOt=G@L= zT$n2(<7s+#l|?e6@h4-Q`$dv$uw!VtaTFi2o;NF=1hJy9KyqDDhq61H?3@LyP8>RD zRHSB_G}Ch1!Hd$H6^}#~1nZ5%1hBQGuVR+}Y0r9@HNlMH83b5PSsd5xF6$bm?S}&1iI+S=F*!IHdB8 z*wxJWBfvLcO)IdrEl2wY+TSkNeYXnk<`}vF~hx;+|^FJgjq@2Vr9V9e@Ov z2%p@%={$+za-Zq+xB|Jd?V(mM5B*I35RXJ#FC)H!OGV-DEcrQ?Q&-G2d6^TffaPsP zUV3J`!xZVPWr21q_^C(0-@{tB@vc$|;sx7G+6ZY$p44id@P+-ckn;LxaYyYG>idMZ z0|-iP4TXTWmQd46(T4{wYGJRvVVCQ<)O|DJHBF2ddwm(x)%c%s;l3 z8a79dk7MrlAMCrxG8f0Vptv{KY2DiWKyh!iw~Bf=kk;cDd+;pin{N?}6$Sua+e)an z_2D51}Uxif=9uFa>inp;Zxe>ByGDrEz@}k z(k$-YKKHVj|F|5&qz#r4M^4Fl@MynYHuTK!(sH0{R^~z;BMw!4&?vSL0FIKycPQsJ zcd^gp_7DGKabn>-ihMiqxyW`JI@(67o@U|18uu2{$2G5=;{G!Q47l z`Ie+!?RNWg-82j6@clvF9~NM%v+>^#Oo$z$V_eP5Fdp;N}(s`4LG8+rk4U3tH{%kouMr1eUSlHH+- z!&kG^~cn$cIQb2#_1 zYqv-MQ9O$8ay*~&`*8QEbQ9zIk=#UGIyDlGo8BeVF8uAbo|-^x^u+G0)OpBv_A)!q zBX8h+Q&j{WJj3&i|0AyGgot3B4!su~!>*_wvzU2R~a`;QIdj=JWe?!bvp`IsfUMx}!G!7yaKSHve^@ z&%gR~KN1W8U?2PMzKDMo)txL%f0)w$^U3&kjqhA@(iWQ?p$q+(8^J@KW;M_8(&V7B47P{58CU!w!&p|Mo&^LRIjO=LUjq+tY6Bt}1LdxlM#RmscA(H49-$O~}w)rzXt?(EX4t#?l z$GM0h5wT^qEuSkYJ$1@a2)~zBo#9Ce)iMoztvE&)WA{{al3;UTI;M)9a)~4`ApGAO z5wx`GROQl`MeYF(8NXN7`w1fn1_C z1}ZRnxq!VFh~ZTNFp{9~Sn|VOLX+64=yo3*kd&bhx$fEyi!;>aFmPznSw-iv>9j7E zu+*E1Zee{(-F1rREnUl$-NAhKFz7w7u_g0%0BU-A!RcH7Xj(7F+w!IHc81&ToYSa$aRZjZoPQ4cqw?SE=L1`+_qRAUjh(upCAA`DyS zID-x&R@upr#wejtZ%agdF88rMRFKK=UcKqhj>6~V@_x=w{3E+DkMDyxB#r)c2A}lSS$lBazDad89lXa=)yE%&1|bDB;R^9E z^@a2 zMDDSm#G&j&Yxu?<_yvl&sDgP~G2J7uI{;zWES);xGu#uihz~gbj%RNBmC|18n-fus zFtU81rtdL1G2-gHr_4w)^rulLe+G;*YsMy@$7FeX_dI|J)ANKSq@N?l*UCD_yG(6n%?fYN{TJ z*hna{P5#LP+s0sl1vRfKm)=4Y7;PH9vy1e55{IPaHKfdme-Jd`S#{oztPUkpLggo9 zVmBt+Bm*bmdP6e`l*fGOk~6$hFr9ri-j!h%g z@gGq8qYU~896(b+Ac^j^7i zag=y5bK<|Y@A%5F$YqU8k;DM;PrB|<@Hxv_8&;Y%E@x~tC;QB`V2J# z(~+&8T46nS6d+2QYGi&`q==hB)NJTLVSFT?87zgb`9|Ke&ls7)`t91y1DzkYC&2`h zs8!WxB05qV0gxu%#u6Fv{$vZP_S2T(7u4pT`*0trp{0CL30*W< zWQ2W$`}koO#Qw+I&M~dq9|j|-wPZ;69VNszn728gxNWXwna$_#y$S!ddliH&zTSO5 zz#{qH)%V{#ruwIab*PU!tVy73%By|~DzY&{6E{vsqr@;Fs&u4?b55CTCTZo=6{u;! zrgUe|(+bc|)LT(O`yY6`Z8&CoVS0OyD_IYUq+WZP#3xy6)4;nY9Nfize7L(TH&-gn z@#IlXua0ch%zg5FUa$Y09JFpVkkJwt8ISFZsl(uq!=%#?8%LwpfRmgM6(iLf+@OT+ zwJ3l$E!}UmT^_ZFTSx5^(DCox=YZ7g={Fs6(EJUNqy+i-hlp|vR|`!KI9c(gjpkA) z3)R<6a!$mSrR0a{?v8zyqoBUh^M}|P%ZA}uvg@@b5|rMpMiao1ipcicId>Ou!3~4d z&Tpu8QVpIu{7Z1=YIE-WT)3HTNbTgI`og`BzL#<&9x>u|P?1q3G^%OZuxiw|zBv?$ zEnbJmdZ9sPf=u3`myZ7I6Pyp?ijYC4)G_j|&#|}{p*#YvYt2@^5H>(+;Q^c?Z9Vba zARbTS#vI$k~802Ta!r$>TTevi3Q z8tY;psuMSg=QW`Ziec!ovRIh5;uQb7IWJ$P3`)e|#g_f1;3=qH$Q$q)UZXcO5sE9s z^-Z}e4w4XEd89G0(J6b8#eDU4*gw2PgjLurrw@**qS@_=BMJSrkY%jy3 z2Dihwm|V4CYTG|$v(wUYveqlzt!^p|=dZT#UHiLxBYW80y^W0?vdB1d7z2NIo*AtE zXyaoZJRp(wLv(j;0JgxsdB11L^s3lDW`mSLZIG<-5vU>L@4qf$BQV3yv9ivO6eBQm z>5%R$YfQJlf79#J| z49?7+643P9J?1(Th-38D#!}p#}U_S@u-da4#siYyDAMcolGe3+@wc&{yF;Sx5vW=O61 zhLOwa563VP@C6TVL2VIuRd-TWTgwzEymFBlcv&}x+i4e*PGe<|9KzapMrvd!4v?1F=;RWlz(q?9W4wU zOih%X94u|k9sjw{_4?tsAr^P|6yEaXYdmnSgq_D?bGm43?T<7VYb2T~+;rlsvq9Bk z8zX`N+W^=wa){r4^)!At3N&*rW}0_BWl4|2?1CKntBi^|_92O$|MP8gqP~mU@Br*n zp8IY3v(1?ElO(0>^Ff}wJ0kjN>s&+8=1qAW+ViM5vk>{>{jL4$h2J|OZ$(Ix|JCw{ zEb54##|KZ=HX{|67y2*?eoPf%>Kwx-Xn8u{{di^mc*uS)^~v*oxx4EZU%jr+a2g0S z|EHxn%dZy%d zqx^4!uKN^U*Zt3A5qte_npxMb!(R+Xc%QvIJe{zq#l{zl@`BIhXY%y7^z)8BzYeS@ zvZtoEgJGs#UM5v5n&GSG9Xs_NGAvD%1gdw&UtYE^&f*I*?JUJ+FjA2&3z435LTkB? z&J;jOLA1dWXU?9jA8Jn`FsgkOb=#Wcg~1N%SB-^PoM$^zN-wUSr;pbyPPWopao8 z1(Unmb3^+*KVLfNyYV4q;a^Xa15Jtaq+WAK=kktAztX0_)IVC{UpdhNj z<#{1;ih%%1nCXqD7Xl9@5V*m`kt8mGz)2wbi3{@kDu)O{!4q83@1KDXcp>6HT$}HK z2&6X%s-Q0t7eypN&NJNi3fi|;HOg;mRET#7DnEe1XacEgTon*NspA|LKkzvSDxh^i zOAtjrd_hr!oB%i}VhD;ZfBFJM6_6QO!v9e% z`M*)C{-3R>|95Ktv$f^_M$PVjw#NS7sr}E^n*Wb#MgGR?4=cpJ5jmNF5z)F|GwItF z#jPUGKT+0}U*_({;I&8EuOyO$RYk>iEsk)c=z|$SL2#LO2a6aX7w&V zim)h}cE=H8SbUqPDV%1_*erFd+*CckJc;)HN_2mG`1;sR{Y-Ipva+r&q}}7NAHezA zappOE_8q2yn4Tm)q$aS5N*0{hN{+DOA9NBcgw__CndX>BdddEl`_{(xU1Wp0!P;6-?LqPD;tjJY6Dq z(wi`spEi(dC6XXrstxLU(h`+k6?&Mk&PA27mHi{tR zd}Bc+2FJOHmWwxm&?1onZBuC#-~2U!6-FyaO%&SG9G1lB30bPz5Emo$Q(^b*IK>); z_sI9S)z^_|Cj)|moNFqOc*AcW>dDK^^XNz&y62bk!NR1e*L zLM2WBbmmVq1{b1x1!kn&;Ivzbbc%<^fXWy~7C<;!c1;|FXT0A%_Y#%DFNz)WcB1jk zt$$81)iTyh>Gg__G8kqYVUJj{HZrm{&L&48u$06Ma;nVsiF?m?BpCELkS5>;j*z1C zs*OOq;W?1mfbMn9lH0P)ITHAmF%tO9?d1YIym`#+uQP@bFOTE{-rRZ6*ZQ}ovl-$f zKKdMUd4ZySPW$w2-2v}`05?~gcr zw0M2gczyKvZIt-!!%;|JaWlMV8s=!^8erxXLCBiw@Kq0bOxnn8Nzr1uB3sK2$x_Z- z3RuWzRuMsd)2`ZTquLx^d!Ff90}rZBKUEEc%UR3Hm8P8~$fu#+jbFCA^>tg^E)exL zH_jFtLLDY1LjhDx9-i71pV%h4@9ZOO&vr4+H`@efd)n7T4L6yn1h^QnYrDX53OVMo3_?tXB67# zCA$jyxR$#qn()#{NOM;+d81R1KaOU7BJYP=xOcYHqFbLTojWafYqLH)A1Brt9p=*u z)m6%NN^E=m+d%afXrJqBd)1wxyQ;LWWjFoo9{l#Phtt+`dGk+b>v-71Zc=ymBLtt_ z5q)}r&)6V*)cH7*aJjDt@w) zN&ajH5lqd1zoq?B`z!b9(B^kh8QGs9ZuO*$e(#V&4Tz5h;H&Bp$Zl@#E1G`(wKf)A ziP=|ijg9!Krk~nBaJdW_bd6XxA-O+zwy$yCI5~J7s(5~c!XMFq=Q9OrfSq7$$UZ)u zbE~H>@F$CDKtWh}l;g`W{^&7tm5;=*&6vdyw}x4^eJI2T|4p3PR38QstVrE^ee6e?StB)HTA^l^K%4 z_pR@_)7a(i7!WV)@(AU2Dzl)VdQi%|%axR`y!nBGEf8_b)&(2y58l&yhxobRIzHW~ z{C;0P-vqY`hP=5AUG;dFbwRGgHpm`!r8uf_Y=8?_D18SqY3$fopHHu>9Dc6OL-ias zh}P;&UfJu8zn&&S98&2XGx><&Z`>@?sF3co7zaBwbhN$KqjOs^Qnsl8c%d4OyaV*T z{hdqE-L%X`^G{-FoowRpa&jq;Y~8Xdo<57RJE&-3t&Hl{vEUz6UyN>lnLmg+dABSL zD&3Icir@`mmvY^>D97xzqM0Y`U96$r$lCLf-rOVi*o~5NcHnB}uaV}WE^uq9-qcl1 z$RBD&V@VI%sZ{F=cAj3T-t#0Ly4^RT%pYnBD9v$mR)9}h$>8v>l>i`5`h(koMcWW` zvvz&1ZP{{BklKNf0JsPSUq|y%T9w-k54(qlc~~hmLS@T!YVD=CHtZ)wE-+glGTbb7 zKt;HU2Q=ZO5HvjWfaF$!lR^C8 zWe~K0Ut9P~ko^|Zd0u>B1I?{mW)ieG`wjWOYtGY4Ayad58UMPHU7T!xO?{7}6P-ve^o5(d z<@M0Gr~TownH77np0W#4l1`Hsy#Iik(FSlg;f2zt2TSgqh1jP^^gc2|6{P6oDI{)lrKAT zLjEPTM9Wn9XIr3xZqdFY7Z$FnQIielbr~La`f}X%cuBh!$d$=NNT`|lq*5K>keYuu zFax!9xyw|X$!9!98cd$#||QTnfx;s4V;selPh8i)Z$%7%nl6xVtMXQslg zho)YwNBio_G(5`_!4y-n5}Fc0HNa;>@coO{r@jO{1g1o$HmOCBX8PKLf0Jrj(=_Bv zf$tap>%x^ow$Tau z)eHOZe!hiw1*NJS|G+yT1YkyXvI4_6kgxEhU}}3HEkF)3fjjO`b%i)JHiywXv3b!f zo!hKxN7<(v;<~0^jGY7#rJg6_?2?}P#~sgIGk+2Rw`CF9o_^!+`>|^U)F`i$0>_73 zq5^L}W@#w1_x;%)NbTJtoz_JAgXTiqC}1!Qw2sPhFjQ+_tO*JHn`^rC#gt6-Grc$^ z>&U_*wOUN&6&*7DvO_twBj{X}(~YSghnwZ0mO?5tY^3`IlOVd+@g3OcYsVE>NoC~WsSdTV+Y+=T6w_hAQRBiS*OQn0?s zRvo!5r8i*xu>V2+i(o)u^e;JRuV@I`^*wbmuJq>b7<z!`VgQtTVMW%2mkQRn#Z`sr`U!qc%kM+$;_zG!+qIP zWohtI3Cc1u+*ZxFo z3ZUClI&z_J*eoxXGKuTqtgdynP$5;i5SXNm#!C^2;Bc~o_rWQbjKB*Ony6CPSI zfRIV!h%f*d8FEsGawr(fE&sl1z%&j&md1H#id9dm2{fvfQ1s-sOBM?r87RgvLTE;2T;35U{_#$cu{I&p(+JWh^58m5b0zT#}+8S`Lw zF;yOM5vRWf73;$ciBJWeE$0__GO5i>NnyOGVnafu>SyTqIC6`<>-|2EFxc%4WPP1z zD%y2frlaOU-Z4_SigQg!>ZYEk$6sfSlJX_zwReVxr$ko=j4SCJwL_6R61WEiQlTP1FU zs__D$oVreWkWwO|HJ2vaW~kp|F69UXQq2vSR-3k{K#3P>gc6CimfAaQn^YiF>y<(= zRGV`y&Cczr5GqaDfdr~;g+J2IzI94$nxO>CoTS$gm%nusR&7!JR8Eqb7OTE>a_Tmb zsw3j*3c(hqmoG{wFLf1TXamAzgz5-I_QuqoQXepH(4*nxr?R!^gfxh_EReL3^}<5{ zZV?%YDG%ve^W^+6{cM#y2PHu5xgm-*A`1wG<^T$hx3aVt&r4mZMi84uqxkI=GRp?U zTV!hUSl*A7&mM% zlPDjV+_bz+_pBn~NPmfB=vLaPS`1+kaTVo9sOZ@0Lj2COxkrqA!2ABSHlF~rWF*Vu zubdgC>5qHg7oKmvM33^ss&>WU3c+|fZz(_|3Ju+4A`x9Ed@-E*J_u(jmtS6q5Pa7dCT7m6L=}OIw$q zI6QZ+t@cU2GdHSG%OE~wA6Rne*|`W2#UUXnnsZ5@CkampiTmJ+so9M2i6NP=S{PBso;k`CD z-MFs4#8{HcSGn0$*Tw(MxOl{TcchB8)67l|dewCFvn-LfzMI}LRZjIW-Q>bP^_W~} z$>m#|XwvSpmgZl!&BhoYIl5g{_&e;qE1><*Y4KQ`&!^6ufT6e^{vZf|pK7p0ZcKG9S75v|AQR*c5laeH^!Z-Oa za{T)F+#dCM?wth_j}vojHEroK8ai)?d<)G!?r;<3i~XyPGp_Ez*CwL>jr3?1k@Tc4 zF|rb+3OA{9H1V9Zs*B#A+q61ex8_Jk#OWv|4~pF=-c@(}aCk09dK7|JXN;VVnhMf# zi|D8@tDP-8xW&ZA!j@Sx+M9A5?*RLvTnlgQ$b&-aRbLYT%Wu7<=UelWv!)svWsD+pLyElIrDJ|tm`X7%DGjeJ&J&yhvuI=^Gp`%u$t92@4bo!BBRMcJ`sMnUW z6B)qhNLLw(-h+g8XCfQFYhv-rj=41%A>F7eRA{JRydL-|?dq6t1wx%jvhBewJ2m9i zx%dS;yxNxT&QBn4KJa2GPV3u$H8s`le3ej!?6j3QH%41K!Mc>%mcFcIsl=|jOa>0U z$*8@fO6ZMTg#yHmQZ8gZg_fcevK>Gf*aMrYbPTlyqzrYF&QOTZLZ}RdE2(WD^(|ZU zEo&l`i){rhLpfmAmmstgBtz+B^y4>W;InLs62wLfWguM*?YCApq%zcRY^K5)=w{F& zls$ICFt83O#=@j)2d;t#;>k+KGq0Z}-W-KGR|>{oxv1#zA5up)o*8%kpDQIB46XTT zNdq-m^n%J)w^J|0q)Sr56-DGXPT;Y8sVglQDRI+BRKamj*l4>p4K}Y;k@wuBR%>qE z4nJNrLPWi^I<;GqJUfQ-wA8NDDoknZRD<{9$Ez1_o+I#>5E4sDFP|$4SE&@GH*Ykh zp%-_bacmCx&)hthm_(d8_^dT6xG=LjN<}=8=@8lkynGH*5~vEfuvL)5Qi%#Hb1jE+ z%b#6e05Z-_+RB0lb>MlH>FS2c<6^lZb(A>%yf{kkqBVH>Nk(}v#&jFv}$*ss~z|!RIuiR#CtXFUgHr88MR#$wdB;8OA70e)UwBSOBmtrDVwlA zYKFk0h6(Cc5R;s(WMu>uQc|r z#&4w+*5LgCZv_4_)N-tgQSl*XLhA{7v=ZeoGpoRWaQ0LXaRd`26P@2-=x~cRh z!0}P7SShBcK!)E{?BbSZiJc*8lG{XZf$ovk0G@}hkfZ}n8J;aO|NoeK3#cl)yI;9b$Q#z!(yQRCOLAtx^&V}y1-+jLQop0Pb?iu5Zv0VJ; zujYTw^{i)wi^b?qnxI8zzGWevFL`2NmM1;XDozPem+(*Weu_iyk&!34A-}mm%6pQu ztto4oVk519`c*lHxz*VLR(vyyFu$3F^&U0f{`9CJz&`V$U z+`F7u_?bI+U#>3DHDBN3%F0lF7#Jqf+noFryHe946scKq`VRlIU)KgL8=tE`X>g#s zeqw&f=uYQ*eJ@o9#A4RLi{1r=6&V`eQbl`%`M4htQ-W4wDbyQ&*z9sK_f-8F?a5rMoc5KQzAS3<%#XsvlyRjPg;UgMSydZ!8^?;HXO|VY zIox?lvpv0?uc$L`+V*GLV9pPs_Erz4Ix$BQRfx2__H+vlNPbM9)elo*RwNMXx>O^2 zqncTKb6;ika`Vw=>7hcjcX>83FxWG*MO)p7$1~L;fIp14@-g2QhIqyIlbMNw2? zZ>ei8SywV>!i>|Io<Lp|HzB*-kuhDAC0t7)JcDxs|piIKfxp+ zQw|~X=TmLmGDK$8A9DxKO1wN3WR9MFHx3|J{a#(=XZRAQkU74y_da7z$~{x4%I4H| zMa}Q&=Mr9yju4|1ecij$gPra5BKP~2tJRzI)8k3{Cgo1PWaZ8#m&;Q7yP3<2%jU-2L>&*B2l#G2*!lfBJH=X=;z5hslVKFc!h zSN7`%8tzVZ_)b@&jMwN`ma}<&NO&FV>$9WFf|(``F^*1d1(UV|WA~d}qtv&cE zyTi|Z2oPl>>S4rHGnz&gzARPJ#OcqRFm*2bi&{5?*arnZfMeqs+2ic6=g7uzWS<=R z;Hf+gEcTfN(%;zl(xUD$(&~yXd?4Yv>X4WkW>@SBZY;63I|+Ku;`A+yg?mj%s-geP z_jzTy#nz?l8zk>9RJ2}G zKzJOcjCTDQ57uMAn4jB0xbTQ9y1=y`qu5$mr4b8*Qw_y`M9Wp?x#;L?Rx6f4CnFD}ksKM6O!DYzs>k<%aOig}g9eq@0)KyVp@d<^>{ z9fP$RNme}YliYYQ1?zf*i=^=&b;f6jK3dXu6*a=%)a*_E?UDnGI*y~<$06y@>ev+q zr-CTv4eX=6+srTz6XsOWf)9A>>f|~41|*k?2QQJ=#C~cAd%prdbc4O6*8CUrN496# zo)1pBW;!MBW7du0m#9i{>z~Du*_C|>-m2>#X8&0Cg>G$u+nUU!CxSf9+Urz83O`7e z)vEjy!SB66gWU5h`KGOWr6ch2TqEa;?vB#jsYD}B2e^7ua4JFgy~l|{v(lj<+`Y~c zTul{gEa{d1qT%<=F4tK4o~tcsT&Q&PDyKn%8b)5Hf%KQWYLP#~>IALMVfZ#iNxe}+ zDPpI_F0Vf!Z-{s2J?jWu50tUX_xNH4IwJA2q_HqkzHN#(S@z~hpUt(d<^iY z>6!PSEt`vS*WSvDp``vC#aB3;w6ZL-Wz&Iwdp}4wu;@$N%oL8QLxV1a6D=INuWyVO=semUGfAK5Va*Mp7`hrmp z`uv*sqT1q~@zb}<3AnG-FU3s{~=WgSYxN#MfGGk7nAkLOI zu|hquSJ5|kSxBT;ZRBp^O|)0uGw?x;PtR)fZUXM(tWi{AN%hc0`RHb0@tS!iSAm3z zL}TQHJ2Bi-{t>yOC}jp}22!4!p}^rXL7t5TaSX;mpUMHpfpSEO26%Xd<26AWGx;NRBIEZU zzQ`Asv7n$rb;!Ow+?3-wk{pEEXNB^tJF&r}BGk-0)IX7|V^R4f2%Wc5&5V50mdwG} znb`d$qB(N-Lf$~4R0%6ZL+r+tn%^UZs8x=jh@1-bLJ{(~3_1r7%3^;W%s;eNAwV}m ze`rOdj_Vant#N@zz2N-wki8+3m>6v$DwOCNs3MhkD$aGgkuUwbGXG~K_m66(&3@uV zLFT~Kce6OI?Fhy92CgG^Ilz{eQ^srLTt0C1WADlNpttgKXl+IZ%Dy6G4+2&)UvNI7 zHXy5-@jBs|aQsD8%M&dDH#|d5Rco)C`UW+vN?gWfzeB)-SjZwGWdqL72a4Z+o|1p~ z*;7OqPt*n}8V@r35@@25kYLN7J)3Z%qz`7!R_)X`S}9E1p?WWBm>LXMIiC{#;&lwm zJ6N3#cP?AQlty6B9pC%uyj`5S7R4iRo$pp3M`RR=JZ?udKAmauzMd0bPq1IzRod5> zORu65YbR*jH?B^nB6a$ya)Ftwvu;J|THyz?>`FmJ6R!1nP}R^X;^pp!j!*kGvMb^l z?*)uMSnURe@bZvZ?c0q7D+o$exb8OoBq_c!%d}GM@)PJZOBF)3n?ggM6F9CjRpUN# z{sDzK6SL12b+xUs9&}{aWh3mp%~H;7k7DSLN~oKY_#s zv46jGN|A@$h}uS`yNOZ_dR;SO&z*Ydrv`psSlL&6TRMX8NpHHa$;VV2?BJ9z^=48U zYIb?}^TR{YFcj_C#gDC8EPR+6=W3G-rU<#yNds8yLn3i#+C3%8pON6{;xa*Z4`6D1 zWx;JCUWO6qYGFXY!3ovt$-<-@&^3xc<=AVXl!OW4;^yRjE&8z>2{{J?D>B+EfU-P? zU?$A#!<%JOLgx+7uoKO-wVdNbe?fPFrBl`|tJS|-!?n()9@L~S`^^?FW+kmj)FRHV; z)>l?&J?Dd))5b6MIa#tvHYydzWJ=xe^_e|;KExZQuj4%zAz1i9CnBElLc?S?`BSM@ zxKca2*o&xvIwyoYmU|`M2n-D&D(=2Y_!%^*EICt=xTM)xadHyd(e^f9DtS$op~*VO zw@tQXa;;661{s7kJh;_!WK}3n%+I@au^v}BublOI%xmN}}>sdACCviyTM&^-f6 z&8*8VVy?e=H+R;&v<|0QJ!(eEj{R{}-fx4Qf;s!t9MWuI&n{(MyvK|}&77Y7an{P2 z7qzfGSHj`6tvuI9;5s#bkKj)8}_@mKUz==m>uDKOJEd^OMZR!gj_ zZJjb}-C%U>$j>gRhMun#9ln@B-|Dn4&Zb_yAY@hTJ=kSdpSSk4NIpG^W_Gzoimggm znlWgrUqxErWnOz_aB-&0WbwMKYB08j-S?BMJ(2zLact5qPktLDFma~|L)E(wvBy?ZltNI@aw)BmN@!5I*a)<~TY(Bt6vM4>o!Pf9vl49e1+-Aa1-`!!L z<$&zVK6QbFRMY|qB<;7=KiIJazD=ty&aEnf#_z!f1VNfUg@CZPw*c0)7Pw*`}2rZgi;j4LQascAp~YA z^jWj9U_Vcm@ZXFOVX;aV+Rw+})OntOSputws0`(-1x~t2qolw<@>&}upKWYbRpm#& z&tPbS{<2Da`bEb#2jt=J*DGhJb9>3`-Al{u^u3Mk?^qW?#W&~HxS56Q?%x|Vl30@o zw-(v!8zwqEEgcF!B-Gh@u_@u){c|#K4X-rrH0RRyCE{yy6j^aU)`gHkvh%r+lY5RA z1c`;0zDQoK#*HM);tO#W{?%Ohmlq%U1SU#O|!aJ_GPFO&uUsjua40De$ic1{z;|>fCu0@kv3Ir8uGGRZMp{Se*hmr z@p=B6L)n9DQWrd_ppLOqM5CYr6GWm4$$NShaV^lGf&(CBv1Z_bTqOS&xz4#jvpO<> zkN^$l^g;9Vmw>bprT%62Ky7_hqNcp8v{!(_t~OotlhL5@-a-aXUX4M_8R3V5pu06< z`!2{0URQqJY}`^(51RvS$1+K0a4g{W{=SLTr@_y~5AzSV{>}*a3DbG>a6~^;yLtL86x-Wdk@us>@O0 zfY#mRA+!Jz$`8?o6#X;5Q6X+$lA(l$_NjT|Q0eWqkAdHWIra}WBl;O<9qQ$^oKLH- zpF2UPEqh!Ld?SY(_UCT!ay$WbOe=?|kR2UB`zrTAP#GxF}M>I1Z}Bm7oQ@Ht7o3UiCuZe$IAOlC{kxG4=vXIE>^3X2kz#nX#5 zlCYkF!1Eigr}?^VQlD(V*aNhm=;rFCeN3%MCxik$9He8L7X8TwsE=bU|C`+ z;797N=$Ej^rU6WTo5&MJjFU`#CgW)LZT%&t3c5g=BOqLnME*V7_ zo>YhTs!N6)c4iu-wMq_w@0aQ?35v#k+BhRZ?`SL9h_mv99E3T=n!D`KLAGj#9JcRe zCAzP6<0~KSSPMyQ?6sMHhvK_pqua7N;tJ73rhbGWukBDWDdy1YfBK1Wnqg{PN&2-^ zxif&FCv!A6wUfzpS|~)Jm0_nLZlgqEmtluH{`b$iho7kWFRgq!cG;d**4AQWtnr=TsHS5!FxQ*@J{LfRNbNC@ZK7_(VJ^;%yYXwNN{x%?ZwC*bo?3W ziwWtd1(t+dtNSSK?(^daXV)@&Ui;6MZn~Q76EV$6#xpkyJ2MelzFyldR;b{2kj_7? zy+&9`cB^<144c%pITHuNTs!^zXAx&mgf*Y9ssrKLelYkT`6>KkgCMWa;C>(b9QO&Q z`+2{!{pl8$2?iTcsJQ#pZJo3Evb*-c`;V)lZIJ)>ToiNtbyLplcVF?`&E9TanTUrg zz$-l?dB5eg#$wXG%URP*5?2K;xxw9p-%vYAlSvj9Dz+J(J<5rQ-QXh3B%RL(%f0Mh zVm>mTN6-5-!cE24pHJ(z7~JMYRuLIOd(#i$t7*Pv3F$&E__j_WKR-i z%^uQi#?w$Wl-m=_qj3>h``lq$RrJjCsm0ygVRzWYmAgtx;oQ}`Im11VWpWW;fojC3 zl;-u3D~DB_L*gXQaD#5olJAF%-x3m)47x9C-tQ7kZyT5}GBIo&2E1~dJ;l0R*&e0K zu*^H@i@WzJ%xFw=jPvE-b0-SEzi2iN7BhleB(F+QHQ%@fZ`zyf)($2ZNRQ*_T*2uk zxm};R?A2T_BcE6a<{Cb>%;}+4GxLu6g_ft8H<9!M(S^ut?Dc(b-xmwdoYPTh#iQ++ zDR;xNy>D_=+dU5N?4CH@1=aZF=Ck>i$Z1XMDun2GXy~}Obu;< z>FKa0a!6Y5%{^D}EqFG(v4>Z#_5y!F=UoD4G#iYda6akyTTkL21hjJnBE3|0<=n2j3d;(78Kf8Lt08fnb!8NNd?#q;9zfa349G_gcyYQ*$w>R<`PKoPqyu_(-QMO zll&`sp}Y;%>@kWj6`1H*YCN;Im)p!!!SV>_zuWFEF9cM7Bz7)A<(-C3Xya8j=E2Nf zjT9O(iUv}RrIfU*wOyqZ2qELz_p#;|%^|UVRar%=D>aUiltbRN`l8-i(L-TZGforp z9d~*et*+1{N^%D`Ux7}XwY-zUu4IxX=BJNxo?5uEVTj}oLa_o}NnV9w4f*&GVa!i` z?L0M|7|Q}{@!V7%x)PIi#hM?5+bXN!@`BE4I#{6v)?d_jKz@$zS@n-X8hTV774FAM z1|HpEB}Q`!kNx=6a_0%}-ez(>b&r%K@Z)=w9o%M-khgqr-M__g!&bogl-95Mn5(~+ zBq=9v>V0jNs&@~vD0fii@mMZ#KC~i?c6$*G9Idkg|A&@5gjNZ41yseAT+iYoMGS9@ zO6FVA4&^HkcHy5V?K|Ogic1M>f)|#vPer8>EcnIta2HERfBqE`)$zn3UyH3-SHJub zA#EY@!G~_M&z%TXkGU0-q>ti`fB4Sm)AVG1t25PBlJtP zE5Yw@m?9=b%|Z%u#GCsFd-Gl^eDOH9D3+j8Tz#?}SldGLZH>p>Ye;5zAD;eDlyogI z6DH=5%#raaqzQ#CIx|n!PS)F>JQF_?pWyLq7hGL;^gjr<`-}OT_|eJ5+`W*~MRM3T zS%+0;4_$o+58YJ<54HwhlB(#^je&l7M-EEFm$r#+9<^-1>!U$pHxpGr(DrkHQ~LPG7eSSVRvSo_BsyxP|^j)!4IyoqmNgAnU@_ z$|$1$E3yf;sWc_GVkr>qKOdaon96qha;0#>i*0xoUdvFWeZv!oS=!+Nw$f-5M8hJd)`gL>3JY0o3gY zph5^l;~>I7OIH`j_CL)GiC443GW!or{cUDQ->E8ASF^L}ffIbMz#<0`z#=1{z`7Hf z!MZ6R5FCJ>Lm-!CX0Wg+_41Pc&6@uiUs`9V`|sQFPwHuB zpDe+be&$s6LR(2m}k3Vcd*-uE1Dsa&cpV`VNPml#s>(ag7c zf+<`+%P7JV5l1St!oulC9Xt|H{!h^C*cyT4#b3b0`-Upd8wIt8X6dnaslfcls{K z|8E=pvmE&f?^Pby1z*i;h7B-f&JdV#ITcK~E(G=j(m7o%(eeWW#ayo%uERCL(5> zV7`gBzRUE?5la`$eR>>sYfJzte(T#tk+?UherrIHST@sg$WGpEdD9}sgzruej?|g# zN#1s7PXwSaQ2-5xA^CacUhAvf6Pm2=*je6;7&GBFrN$w37Nt|R9oA(5VVV(u6d+J2 zWm{@?_I1uw{GeNSwNHwemjGkf6CVLmWCUR$Tyz9~7AkZUBN;0EkrWx0@BFD+8&4Ey zF~NWe48(xiBlL;SFJfc_AAVf)08gNX2I?oZ{No57VDJbG{u)UszRcp+UY7Q1%}jpc zgUpAF5buhM&UWRUylg&vTqav`YmlCX)+Hh=8yXaFMU01$A;3nH>uV~Hjyjc{O%X0@ zqA$!wL-Q2?cmUukm6i3>OHae?77^AC4+_Agz{6OTU@|VS2Een3pa3UI5FrI35`cpn zI9!3_iGF$-Dd*IE_g2Kzr9w%4gPTHOpj~pao!6U!QDi6|DRww{#yMh{QX8)~t|Q1$ z?P35R1i;5~uk3MjP`m+5#Sk)720uI8*rPe(;!S(6=BEqDP&1C~a65Cm#Kw5Gpy&Y% z3}D=5kfGvD0Pr0EW_Di9gj2|#nhde@^z*yy?aTJZQ)!`ORqLz5F1?FVH6IcOtL$IJ zub@m7-?Z|xy=-y_Mee01)@wTogaeR(0Dxj45ETSM=q^5`e+j7&0SP4t$Sw%U0)dbL zM5+Pp z9?-VO0BtjVab89GjIShDZ?pNB4xorXHM1#vdt6D~4`N)`KAQ!w0Cx^>TlYVzQ{g&- z=|8Mn?+uKDDcp6bcu8llKBF)L`$pM6d$1H$HcFo)4YOB32qxOczm^v9*|;Jmsd4_x zA6po7b|EE!)4+miArTuV9=N0OkN#0ze;d6hxo|dcGjSRFLLo4#i|?CN z*XHZ`q}WBD$vqEiML}T)3S3BG3JNC?Q0RbST3EFB3L{X6K_g2HdU^Z{C?Y@+9;!UPl;zQJ0j+X!E@>f=J;I!xd|VGW9H7*I$+kjJ1P4TbYPT5KP8amQG^JhCov zni0pc5#i?_!hwl;V}Ks{SE6k3xxGkB<^m2(ovQ)5=`jGBszh?kc0iF17{z%U7-t8- z%mcs#0CsaYFxNH!7%Gr8=K2JRZopsxhH@5!SOB0701I{^Eg~~GFkCwkGpF&^O`W+` zl@02>LH2$#`z%yD6-F{YEk{#|w=?;*x23#V@8X~MNO2$|a9QD^S1y~&RPek;M!@@o zi*C2hLS;G()LB5S49DF8*N))icnY$2fO;ON zJG1z$(lvMNFTr19scK&}cGbXK&pSG@cH@mHQd2Fg;1l;<_Dx3Wl;Xn)#&c)FXTR6u z!2GM*@+DOG(g!&5wi4_OBqe${FhBon4OR1VEXxCkPy4U-BL?D0_U@p6Cq)04V^(ju`SLUFa|4780eS zDIFb4dAr;6!ovN!B`8oLRwZyhHhcuY5&*UUK=GE4ayyp$Ehe*LY`!7Lnpn{;t#qs^ zGJB`AZ88FxqnpoxK*jOrXb8BV>2}BEGVvKm z9^W1)BVH|)5uUUeNNxBH)()X0SELfTRW$0|U%u$=U~M?g8^0nok{X1Kw@n2N3xI~b zK*KPu#mcZ(T4hg8T0Y*cd#M)?Oil5Y*=^ZsYRq$)PPhQcIat#+Sku69%g3N~ul}n6 zu;@e-w(VN(9VaOOI6;5}0C0d%OW;@ljym8l2af(qvx>}^!WpoJI6QK4E-xXBSlBPE^eCk& zv`4r6gycPS++y-Jj-gb)j)-NeR{7K9CB5<$3;@st0IyYkMS9!I9by!;C`Cf@fIM!o zvG;&W1srPz{{%t?07L-b2Y^Swz0vI@lo$c~WrPw1ZTu}EIbv*JTp|t{%v(%Qz7)e` zP!4^mRZ6VftjAyax!Y6kQ3Omk6eVIf%v&_QhJOeClSAAyAM0-spf}}K$LN1V{L4Y5 z^$xeGai>s+F!65x-u8B8yXZV)csYGENsv2|<7svFCw$91eUdy@P&(jS%ARp7rkz^Z@mwE$?3 zcuYq_1prx)mI2aafH@bKjaEPRA`0zK?+JxftE~79N{YH&)CaHlg>Y_vBjPP$xLi86 zjsOJ@C^ct5-=^CH1i>BwA@edt?diQS*JYyb?Xm-TT<2Fg{ z%gf24K%gdtq{V{b2vTH#qBRZ_rI$-e+md$mmLNi%K55Q&>XcNL?5aa6aRbk*BFzG6 zBCwJ112X{TAOQH-rSWZdA@;y&3+{-YXhZNxP>ae4`;%?)1?+rkSKWhUIZ(WE)h%uW z4DKj9cr!u&94U*lXflqM+t_~Ca;+t9GzND29gy(=*&ReS1_ERj!21x91Z+tacW5lK ze&AmE`yyylvS@* z2Wv-Al36prkuDCT;Xq0Tj&#Ab<;iVPJ{OHVaJQcWcZs-RaOy|{fxX8|Pn+hGxay2;i!ET+D{kU>oqh*96bW`n3G9#= z1jqnDEC39yeq>L^fx-eX{hN5;-Hxj-UjUf|Fn538-{B#Omzo*AjduPGpH4uT9zf50P96zo)g|tz&KvswZk2M_O z&LY^|ejPGX3ZtlxhB(@bWn@+~Q58?`_M!&Yy~6d(T%9qdOopgEIm3pHW22DMkmAEW z?b_*nfU*@eYxQ`txkgOPYOPulZCit5ZgoOa1dgoRwM$*GF z!?Rqqp2eAXVH-EQn_J1-xgWpAb?ju#8^fL*OOf11-d86!ed}I(J43K`%*XRZqdi@z z7TLK?=yD3bzL#9DVm>jEBO`L(26JAFO^yZQD!D&$lQ>z*Z<9F4hBs1zGFg!-$Xg{f zp_|njN~tLB@`^i0Bbk1ky}etaj(=4kMvy*P@zAR#fT+*ky@S|5`q|13wP*d!Qs-pU z=_~OAzvQ1c>`cjwT{vC|x1WjI?RZqp<*V|eM=a@kdWB81+S5a<*90*Z==kuXwyKrQ z)>1byPnBZt_&@eeRs~L7RgLtK^l7fIma4fsGsXP6Q(p7EKjsUFpK`KOH`m83?ANY{ zPJMQ?jcMc}e&WR$9~1v;cxU`$MfF?{eYqRI@4)LYaSx~4ItH9ZjeL!6<>X$Rp98CW zbWskrOv_(J;s|WfZkz6J-OUk1+*vFb)!m5bp~T_qe7QAUl&0S8my34r;=ti?lbUb#(iMx$g4qzyfP#%DQgY?Eak+mcG@=YE&rHaIfFSx**aKiSH$9x{JRR z?+6xum|$bCTa{*JrvO>gGLVj7p6Pp$vJqMHz%*OsPG=!NZwa<|bgk!|0Q#EXvlN zf*2{c@gj4G#U$~J+J`rTLF{d+(F7NP48mgx?buj>(R}JUlx89wG3u{q?+xQ@r9~rK z{pGM99Ld4dK8zU*;t&U4q71@w3GKL80o}=1IfVCOOA$7Vd)DtlHYnFei`6PD;J)`H zmafS*kjR;wx^0x7_pa2lvnzgz<|Z~M5g54Dq+D<4E{`i)dGtCE!Gghp<9GrE zN|$ne=9838GDJ2b_%B*uG57!Y7*R~JW zN)OksA=mSG1j7-h(`ujev3Sa2;xQxD2fA5J=-(Flb)P0im|$wfCVc0I>U&-D5yQ6| znV}~2lXbrwQbYucSitKSllh$tHP0y7?cNnCM`~M#Kl#G6z7iLOL&@H(fyLfgUZ zz*2m2w~hlm^k61zVjDYONc#aATq_EfpM@J{;1UI@Hxc+!_#1r8Hc4VQzCHZLOPrU! zF>g@aMnJ@|5)!=!@lE-si#3BHYz-*>i*&35=!;&X7mWlXM)NH(0vd~|By-DEu?`18 zs9zWM37gvcyo$WEZurkHUS$%xU_mdV)OA`go-YOxW4n*>xCM5@ES>wVd-Y+?6}uU>>71-gq2_Bu#V?USgWnB{hYg$I{mZCTCH(C8b@6zfE(b zY$bP!72;$3vbG5q5o$^9jTT{;6v6Q25hdeWK2Imo-8Rj z265{84IlKZy-VZxpq=f)vs8Qra)90b9?nQ{swsQG~wZ4 zt7S-ltqj{S;qk>*s|QxkOL6-%f3dwW>P{jq^eQY}0rr!Y`J4wNk_hG(c4=>|Z8P!D zD!8*(o~3vp7;S&*qr8{cWbdA?2g>m(OdzA`O*rMNVxo&K>@*U)o)~9d!{tY7?@hVt zzKnM$qK`ipGHELdUnu?FB3*Q3*OuBez)Xwn~KL(wJ{f6>75>W%2Q+TXQ!m=kbmT zNrUG4p_ydK1BtyaW;qA3n4ZsT^eT;NXHIx&=RHZ>F=!Xy)eC-pYpqZpW|6z9yC$l{ z1k>eGs7dSo#ij%;R^6Y5zMIPw<=MN>txe&MS7l{o>T~EJHhFMU2J5>9c09Y9orY`T zA?xR4p21z5ok#4U@3E&bq)S^KYSwEDjsGTsti zMKRS3D)o#VN_^uzq1AUHDvAu@V_vk&=%U$eYm_^Io^6Y&3gP2kbI9O6h^m_3Y*2HY zQKxpJwK&3GPaUK_w_Y`~&$uY4@Ahf{lg#!;Rn0~Hsyd>Sb|SipvZhy>w^IsO=uzE2 z@hGa_gs<)ln6Oxtnul@R_|yZ5>VJr`9sjJFq8$f8ZxJ*Rb)St~) zc)g0^)X#fOx^Snh3gzT@^F01uWQ~~&?}9q^ByxZwqioq&;^;X>XxOPP`bP;f_dA6) z1?d7RNk3A{OVYSfm$`MBkogQMXSW`D+U=@dw z!>h@hs2@kpq!fQ+tUEatciz-8Mh-7#_A5^1IFlnbj{H%Ml=^#lN0zv5vR3-CXZ);taIa}Q z<7vC;LX`RtPyI>|Ezn?AR>;QjnkF5TTr#~SE_+rDW}0($epk5S)S-9ng_2P$W#E(cGi z!28Y!Z+@~JC2KZDZPxnZ@l4##X{hy|GdncakC~Omb@JAzH|3}~8z*!p5Ko$F$zk1y zXE@z)H{BdKzbqxub98*omu&Jl7bfRMJ-N`JXt{B1m%s3QP=F)ocy*g}@AWJpyj`A} zrX-HH<~M4>ZVmHNjAc2yXC_j`h3F%)wAYqNg=a_HO)3TSoGZ#xDJNyE7m)^{V+OX9 z{^q5QbqN-M!Zj|h;(aI7Ukq*)M$o-^5i}{0Rj#5*pD4qn&YT#ks>u$ixYR>u_PQ@* z+ngG{;j(kdE2webWsSN!4WTHU4Ys?_W?d^t-K*dzt%`CBk!kebe>%L8yH~GIGz;iACW%MyHUBnUA8qx{{U$3SM)(qC%2kD8 zk-Z&u=od=+@P1&_PGt>djZDu(WQ@<-%;ePid7p2uFzu5=u4DGk@Yd4P7w#nWEtXy= zI3C^(uD(;_4u8c%ZzDYt^i!T>z%AO9PifoMvG9xH(4FR>`9w+NxV2>@EDmk|AN`lclF8 z0wc4V)73Awhk2WyUS{1s=5r*uHzT^VAnf7^DH~2NOYNF6XcHRX#q*y%=fHF2#0yAp zWqZ4_Q|8h2IHZg*8QNHz=Mis0m z-ty!kpE~da2U546W`)(xHhpoxSjbw#>UE2ZUwFBORd#BjBS61z-t!B^ zJ#^uIZ)8)t^0GQ zai5#e_?Ogsny{T%ScCKZ-A;ZJ=XyN+-p_?Na!9#jG)tWe`0DLt)#lXmm9U8BabyTn zBep`QZci^(E_-#`?!}fiMK3>YhcV*= zf7lRJWWwV`@w}GjgxqGV4hUX@8nKguQ-S*ylSO&Vbw3vd_Gpy)rUKn*S4*L;r;KGC zS#BrGu$CGgS>79+VdftNE9e`eqB=4M^pB@K-)DaES~s+e2z4c+9$65c@DpWc0=!oO zW0x|(aUy96*Pu;R>RoGD@2RCGu}?7zN%6@R0k_|! zSCkHjgL>O{)ii$OUJ}TC)?}Yz;vDcL3s>F>}lLpVtd3D7;QofptRNJ2Lk=%<= zFVq)>Ic)KK?m)W~?ZyL-x6i@Klx z(t6Anm>1Ui`{PPQ`mWuWzsxV>HNhW&!s8u}*_qt&l?HDT-qbF=ckQ0YexTB`A1J}i z2MX(fine%l0G?*#6}k0Zg$K3H9^^FYxxZp}0e{mbsv9|ZOY-cUJro0qS$DbwxMQ-CX=m%M4 zT#3siw}?OQ%Ggi(l+{o{a~I6(Td*a0XYG8-YO1W+_Q&z_k3;phL;H`z^q-E0>5BhM zSDE`TUAp2ag@IjBqsXgmld<0cL4T%{{S#pPJ3!=5zuA8RD*hSp(C=(+qxYqTYmn;1 zWc43K)o;b}pZ5tCKYfY+F&h0g zQvS;b*~hr@-?NT_g^`_anM{{9X8uu>|L!a9&(eY7q4ViK@qhX<`V(*VJN^XT=Cs7o z;pNvgUT2h_+sxwp|sZ#bq29gZ%Abp#m*H;9k;rw$1lKx0q{%2Ll;?{7!bB3qn>jqCgX~d0;Ds*$^N@aFjj>yBcV~d?4iEXxIQl zuzwH2zh}-+4S^xsAK~9KD`iu_(DdIX|D9=;UY!NoRBsD} zg3*Rh;SZE7piuAtwcQG#q8_N}2g(*uBoGSm2ZW-~fw)LZAc5Zi#SEcn+aXlN17-X` zH2_K&LP>T&C}CZQtMq|d0+bSjVsC&@Ga3*os0akEOkmw+7(uAOE(oQs2cZN?A#+jV z+-5j$htMllE>GWnNHx`{PI|>2cwjZm;@s0Kaq&YS@I1FY|aN0_aaDM9Q9*i4r< zxV5$^1_TUnJ^v4LZvhtN*0v4L&`K#HAdS71lI{T!3=pvBl-X=kWx)KucKwkf1TS+jvLBMMxh$z_u6h))juqe{!96~zeuQ@~2 z{M}`be1o5R3M%Ys{tlcX9#VX&g-muIxx46l;aoiU^O}x9KwE`iNrX$@i^J1fjOgVHfZ>d>FuP=n?LDUK!lueMY4S(DI5u2L&VifS1!gQY$3a!C_5G+(d zf!zE*oENGP_APJtM3Ko??r}EY-GTpxNy2p!N7;FR3Wn!b)G)}H>=}Qt31YHOoHXuW_@5H9 z8y%zih6F4M5KBA`EBPMRISx?kjha{$KT+A(r3z`8%+KgmPE(39ud z9Ru8g2w;9kDv@Lz+4hbw5#kiqk#tXpp|M;JfEXLUxCs>8v)e%?Cd*_1P=g|^)MqDz zTs@$Da1CK1>`*p&dV0AUCttt#H>LMU>n_3KUJcA0Cy*(WpSSbRiBNiNnny;aBCqqz zYsY8M^!W=1fS-Ao+z7HTF!wX533KUR&auCmdjn z3_i3PfN_2*O7|T!X9+lm62AZb zBurRIk7q{IqYPf~9#lr_+01QcBuHmf7YgFEaA~Gv1X34uC4N#9@G}k z0F@EPsC;M6l@s9<)S19u_wMtWx&GgILdnUm3o9n?&iEA)UB%<0(g zOnChJOxQuoWg*`++E$Kb=mBl6pR}8d_)B?$132*yCA@~squ-)w6>;E3GvjyT}*%SE?u!Ow9Y z$k)jTEE(6yTv@tTm;pZ>#i&$pY?^ zzyRN%ehBaYAjE-(e}V|0!NfTR1FZd1d50X11QX|Hltbk;S|S*jIKTKsQ0_e$5IF5? z4~Ho+0Bd^8M+p)C{NgW70V`CJmpcsHh!ira35T3jht(oL-(L>@kw;+-M*4u836DR(IDJpTY|Q_x83G0nApseV z!ZtMEwXT2Fw#@Z6q?4dGE!J1j8gN<12e8~Yp#GBr5V-{V0_MXoq)w<2EF6mL|7#TF zVD~ksnAzd(lrYWwj+4kni^vmCUB&%=eKCXx;$#H)Hh%{41WN(MBtryT0d)GF69%KW z@GE=p9M0y$!+kEMlQmb-&0?|vvc>w6r-<9qm#*DA8F=EXZS|egSq_18de5DfyrOHa z_}cq?U8;)c8Y*vpby4fLqlK~++gci4G+`^=UaLu8bm?GBeDGQc=bJDGsb31iN)p&& z%L88}*!cA$Fm_ab5(%tvQ{pvj!d)NrUud0!*RHqxTp-u!V3~rE0O8l7K?#=I27F*` z|G7X;vIR)8!=;L0wLFwZV10{!1Yx3OGy9)0E(-f;=A7W`vnER7h1Yt-x##Iq5-+x- zNW#S8%N~(K@GG!dcc2rcM1-9BrGQPHgK3)c9)X4aS_DVJ4CBhqLI?}0M<&bPz$P4b zwjuRhP!hCe$NBy%sC)jQ^^XzicV-12DqeK)_Q5kmdC+jT_$dFTu z46^Bh8s0Sg!RFamRzs$CU5t1we|%XJ%)!f>inAvw!xbI~L}Or|-Df`Dh8amYzkyHe zc#s`iXn9ZqHC`fy0I4_ufB=lufY3n(Svn;P&`kf-5I_PK1ds&izqMeEz&i;5NpR;U zEwO5X@k7|Zv|hof>`&QXsV4HMV0PMHV7dB&PchMQnf+7`tIUoq3I}NBoO)7D1zRi< z$ko3LhWEiX!EaBmfSc-594c0pqx;YF8;14tud)6{bE{CS_{0s0R|X8JLD)Q`uRG$2>;T{;0N7Ja1YvVSk7Go) zES%w@K%5bBIe?(a1Rk~d0^QE8xHqgVE|89JcBa-{5y6Ubut;YO%#C~5pbH-+tJ)6C zS^ge~A!6~is#DBiu_2LNBt1`*h#@)w@9=;hStJ$tv*Py*W>Hmp4OXZx``N=UoKcF2n4oC>t6Y={;Ko(RFo;-toqx{uLf?rHyE2UHLhMWvWhwXac-9de= zqUvQ4EF&=?S_3K&?bSM{qqXt>UYP$y221$}0Y@T?00Wv6KoYm7RS&bseimeo{gN(u z7UNrremO8EpIy|3&rJ9hS_WIKeS$_iaXOsc5U=LYfV}u@^ z<&M~vLmn1WLKZ3^3w_YzUj15NV?cbURJ1`YHParc2zKE~NW6v(dYX|%I%i<6nNP$+ zKgp=3R?)yGualCT1>WJ~2WVRZ(bhorvkyeu!wR5nAC5Bq+8)SqWxy8YjRC$~5d9uV zG+mJa=pBMcy$ncg07(6#0!Y0Dk$R8x>=H!k9~D4q95i2i;75Q@e^&mv;r|r6el4^y zfISQfk?rRYdyo7tLL^vP+@(;hz!A}yg1oqsF9Sj;^?J#1C z?z8_LarXBd`2^-9M$M4r*8?|0MtcU7LU27|6N;-9wUNW)myR>H-v#H=>L7=7*uWm| z)zjdaQW;$x)Iou)T0MQ1$Z)lS;@SVxT@!LdOWur=YVh1`y(fT~8dR%~M%Hyns=nRB zUp1|IR65wc@|qe0#LysU*yGL%?3@`&kv#5a99Durp*ob&cpB` zR})&q4=Z2{f1sV^W*GRZ@;`-U{}KzZX-!lBIF-HQ$hz!zjdCM+iT2XTfw|p36b)SS zIyaw%R4+YDo;|_hJ@|WI6%k97VQ!~B@NkZW0k~0Z1Uv_iFLE`Y>3A8MnZMdayfdms#lF!EHS1dTzN5co*(iOn8`;h7(a20fsQFHE0S8*mk|GX>A>*ok(^jQ zodn*uDuBsQ90V9;!*~RcgV+C=>q{^zmQQp2+WF~P#SIGx;>E9>hVS&w3K1Dr+_>>; zCx0g|9W$_V7EG?6JKtI`9tru=iN8CKD;EYmQT)>hf`^1oit|gS>tZ|TY7V5MsnYsd%YwqYzdcEjXxVjHw4jJkqC#N(wAnB|)hz(ri;IbaxJ4`Q-lgopZ! z`J?iKpm9@xSa2G!!1efz0fpSZDu5Cd6o3VKBy_IF!5a3X0w@7e0xW&u{npZH_w+RyD9$mt3W~E!rw1rjK~#SQLhxPoGp|3OGvnWZ5PW};8wAai zpK?S<3jqWq?C%^wXhcUq%Ath)_n=<{jo|Apm6U%$ahN=QlE%NbuumVzBHTQZ9&|<2 zDx&NTqp@8Nw{tRYL(dCahvbOkq6-gOz)qjW54LxYqjg}XPvd_Ly3W8B+Q`9K!6pD4 z3yMEIgIyd>d}0#-jthqsu=BsR1;>ack&9fz;6(7F0*()+EC4E>`qmeb(!VO;gfK`( zK%>j2w)?B{zl9zU2`srLGyPkO@i5s~?tIV{5s!$x&SJlicvG7~Tf=1YQ!KVD9l78s z@;FG|3gqa*7~}xqaYzIyzb!JSR!pt@#I2*)?->|L5ojcb$3vB z!elG^8G!#;fd~%7VYVzUfC(^?hZVqf07xSH1LV&NVEZ8&{KzmFaOS@cO=a)l)#Mz} zSWI1cuA9-=2F-1p%-1k5r`4cn5S-Up5FAp?Bwq&{(^mvb><`=jXfFPJ$Lj%+HML1L zkQnferI`B0fCzM+8YY9zQ=sin|Np(g{D*lmVOc}9t?p>Q9*%z>tIQDebsBp-KB0fC2v|3L>h%kA zz*<6Oaq*5j-SjChFh!dLFLJd{fYa6VsaOi7`|%Ky4>i@U#((tI@g@a-p%W?;OpyXs!Hl^jo)n0`wx?I?t;CxUeO>B z?6pB5)l~9z@nB44p>2~2@X3=5jHxt4$at`ALKHfz0Cs8`gn#a~Ye&it3PM8)B*BoH z8=mIA^FxVli^}E~1c=h@$S2aoV3mz0R3Lr>71)pB{vp*t{f2vQg- zu0RD3ay_32fX702V8Kw~1r;{11|_mU(K8c+4TxK0Yi&35g!1&mpJ86XGy6>*R++#S zg`+h2P9e*|Q_&6JMR^r;tt!e0OwIQZfg7u@u;6}gQh>a23EX*hNkhJsCqqI4uqhWw zIJmwWuX?_kV*(4STT~N3PCaJ3MP^tD@G5D}5ra$Dvp*I5`U24HDHU{k`cqNs{uR2> z1CLDFayB(D~(~aoCkLVkR^NzXM-`(%9;K3q)?1G zL6m*g0(tt3jOj{bx%xpQAcd!(#Qjtt*FjnYBTb;h{ak<)g3P>vgUB($OQq~*iQQTC zQLo@ke5Yz9a^!()-~#!-=ivYU=xYu4=SFwGxkcJ9P$CYNMeWrKngmFTNNf^4+u-2oJ@2+e<5Ij*-tj?~kN?gP$y^X8G9DdGC@;@;8x_Zt0~; z_0pGC?yV!A>x@%J-l}rH_KgaQn@itKMZA5lh$ke3VyPZKE{Yz_>zR|i-kw_?(#w{)^3a7gV^34McA-yn z{PS*hJc&VEc8)rxNOiII`!}Z~gM6$nOMLHo;`R2@%GPN%-c_f^Va#J){cTDxO-M>zBVh+BU1~h{*g-}ihG~*67oa%!p!t7Xq z#BYH^;+{A_nKkR^S!cyX|$SQG&iW!=Z@^ga@195Oyx`rc&op6 zievboTN89Y`@|XWyO}SWT&&(Z;biWXse~HKNZu`T+}Xb|-7qP5_6-ZF{pEc-RvD$x zU7?$x>BKqEr1}PG(t_k3l}$dck}(*w{>r}jYT7AI+3~AWnMzuzNty12`?~qM+4nB- zYVr2ZQ$%t{E+`whX^Gz^Uu6mKXz_~DBtzTeQ-_G+u_C}LR zW!x>gxE6b>_g$^vC6MFxwEH|qrDA+SF5LUbKpKDRgEqbU=@c*~maji5_(ghS8-`*M ztdo3=?`1QvMJ!s5t*<3KxL$Mw*@WQ^Ybq-8Yr>obuX%n=xZ8E5JGmobrTb6;%L4@o zR8Y(>ehXc&yzCVeJI1Dq5-WFfIQOv3(SZjPfyp(#j{BIBR{7P1S`|MTAJ~Z53ZuJ?=E&-c__% zo{W`v4HJ(YyXn41fxS-|2R<^Fb@2P{)o=Cow>NANGzppK zXA4~Pn(WSLXJ48>Ge)^^Qnrfu>N-NeZsp#$I~n64=ab7z?v*l{V`4Tuilg;n+Z5B9 zB`&n_onIWB+rUkGxXO4)`)b&?VfKo&dHa*6t*hK-g-^bbj=J53cR_cD6$BkMsM2y@ z+o=~F->R`yyb$#Dk?Zd8trouPn1n%toEiHI!r?`NP1X~OJDse9;%qwq8~3 z!{gfV`k^~>sxvGq%?9jZJidb_+VTCB__bP&wYpTqM7yZ(CsAKxgj5k)fUPozdM%Qi zy~fNUc?w8O^^=Tx?+;}Plv3|)Tl20wi0aS!{X%$n^Ypue!cXR+zTs9=e@q~Y_Fz`4 zWRdetSC`GxsdMPxu*H9=2?*cHs&(k99!qkT#9U7FA??YjX1S~3DyylLPW|DsWMcM` z!+HH$n;PVx54-?JWVT1zvPJpUcBd?7Vz$~pVehDqohhnv&Dp^JR<--4*_Fr>Xhr`; zPm}EzUoQB5T72RVNF!Wt`KgInB5tfb$ zeeU91Bi~-6WY4zyDBmX;1Aia(F#&Uq1D^1`_7ScL4x)oeo*j;Ae{$u|T;NajbA}(Q zE?=zY?azi$eP^jcb;J2H*=hoqO~O!vH3?+~Dqfd0_e>R4Qwzc~3JUIKeA@Mpk~tO2 zyhF5$+Rm7sp5M4#_A#P%Zq#tkgU!Z4WpK@Kb>1)_yfct|FN#J)DhSiecF=6$MT8ge z_`paf35= zGBOTAYO;N2dTNL(+ZxhJdsIYqtx8xU7)IvV zSXA$KTVGvngN$|&{TL38popo#hUWDtyadKeju0@S%+!?=(W`{!Y> z@BDBW6KHX_;d8ThvUavGHGSmFM|ctBb+@&Njni=+5qtIfxadQCz|~dbllJwOP}9#M zK7L<*I{Gvuu1YFnIzP)oY5L7ad%O=Fr&3EZ{Ov@ud-NOF&Jj)(y0bKheO!CmDq{_Y zzCK4-dw*naMelU|L%@7+xPI^U4DdJKUi46Ob$=ZA7Dn;8z-ZDcAdN)mm@lTtG%i`aO+N` zcvebj@0yPq8JON~+|=f@THPL_DqAC;0Xqjx#Z;ZWDr&Y{?Q8So9`0Ei9y2@@*6(bq zN*lirzhdBnTW%a@4^>5^KQ~~nLBtg|%MO6(5T!S4s# z>uZgd_wbBqQ(?XcFY!_KYTvXuSMSHi%O@hI*87iPH)j`{PxfLxc6{6^e1n5Lv9sHC zO!_FheS8uZ7T@!wSLgCRK0&84Xml%qk1>JPV8wUO2b(j+fp>M^$1YzpexHnx-?6U5 z@At2)VP!{UZ`Wj0s4dp5OFodpd#T062kSe#=w+l2PLU%K?XEA zX%&rX)6?~J_Bm-&-FRxbUd>*$o6_o6@u6?-_f~w=d(+by?9x$V%!aF|*0zlq^JQPw zB*#hib=sb4U7XM1SGy$9N<}5ih(C>9-MxnWb}N0=_?!_{EIw1O#_FSgjTNF#4j<~$ z^Jsat;=9${n3$96cG_MThkmH9ZikB!+YWY0riG~2^W!mET4qMBt+Zoa-Zy>EFYIbC z=hyh^dY5A36esJL9F5O>{P@wdWBJ%M-^LQFi|H@rB$;}e5~ZmYOgiGEFSuMy=+Md$ zvG3LG9A8+bRYV^kG%2d9-zV)U4)y7!9GJ}}IvfYzWn6YJWaCS5FifLe!uUz*HC}L) zjg^TD!lUKEukGx)o)(=Y_P-wDH_Vlupn~_3eSNp85GD7qW>sx31ncSZ(441ZeqlQq zW$5Q4!^w&M!tT$6-9=t3Qcq?gvwYN3EoTl%Xm9>0(Sz}jB)Nj#gx~q7F~@%+IeCj( zLekn#MKFs)nuHRx)8wfWueee?oSP*k@{U&h_MjRi#~kOM`oVbgPT{; ziu^q_nrHwr79oo=4F6=$a57w;n9!q&!RPo0qDRH=E_Qa@@bdPM>qz2kiO z++fI^hxENw@sAB(&!6mg*qZJ8_3kUB(fjgUNt!*R)hx*~nt|meuTArKQnhY%#m2l4 zZ_K!f4#EblHl&M3BxQ>;3_pxkn3kGUPrp5Ow8}L9V!vj_O)rh4!j%4d(!u#SW1Y;3 zYYf^SOd7sEdG)j?I@v96Wl^bDHSp`3qF|TxJMm_BwVsC`F(t2x_II1?i&UIr4ZqBG zYH{Pr2lN?!VWC;m)dIUquU*lXmIp%aJimFFH+U$$d_^s2__rHv&X+121d=k}X=v4F zUp;cw{;k?;QzD-8QTI0{Os?LPw_h=Nd7yKi-ZV-!=;rx1EMie)A0oCTUCJ(^A-UuywB^(~Z{GHm{7EAh_ z8cBK$&d~AjRf@^+@2OKo9J8=s3c4~{m5FCIgZ7QQvPvnwal|H1Fpwug(ksA6j#vJ#e?SjpMT zrx0{>T`Q#e(^xv|>oByMKgznS7A1>~Jrc-Y~g4`pT`Q za~0~S2fXy8MeN)QDHdThew$dtYW!L`{uQgj zA}O_kVCXG_{&1ReSsk0AMr=(fmb)^dQHzt0;V)=2CueQl}WY6vycL7|5f;1bJ zxKYsnW@{SUHAku#77f9$v){dhEh|v++`FQerI$ql=-Qo1O}sN(#Iw)qZ9AkRlFDSr zPR36=-1HzmTcrXlbW5{7G^!q(Q?5SsTHE<;W6Z=BdrO6d9M{(?&&p8&?{>XRXGZ1x z&Bbd&5EBZBxH z=XW)u!i^7`%~EDZ85YYXVa*4wx*>1G#h;@q-+1WHFP_<_L610;qP;R(zTSC1o0a(} zdDWqA6)BHkXQ`XX4x^K%ZP#ru_l|cwhpyC`e=OQ(mP1fz>;SW|dJj7> zT@QBE)=>@xkFi_QIV~7J4CIECkQqbAy{V6vyEc!tHuS2G_cshJm3ApPfjCQ@dI+9{L3+6GtN}Mjuhu z)?0|r%ylyjCpG<5$9x|tc(A|QE$!O0%e)kk7nQDy+ZqQ1e1L9Q@D z@gm(~QRS{km_XesI|&nnY5C-IoW4?=h${cjP0#d|p4k=hJ{jk^n#@5u!5_q_t#pR| z!>0B}=VT4X&pGDjM)RzdzLtu4Pu=;}*}oD>OB?3mC#%`tQ|IZXla z*R;09(=Iff%0tX?*$qR%g~DX;=cNj3ADj)|w{bJh&t z_(c7}aGpp&$ASq9N(&gU6_JM;GdL9AuVUp20d#teVe>FG>W;)Pz#m}Sxcn8L{Eot`qjyR*kykE4g~ zX14lG+%q54_TW7E!I`hOthfA_4>|GIrGU*31vX$X-nUiVpKVkAs1~OaFj3(ak(F}% zc~4p7LT1VR)z7Q(`fHHbv)tbxyzJjq7O!Tu>Qct36g$2xi!}uqz8N>W46_rt8;1!@ z)!P}}@>f6_K@r5TOhHF0lNZMbK4UjJ>+pixuqDU%0QkJ5T3XLuHt zQ@YnFJm-5@2V>5-rN*o7KOG5^{O!>nYs<4kH&Rv#6`zcMO6+PcYT&=3)9>2NW6xdY z=O8%$=*ZKaMU}MiJax%JDhkatGS138p)c?I&T-x?>euEIQ41YxtDn3*am6P4y1TLE zi<<>XvhQ6Nz4t4q>8FdLqqdC)SSj$*)B?Y`9eH|xtw`mIs9H47mt!L2pIMXwl(Bk5 zr(JYc6~=87Wp!R~+0Z-@jUXBHXEWQZ_+9?D)EVonGkNOHc{!M2dE)`9rxx7Q?+Qmm zads)GIT$pHPf2$UDLgE1IrAK|Qouz8H~$-^qLL*gYWX}A?xEDOz@cL)iz>%HESXho zF^s7%vUTiTv9YsQZ|LF-dhLDr&FGRjP0etUsa#;L__4@*d&b{9FV^$A7CaO0v*LB7 z{C3y1Q?vX!!*6@)mnsI!SbfN)-;GCsb=>2Rl%?UDgHuZWZPwR7*AR&tQ=3v_dPK@k@8h$@8Qv07v82ge()~3tF)}o z{9)THZCot})sV82C(-VbtUg*LbQj%vkZ(oG*oX1qVz%TR3^QV9E`qJ5ylk>}O}Kyg zA`WTxG=|NRcRfcvs0YDdELb?W$=_prJ-Qkv(b(EmDuA>qx=8x8UM!@S#oaS!JT~>^ zOcRlbXVfW=JM6M5Rad23Jxj0Do{vH{xPqGM$;^=}nb=7&Pjc$1E_I_$B|Cmk z?gg2*)Hc0Vtvp%`#D==+H*QBsy zF%qh8pyzI6=SLNy5|1e|c#SDP6_c4TjH#Z>@K_{VKVmdE-kn*q;+V!gR$_K_q5E2! zHi2*Aq6%fbfxRPYzi-62n%aC%6Ct|vxKv?@B}>C_cV(bvs?7sabWB8b zmYE= zDOA%vFkau4dZz zSZqiUmJDohFh*E1cY1G|aZep*cXVjpU`cO|ZpRBCa*FyT6nY;dkTthol87=YHbD#sGE+8jQG=|QrwSKMGIuo#WOatBZRdV1Ocm>^!d2I;6p8O%fPS0k;-qGV9l+2H`^Z;2>eJ_-*I z=9x{r`&;t##*~WE3a4aBneetp@SA| z2_yt+j_R9>PQSntZh6~riCOW~eM)3p6oW)0)mlD4?j2YV{rmy-DVl*dW1Rc_VHU~U z2csE;Tx^O;NZy($?i=!CS-#Brc`bM&p(6=Og>&nX?HFJC>o?CRtOUs@aQtGm} zaC1D8elFmBzI_XMN@CjCM7h*gMJX?rQ!H!mh9}$m_n+agoC&|%p_Sj;#<*t{91c!U zAr^eMiSt=#L)<^53C}Q`L`Pl|lE(@v0l;o#PrdvZ{WY!_M_lKsw#1hr-$@DzkQ6t%!Q6jOYHGc7 zgI1JO%$5$LBpo|W@In1oiWO=S&Tz}?gUsV$N3nN` zL&n&=Lt|Jh^Q(kf^L1sT?-n;8lKrz^KQ+@_f19#CP1Lz{hi6&L3~qUQ&?<%&`-Q{H zfdqSK!MlK)@deo%TWgu$$=NOqtFOXxUMQUVB4O%j8EsmIEc{>-@=1}@`_l0cKE@Xy z!4cC$U77j4GMqwP6Pv6ZqSd;x#gVC65tKJhd{y^Vh_*1~?TA*L33UWv@i9IX38yrJ zM^Q47haMf$D2AfCQPT2g9E$d(X@;Iiy8VPPgX~l@smY-|bfHa1(GAkkOFGNrd5Ff= zP@(a1q-)Wm8KN$Sd|?K*lS0`fLdGMkAvS!2qMg?H`{gfHBD0Do6WhOj+g2`&>Vx)y zNXl!&UrB|W^lIJ1?sv51_mXk!IgfCM*z0jJKj2M#xkxlr6@VqH<|4B2S|sYS7nJUT z!a7JhKyglPt4$DM-SP&kRyS*mY5Pp@eW*V&tzBk$-kyK8m9 zLxgpfxn*nZ%g9-}_&Kh`3~LRZGQ4j9`t*rLC3Kc$L7&n|Dkfe77+5j0jp!pu`XUnA zdPt*Pi-$f;6i0tMKXFZK)6t%Z9BBj~2XB!V?${J1!{Gt_GIXY`ZR|`a`i zNw9&%L*N?WlQqY)d@{TtMm{PD~wXipW z3R(_7o5CS9s`+=ymxp2_(jq$8ih3`|*K&5>dfmHXlW8Nfj>M#Rg2nvgh-&N1j5>?t zG5#-wbf&dQeB2_B}qndgpFELaQvCaR;#kME_T8lszQ5~br@{2%BiXT{$JBW*W&z~Tn63Duy zMF|!>L&$Tm;LUwxN7x6`s5;u*sQdlWqAzS%R=yl;9@#ly^YFSE!E-i5h9Z2Mo4CQW zb(9XBrBJI7#ZZvyy(#A)b@TVJf-Kj9L@sLm+}p2OCPYQPQOTHbbx zISQ@(=$&Ou1rpjt=uB;Clc}0~HsgvW7bc+%hO)Fj$BT|IwyoCU1NKZ{Pzzs4SK8dB z^dQ^DO5Y+Pv(|=aX{weEqI*N4zlA>LLAi}hk^ieln}SJ3TA2vi%E%pa#(B;GSKeH- z9=q~MrqS?5o$}=)l}qzn=u0aY%9ukhc=($V)o4KvT=z`l)b4Oy(%Z4B-o+9Yd##Ze znzSY>LsoM?N8MW}Ym?_oa6*6&&ly&v)`wm>HQ$;x<-kf57^R+%V$8Da?O-VDw-2Pt z)$6|Xrk4YJ-ble@YB$fWUzqyf`gJqO_n1+-AY*xEGfTo5i}!1x)%WV9Q(YG+7cj&5 zJ#`}84;%k@(dWquVOnc{<*K>}es~)1lw%-w&M?OETvN2_*rXVV?kmgQPV2Ir8KaA4 zfrUPi5lCAQBPG&1iXofNo0_kwaAA(d)~|?@1a)zQxN4zzY zsc4l?{~M11Gwmg&nm{Sp(5}q_qTbJv#uD65OrotoE=|Rq*lUQ{d zCDJH0MK76x$wa&3RylcXwJ=X#pz-aD(D)8Y;;YgI1jpir2hSet%$>_I=#hXv;+ z>Pxmk3q+!xOHK*xlGb39R=LR!HKXG922&RZgZIpOV1)gujy2)H1Zh$U@)XP_kwtVb z4N&C@cKdJjTWV>8HLQ7lZ0T{j-?WhAd1UJ{mklw7U$;A&T{P$dt#E#_}cOCPP;kD=~XEZA}pNH0@4?`LYQ=a`_PKc zU7hF3=A*8hn>Pxvi5~`W8-in9pjNa`$_q0~^HkEQuG(e+$hpOmA!`GWGyV3E-$I41$cgrRSw zquoItLqo)weYG@c+R!VEPFZPpIHI`|XRy z`@lPpz*YBo9G$1S2;%)@*?Ye<;jGh!JLnETy9OtlqiFH#P@ z1tv{iw}OMc^Cs+eapwytkKyV1!;cp#Yyqye;cU0O#e5v(6~#XE3D%Dfh#cI{x8r&xwUzgFxK7@1gXWo&U1pMXNdnKsX~fqT+STv+az0)~ z_p@8-iZhzM|Ku8Ito_PSkAuDqEAJcoQtU@pg zvEO)agVuBTKKGPFmsNaky%g*Ccs;E~_Qq6GnZ#+xw#&=1gBKpz2&NmXH`0!y?zN}9 zbPbf}acgnBA>BU?KTGqz`)S>W*{-X=A@wUWV(;TM)DbUK+&olSLoTPqD;2B=ps>AP);=LSNe)(ywznv)*mD4lj{+v-xAP z$JsJ0ZcumQxA6Kv{R_vkGj;O8IqgR0<5TpH^2=@Rtd;r=qzr59D4Aw zC_7sy%||VsdE!h1yzn)zg-^-)emR5~i4jL>ZToGt#qFwSQBNI%0)Y^0qMYA8W-PyQ zhGrI5W^>pU9_5@qOIN`hE%K8O+^@w^owRd#BT+f8diiNWE_Y5u+YUu8zUy3gTQwr+ z7N-O<@;oESMc|vmSON;0iqH*AR&EctBCtri`KFXv;=)g0`_CXS3&W8p`xl2`h6Le| zE3>(qyp;%Y*0w$8!Nayi{#pLVl7;6KaUiLKhSBmYjP1I!T(QnfI3(}qxZQ7>)Kj&k zuRv0p&{FPrCmO-ktImdhOjaVG!3AxaSSKhS?FP`O`~Xeno8lk$$w->EH?PJ8{umS> z%Y-55UjVW{^jF#gRQVtegf?F4AsaGiST;?VZCT9Jia6!8*N&ht$4FMXAb&JF6`N#Zkr&$#diNv;P%O|#qx<80C z+&*+~r~muLC0a9cykWh2?CroX%k*Jv}E(VHU*`YDQ4 zbtnppmFEPi5zOamo3aia_nXmk_stF=vCtLA=z<00V)y1mVUze$B_)Q{L2R|%G~i~a zVodG~Mk>&mCa#1QGmm={H(Beb-u@uqROo4Gdw-2fvmMyu#7mwL9-?^mMlPB$&SkjD zj*>`ccTW{BbDcOU-VKGd@txy|6{B%nBRSm&KDoK=AUn+}VIKz1K3JOv%q6t(b5FBs zBObygI`(KCSr=%>3`3J|w8u=yH;JKXcJ!zm9Cy&b$Ek~5o973DoPaxxFh-Or@KK!L zNySBiC)}v9ewEEPf485y2=TH9d`Qv_7(~D{izBoJ%IkQy%{``=g$5+d zJWVumm4%6X=5i;H2D3ot{4D<_Z(;W}*6O`YMIqopIl}(C`LaaSZBItx+S0DQ83*8R zTD)~lYnkIYjIRBI3t&x)8=JfhjSJU`E$llM0wO)nqTwMg;+VK+_s3)fA`DXoQCv)i zFt&?I(AahwW+Nafs}m^NncqE}36^AxE@Tyq4c}L2Z2E`cU=>vWaSKS(y1t05`@Y=4 zM~C^l%?`9JkXIu5J>!08Pj&>p65O<-ND%Auu-?e_TM3PuMmowOt{sBJ2NOUFk2{L} zY0I$ai@5R_O%+qWnSs?5+BMjb9rrZi>48h&u{QCRN=hCEXen0+C_4a-83q%C<4zp5 z5ge<28e2CYi&vW!z>mlKN=mO z`N3ww3M>=r9RUtp3YEulv6%2VJ=<1@v7pi9H~88(XlAgWmY~lF&1~A)#si0&G`2co z$zXNaMtvPlLUB$wc+iP_{3HZfK*_clp^3FAvRkWr8Z3pGrgU-83fd6{t)LPITr}f* z4k1?jqa3D-%b(IfYb6`=E*DtEGswE3Ron(E2Cbk|B_exwS<=Q0f}KM$K=QLaGPMi% ziu{T_pVmG0&1P2KhKv8Hv3C%_*^E}JPK!P6xfUrVEp|GGuQ^kbI4u@Hu_cS3BR3zhHj$) z8cw~5V}~w4Z4;vnkO!@!haOl$JQJ}4!`V2uc|JiW3nY=OA<6L^*tK5Imlay;EUJ#I zGSBS=LTk=p#+53HU5q!jjv2<&p8hM1yvsv>QY3PE}{IWxE*Np(27!Y#lTti)7(oNFb~%FeJ2KNW@u~P+0l% z$G$F}!4{U`xLGXwi~Be{$LnF9am3K(XvaUu5gsqOKgkUBB%FihXF39m4vVsrvd2oU zlC9#NXq4&v>YH(8BYW2mv+^yxz3fB7@@~c1s^4Cek6h4la{)ir#}m$j^Rr!u&R5i{u{8y>4})YUF4(wTp~d2;8GCOH!Dz8E!q^d|?IwlAil`@Lj4M{9Mz)w7Udb0{BALvIBm1jqV^Qdz`OvYJQ)i zM=^by1J!Mh;0@&q`yTGa(e@p?K_0i>jGKCHouT z%$Z6E(|>vdgC*Q2{%7Bq6M()kml-$u>Wt{Cl+}KlaXIzvGo~*-A);;>3*Jn1ZQXik z{414U%xtThBIRYvFDaPb4R1QN9OZ<36|0ad+tKMxy@!22j zHsbdae0KKI+VKa|d>k@fxbxaOxaMI|-(4&wY_(=@rFpN$YiD^h(jI|ZpWNO-)Oca{ zhbwZ{6B6+Iqmc+1U-#|JwGR6lpArv`A)oExim;lRQ#v~b&Ppr^KD*OXd$f(Jt9a}% zYP=>i#Oq*fu_C7v&j*}sjQmhEK2{FOA(BO{v?hQH}FG z#XT`DL!2Y)cXil44)MBt}0mG>p6 zHn$P@sh!E@y|+thyTivq8LRPV>q2(?{!B@jc}B=rk8O^+@fz!9gX)7RDeunNZC@PS zP@0C@hp0S1rnDr#ofzi1a;5PZh6D6ubAO~zmxi`ZTHm+-kEyo|i=%nIKyeEpxI>VI zMMH3R2rTZdi@Uo7O>o!X7Tnz(f&~d~!GkR>0YY+z_xFG9z2AVYsZ)Kry61FFGjl$# z_YW4>2z=Pw&^mQ>%@C$~<8`R|N72Dv`)AEvmLq43wmR8mO+oDMtW_PSo{iJo#SNct zSzngF((jyGm_IF8woYe7i15TI917hq{QY|HNL)OONG?Ce_jBzwkTQSe%RAs(rEX2B z{Sxu#Jv~pCpQrQw{#9h*HsvxNm^0fx?uq|9^fTkxMN1}{LTVXl@b0_fpNaO^?e@AU zw(Yo&PnSoZ&;NP`+9dtfPCx8$)Wi^umtY5{TS{0PVo<1-v4tx!G%pVgH~w!v58Ln=g0G`-wic6I1M`7l&-or02!j_10TJFx*Mb4mL(wa0VC| zF4j*O=B$1c7Ug0gOMh4G#gQ;wq(D3^ZTSOczH0FG#KTc}enx0Lw7T2-v(}nV3`Y3$ zs~c$e^qa_mtm?^r26ZNX>~KSRd@aH7Pg*+yY?}oY1HblJ)PFxt=7!5lKPeGVSYSwN zLlb1u(WQr_l;#t>*P^}3Dy*vpC#>%NsFYvWGUK_DTeyZxl8~e(zjDxOQ0ShSV6yZz z@*v7OYSZ}aVBqiAteHn|P@X>5w#n=p;!Xd(VX<{Z*OhwKM> z*znJVx0bJ17Gno-DZURB4t`*H;u}v9I21~VsR{U7Q-Nhzbqd2{m#rk^7#{^`R8ar$ zpebm6XLHffL4%<3eQk03pk*Oe-|Ot{NvQiSKRN+MwTBO4fg~8uZ6M7(AXEf7%$&>R zulcNWf%u8b30u=9#5nKs*PlI%%{(dGEh(=k1hVXiR;xTWG&>Gp z{JC>-Z$pCdYNYvfm7)Gg+af*-Yqd1sT>=(G2_Hg}RC*W}2yn7pC2`Pnt!1~{5WEW| z!1!ub$`TGyVi9{hlLq23dnPVS5f1i~1qO$89D>DZ?iN8Jn*F!fcLWRz`OTx?MZu$y z>zStIT`jE$S~Lo-Am@QJdy?RcNXKf?k~G)QvcgFMDJ@d$-xnG7zEN3u$tv}S_8!rw z1&)j)NdHmdDC58_E&TD}#@NSke%?=+NKt*1KD69FwCq-ANe>&(R7VSw zh}u{AmgXg4(D3dL62*DrMzO*xmI27GnBd`2?xBRRaq8LTx8YnvViJO{!Qy%A8RBIk zplIx+RUGYFoWfrq4a_kmGew5tHEN8bRn&kG>fku-YI7V+hei{IN z7qu8=lVA?1S4+VyR2mC}*sBiay`DiW-(4lmf|$@#^|GjASobA9r&?Cl(do~1DL>pR za3G1LEfnAcEvCun`mNemr#)wfjTh7}Y!>N$PObikeYLvwh-xD_csq0XXv>!G+;`jh z1Itc!)JE(NKYFT}naVdaOY5duaOWTJuuoo541xq(Qg!@Th*J;3PRO_}v(Um1^^y^qe< zKc7+LJu^#UOy>_jqiRz9{4u!o0ZUBcxhp+o{GEj3V14JD!aasXl0re1<%|+w!5k3W z8r%T4UNQa-!Lb{$wcF7I^3@$el8A?{8~1h-W!yLYv7#Z`S^u2)C|_SKiP35?rKCvy z3oQKQvb9Ga1UXJ4q&45qvZ#Xb2SKO#%vX%u8VbExF0X7u-`#3jAU7NS`+G=naN?H!YtBj z@*rMVaVaVoq~+MwYP*7Gkt!=%b5gRY$|W%^Sc1jZ2l~V zNL^@ z=hp4L6GLMG8cWjTdaDgORwi{Sr1ksM(n3kT;LEq*c~Bvxt%sDT$vdpR8&D(bQxkmN zl$W6EsG~rOvuvkpHDNqd&&xq#zFULQuyD)1N?Wb`NnbFKbQ`jO9=4ve?GaZZ%h35# z#kLbo9)N}2Mzf)(t{(GZ14Im-i0OZ$*J?HlD`^QTahK<#FPKa6=%u4>H20>kme;Y( z4R&=TGA(B{$ICm-O)@K&B;+IMF;FTmfy%NVpw=QfFlO<6EKhlfOn;QM5-jYS8zv{O zwTC8QGRCTd@i=ewyJp@KCv8=Nr~U_94@g6=0m_K$D(~2@HdETs5?wb>*bwR4ah?%2 z-mb}lEKx`Qzy4U%PPD%Sh2^OAj?~E%izGyGBY~Cw&Io*+Wxrg`^T-v7{lUZ(YHw_hLx9O#GQSeQh5mf@YR2ORa1_wM^80cYG?Ai4emO3Q;OLx~!X5dsxx^ zp$}(Rw22RDJfF^y8Iy3D>QBV?MiLvV;u<2JQdVqce7Ah&LCFrShsH1KFvb?VS2A$U zo$xaV920_8KGfjJ2FrL8_0cjk@$A+kP{EL}c=S-hmv0_-U98uHB=Fu+AydNh&A$!} zvFGkaCgwSYMO3dHx?Jsk?>F`i3p`DD0aMc^4>D)nZN!WDEf7!4p5q;sOZV1D*LUc* zLEL9(*iG{G)jIclO4!xAAQ`y3Dmq+G1ZFZ;LdTGToLkcP zUBm?2FlE6{9IAakBzJg}2onoB>Utubl>?kXbxRW8aau^E#UU!a>;ok{8&Wqq>*7t% zE7mh~*5mdgvm~b5MZUSn;yzlvEgJXAT8sSeC5Lm}C)D8Um+lz0%N&+B|JqI+rgV9r zyN^(Eq5B_c91PET5Iq>O7LPAdiRr!Xw7s?dJzA_(HZVd6&{PykHF?FO%4b7s7w>T` zgsD>y<0YDOGzgh;7J;Zhe?eiNn9!5D`^G=SI~y!I+_d!lH!QO>Km=lwKZHYOpo-_6Gf@1|1?G%`R!dlNig#F{ zbP__mb#U}dbx+zq!JlJ3%arU~U(3d#0_e&yxeWsu@6cjLf>X|MW{`iiXT!J4nAs|j;6uZ zPUT(1V8qe5@D5eyHZTyvQ2&~B+N!@R`|WoB8;QB`R3^U9orMX5>IXPq6qVIVEOZ<= z6MzWOB_wJqA}a>}Bj`q}DWh1*Nti}LZ3~Ch8K*;28}LpL-xe@@{T|veK-=;~%1=qH zT_$Eam9oIXUMc+-FnNv&`iTxhejXwf*nT~xs%wCK_;rz@GopnkH44(y`$U)_96Yat z`U}|zNG$Azq%r|Gy_m*@)-yuP_{^OHTv~r-f~Bn+#^zLcSkvV6t1fJOaGQ=g0DK}e zfH$(CrHm^4_CxtP?N?*h`KEfq`I0_bIIUIb&H2!;VT$)irr$m_lnEE2y;_IZ}W$yLIM;;jQhRV=npCjYS#g*kz{60`O48oIlcLv0 zL6S(;7cRq-E_^nJwr(6hia~ok6x3RqP>FRXOgxl>XtT11f(=`5ZD%E~J3i>_C)X2| z5c8u4LG-CgTgC|*1Rh}gFv6^$;=9GOhc^~cW{u;Xi4Ua%5H2x!=pHCY*fg7=(QwSl zLm9iuo&@`wgVU1ls+s*p)zI-BRt`3Ea1PQ=YQFG(Yvn3plf5hMXP0fD@UAPRe6$_E;-Yu6z+@3yW%T6|-_%^z+H=1aenImO6!O0_KMb6@UAh6fT3N#%;x|6&~lJyT^5 z&CtJRbl0zB;%@eQRu9`mSCZ($Z00gn;S|Poq;o}b!4<~j=xJJq%q8!DzC32;b=}2^ zKsMmW`}R~6{~}Fk@+&#y9qpQ7j4%0)TH)e>XR)y&gOk^{Y-Nj)sXU~gNbIrxK&O-> ztkutf*G*H}e+y4JK8cLX|K-fS3|ZwP6FZK2BNbD<@!MHBc0-Q_ z&0cFRXrr$?f1Q$55WPUL8--AbBP#O$7*({!TL#rA{EgvxyA7h9!vo`}zd6fOt#VE} zdKoxPAyJE(-pkupJ+}c!mguoK$pr9$!I9AE6UhY zG6l!>0k9i`{y%$~U}{p#fAsL>wu@zCXpDqJ_ix{-x0QhCMj;BGxcW3f0*Kj2Hrsfh0D&5v*?gbQtU~HCe1CWjc3zn4wUGH+=iO%Kq}8%Owi}6F z;yATtj6ho5D}+=ENmwjy)HkkdgNS7=9z8d&Q{#5DgmEMo6Jw_mI=7>W1$^SCoJ;aG zmcfuf?U-Voj+PM?Nu8N-SiVL;8uIrIwUyu`qsSN!FMOugYY3mD0^mQv*ot*g%Jtv} z9k;S{OqPSb-82{*sFt@;U_-TQ7UjE|Fb=62{wbyw-?+gp{C#`ZmPOE<@a5j z1gYz{b0^p!b|K`5R|rfaMoM*l@8icY?x^5&HXv`x4@^+<)gmEufVMm5Kq|hxCo2OH z9%Awqq`ux=hL0Q;Cn1rvVz~L$qWFg_pR**%PPZYL85;cE`R|N(L(y`Q&^whwD*-)C68sY`S~>3H@$zc&f_X0HY^HxglS$)7cQ?tQWHy70l6ds9FmejQN^S43`WC zLs{Y3uG5oqGzkE}x88?;D`?z(-pK33zK0IDoL;#bC1 zh%H5l4!qm%X-djcQBFCuq6kmXi?MPDY5C(~<@RL+kLA@&)}&~+?T8@@9%=q3u^xi6 z;(OHJlqM9zzQ@)5VG;&N86@k^gH+Ts?kPDPVe(DB3-cHh2iPHavBNhbA98+i*(8f1V*NN_HC-#x_?y}m&>+U0 zsOz0k961H`H7ok=ihG{sFi677>Wd>FI3RFHFpLNJFYv;ivIA!ntqA0n*X<)s%qs#eNS9~vHE z-E6-#zaGjVo-fOO1&+Tx6q718l}=LFiePI0erFI~-Iy*ta#VhZyHP`f~*0+o=%$)o>OFltS4G$y&J~Eao2RBzdA{-id=UiY6Y0-0-X|z4MuaQ#zj@)jAq@HtR3w zgAxMVe1)-sLn?M#ngnSC>zOky+BB?s-gU+^Az5cGVdxtKE;{7VeWI|UhiXt;U<_?{ z2(st*i=PQ=b$ez)c_lHoJC6$$xb2*y@S{uL+O7~=JXm|+Mx4P?wQh+^)cX|vps}k4 z_9-FA5>|y>RcXS0xjCiVq5MMHj6Ihw{I{$he#RiGu)4OQf=dgAS9x`;KHmJbXD+Dg zI|P^RGhgJ!u>$l#$@QV!8TaWA9J@2_AqpS*)#rINT|}ADt7iO6sXtoanJ{-h(cjYc zG-sd-rMX<(7ERc8l5}V?cH_5AHV*^`S!<`#zp|LwNJetUc&k+vqCXqF1E#v$Vvw9C zoIL332OuM0`L+@+q0%E{-Yr7+(2+ zCUBkZf)Pzz>=Oev0Np!}9s?@q4ps!ZU?Y(=WT>W?@_PR5%3iN4m?Y7tJ^6R__aR<2 z;6`1{7r8w*k*u3Z_s>~b&4>4!0$Q5ZxcW%J$KJZdhBOHTpYu}MAo!9sy8)Usv^UPc zV(wDIw@F2qVmod_h0|^pNmX~0E)aYQYHAg%2F7nLj3<(?q^2i-3K*P-n<2=lRw-wZ zyHsq$(u{P**zXX1!AP&r>@c7^@?LL+A~E_+Ip=&`yuu{nL+`?Cl8H;H zxbsQ{p9VD+uRWD0(TJ^(sh`g4)dZj_%}J$57*-nV_%Ue8WlO=e?Y9c#uvqvutV3cV zQiis&iX+)9Y%4KSwKKLlo`}^)M!AqqTLmIHEk4#Eu_b=xTSt(lO4ezYf#E`Z zsr&}sr0R#UO6OM{;=4$h*S4D%BDksV*z@){2`!X|cUlF+D{>V;MyYA=F0w?3P_S%-?!F1RJVgZT29dYvGckj;vPol_ zBCTg?nybQ4ZNt5Oj%?0OX{)$>>03uO3ihhDN7;Hc&3^@{mJ#L_wf7adf>yejAIBy7 zP>U>S*qxK+1M7DO_*fZ(WHp#yD@hnI`-z?@nKPpn86JyaW``YWiTOnZFE-d9%0!-m z6qO_xy}F~_V%#!oQ!zv& zCW~R?k3@##H~Zt(*8=~DXR-bqh;&&?{^tVsr4bXqsWke%CTtq*j1pXs(n-nw3LKpB zv^^$~MFp%5)_C)!GnSgqcQJm^iYg<9PJ=^AJ0xEDx<^lF+T)vRmw5#%Oj#PL_fE;aC>bEyM$(}- zPBGL6iKs@N2RG?Xlwkd#FG?252V!YCy~UE`8%r_zcQ*R=1IojTW@kae$Y$LG6ed@* zCgo)%9UkXun!I=+A-Eu>lk)BjGs&GTwqtOEdkgM68xXK$Nd$eTR?G$F^CzAo+nqrIjSaXR3b(>O_{#nfWwBccl(?W~=FW(vMR2aa9-o#!NMoG!Z!B6igWL+e!p{ zPAupN=ZTyfF49-be)of!?Egg?SH)H0*q`DAUuyWqB4joZRtXj;6Xdmw?u*d%pBsKJJisqf33{FK39p#u0)$MiFb|FN?(2= zhz`;GVN)5iW|5ezf;rCwim86(Ff7i-`st36i4JT7pQWy^xYG0z(If=T;f!lvgvaTa zc@@O&nnc*d-@H)vH`^u8Gl_UNe1T0{nHDPs+<2TG)j(ff^;q%`Kka=Bw=4nBLee`v zvvkr*^5N2z`r{qs zrf{W$3OLBW&Xc_>Xy{GQpf9f&M}Rq&pQ;KB|74$t`_)1Sr7w@gGA_e374Jm(uBMqv z=j|aW1-CJII|+#l}8(SHL_Ow z9d4H#)ryMiLR%qb6HN5YcjZX@kbNq5J6-rBgdg;AxHBYTI-X%Q292p>dy7Jn+__4< zO4^Z%prr>BcNY+Hi{d0GpL6J;A=Is~alNX&gcFYOHCLE}pqKyyy=Wr-3J)k!+$yPJ zh({aIO~#EbTGasfY}xoDNOQF%Fg*FC-T$Tin5C4!X^OKr6ec%`;Vpypn2B?Jsw&jr zAbTD19i$mKRl~8G_-UN0sBN-w!#SfE?kK$GAV*=LzJxio z!1(Md6T>sC(hEKQLp~N@Geg&fCmS8N^-)wC_Da=cq+zUs(WhY_FVS}rsIA^{q$LnI zdxjYw3*pH}aERr6Z5iiQpn1i1^I^F%-&or{jn6pO+oiQitK5=G`>Ut-#yAP-f882P>SPTsuIGlO;3#d0m$k4+8=dKJ=0(Pw-d=r zIYXV|N)r8TdbrYza(YupA+CbcEO6S8^_vAZCuVF~@TFJM9TI8f>ML^l1{F1Qjb*CNho~HLe?Z*`K?8iQI+DG4t+UbG z7CG?7J?5P!JuRlFB$$ z_l!IwK&~ACiFgnIL+t5Fk`Gmve`(@Q3zqb z(n2g-Kz+#-7a^-zVOGqfp=}OW8$M?Q=;mZuZs?2)p|Yo?my*>2&U#C`R9yU&U`GIv}Pf_{!TFVx3Ds_JsG=o;`_M6 zw6c*0p#3u-NwyQ4>!Yv+gxpkyJ8;43E=a4;mAO?BdZ9Qs1d|Z1{8e+d>!}MrC1>q4 z_Ik&&euB2NycwGC4YHMn%oizdsA@cOaN>!(G-x?kSpLK9&!BN>$?6>Bn{a5AA>DrFGzrd-rG01AOT?!^iJk z{VVzZoUr4`Q{n#CU*&275~d`<6=@t+bYH{j@qDYN ziu5nk)beI56`zsU-?iF(sESy#C~a=e1J|!ZfFG^)TYiD9z$^>)Zk5I_!L$d*~P7DKKBZa#ZQdzU+Nv*#Fo`8^e zF}HS0I1;@i#2yG65gEp~YqVel&5upB)auK}wF@gy1bNldtg72Re3Dc`An{Vk<2cj2 zUE@4sAo5?w6hbf z&0e$k3(Qc~AX(@ZsQj5+7M=yU{L!KjP)d*zk}X~IPjF|iQb(o^MB@yUI1CZ&U2=b`FPs;`W6^CfaM>ntJ|Pl7nv6}fYiRt z0&#mzKp4>UsKxXw*55_HNYX$Gf_B3$d<=>1PrLkpT$9ZjGPei)zl>CUogMt^Qv!+k})HrCQ{gf4@%kN&27O8`(H# z!)u+`tZ=9mi^(oVw?{x!5Y9?->11*JZvq;^cB9%1?_N@?5AvnW@N3H|{l|Q99}S9q z0>E)o%iT37O{VpoI~)IcgX`LLvUW~!uxpXSj z+Rwkx)%NRA|FouC01*vV))_yOyYqR+6p7k!;M+~1a9Y&@@`%IUIlBnTXmbfq7~Hd|E92W%1P)(FldRe2ER zYC|gKH)xotJZ5OJz_us(;0q)Aax!_o#0qm`Hx7ww^hxdcIzs|>|9)H5$mvEwb7tvc5BS?tD@l+Lf4R(TX0Ss`nV zu`!aRM(o}(F-6VQ#xii_p>rfddusY395Zaflvh9Iwa#7#1ehbuZIEW-_z*Ze3HxmE zuRLlZCkXtW<+q=ZL3u2Zk%5|vRfup<>UWvFRTiQf#@Kor0;$k}|6s!N5C22bGw4oO z`%JeX9x?oz-nqf297*K2wTZ!MX&Ew%D=;(UHcCYN4P>XB&9s+j|ZwOv1&?xy2O3^wv$c;IlW9KZbEQ@JcQ9HJN%l;xbJs4qkwy4?bjkb=9;J z#E_|@h6cb$l-`W@ciP`If|f+ zO(0_R@Kq)P59U*f9=Je_amq1aUMqf}M?r0$M?G@AmJ=E)&4~<8){Vr~Qho4CPP_^7 zrtOoOyHi1h2IZ5kNnnD=kLW!+nwh%6-=O9N#EOFX+pV|^V=Od6hJASK%8PbNYhL%S znA^elnLlsaVi@SY6}Ui@y9g|9wC@=U`|A7;VYxdbUt$a!B;q)_2dkuS1!PO+c5Iem+$TzKt25cs}BU*O5JW=SdDEo}Z4sOGvcURGEjL9UJ*^P`fQgRv`#@=*R{KyI=%soeDJoXQC>N8_IH-J<9Z3Gc z@-^q6M{pJMUFB-hMZiOWh9R$F3(btr*ln3FAN!2XSlU-c&Y!Ym^OUQ7_-gSrfV-9ts!NV$w|be>Pk$H2?0$}wq@!bGm|5reKVPmXNr z8&2AmYd(vP;Dx-}gOG=^C%ngNsD3rYKMn}NleXnWp;n+{$@3ugZGst95!m&BmhwkuG0;QBjCTk-eBHH!iDkwbVYR7%1= zS6xbK`%qJA%mfK_WamQeNl72HFY~FrY@gt{;JXR=F!$jDtrviYmgyM#+ z@JUq}|3b(x?3glZQJ-?b3Y`GasL+RTXE5~Nq#03z_nz}rtaE*uVgw#-Db6q%$Kb#R2{h}+)YY}ci7Axsu zNldKrmd~Z-)e=mv0#e4U7PitEl*3nUGp^YO$iHf~rBbV4udON;m)DbxOO8HvT)EJo59NS^Y0tMTSfPr$|o9@-M$5lT+vw3z?VAD-NEbOELb?Vo;`%^E#wwA z7^vFZX=rv+cPJo#Z%kSbef{YwFq?036Pq$3cx8|o;=_lmsr^?ZEZsJX=u$-3lYAU+ z;D@)xq>%X?`CcE;-WTk#e=g}=-sDr`Z_vz{2M#Oc6_)TJqHT1N@Sdp`d0HfF?0vH> zo_W(IZ3SGc9$2Z8i=7)x?oBr(MAg-Cbx+-;QQej86WR)?Fo4}2$TBFSO@GH4`2YF- z>QmlDr&)IOkldgXeie3sx%Lv7n73|<^dt})YWVc-V``=_wNUp*A^^hef6zTOe*)0h zG~cmVZHm|=r(|?f3t`hH{0O_qH}lvp2Tn|gyrCQ1{TlOKXo2J7+^$jw`jXE}S(1|Gg zlBggEz0-X$;36Rg{@%DiSsB-P6@=LMg?;Dxo?58vFNHRjf{%pv7Y@vQ^lg%F!P-gF z!1dp|sJgUgv1-(t&zBR~hOs-1?*ILQuvFp;{7Vrn2WvsIKfn=nZtf#DvBv-p&$4~u z1oV~9%uB|ISl`68cWl}+*OYVkoU6XYF3N$Ih#A=u=;lCW)^6&3^IAgld}dQyCMeWX zhvOi3EB^^?h*;bYa9z;FFix0LeG#)*?XUJW<~<~b72t_=oYO;#(Fgfvab%DZg~m`Re9_@;huJhsi@BV z)AC~;j2l{u!o-WU8V~GAjOunz{6U&XL~j$rclpQLu|kuczU`N;%QP`)#r(M0(|jB3 z7!)t|aMkmLpJd#dO-4`Ux$~r(5@Ug`bq!J=ysZ$b2b2RSoh=QYo@gRfeh4=4R;3O_ zv7K!80=p~!A!?9~^4JcB`n*6T&)=W`Q0n8m0I5N%ZCYAV7Jr}`bb<4##Tcm4(3+X? z))CIrombkVRlR#C3>XUaGo>R8$#2-}{umuh45Lk$_>_u25a$6qeJb(=r;6>NW( z{SN0F%i6}24)qs~i3_DGoN<C=A3@wpvCet@4pW-w|}`&pckp) z(vzlV@HSeUth(jb(yM;>btku*zLUaxX?`VFvF%>$4gRuLp?BDMRknEqg2siyDX-qZ zSPwBhCe6-X3#+TTzY*&f?7u2c@BzAfVOGKOF3stu4n%?F=R5siVx7RG@g>qZ%I|Nq zl38_aZlvALse5XcCT2&u=Q-osTQdYxh3|`sH15_}^Tu=ryAoGF5U^O=LhMK$&|8M>z~}6_-4UqN#skxCUBJ%rjT73lrqi9%Bp;s zUndZ6F*ND$)?iHqP+%|_DY`T##&nH>t|osrJ7lQ&gQBW5L)51BwW4G-aJiQhL7Efy zQht(8A3|lY81l5~lv5Pb*OsUZTf-+#t`14R0bji)YEPj7UnArgx!llwUeoS*t>n7^ zE#iRwKv9vqyI7qbXg5HUaXn>Z`@XW;lD2Ttu^nTn2y<+Yte=dA=|j}*$l}Df;mZ%Q zlS_Xf$7y$Aw@mziMI2xO0IcrtwK%RaFVeEdBPaqV;Yy|4H2wO0Yj+M#K0{BAv3*@m zeQ+lV#jcfg@vUEJanQ7{r{4KmK81H|-`ImRr}%Frac=Ab{P+1{`>GB2V&u&HkJfmB zS3N2d+Kp+orz&43lgyUpI>)(O0X4Ap`Bayro7+^EW5=I4=jsa{Bn;KZT#*Eb$fm>9 zBPP&%1N+)_S#}j{t@(%%WsrwO{;K*$>xBGGd46Y1a++uMP?XCRxu;iMEb8=)BIr9a%Mz2+51%H2ec2vmrZr@q8f)p zp`>{%ug8`2f%>GE&^bzMvb?5SXn@woe_DZMronQ66wgli;p}h2uXF?<0kbypi24AZ zIU;+nMCDQJ@cBBL2g_dH!k1<-UV7H zsj4HtlHTrtkAFFFiq%?YXwH3ZUe~dAq&n3Ls#nVwXH1T%gVe6!%MU{=yTv!cyYd#< zw;?UADx`M0gRbe0Gt47yeW`SfsqH{wNOmWB`VFh+kw z@I)r=a+|syo~8!dj_$Fd?CZ3h#C~s8&PE$XKu-8$0;V|t*9scpft0(yftzdhyB=fQ zwsBsi6s;43L-!)Z3W&iWd!Bp&r)Mh`wddZ72|~ApF4=nueRf_#1AC-5n4?*6-Ur@c zW3Y=M;M7}L=4x-V1U!8$**rL1d&*CUG;%CQmXBWCEc1 zBg6&ZUk)~yUg>pkJN^)wzeG#2!xtPG!}|GMlwh}bR8=;HycRvF)F?&JXrIzt^y0J7 z85!GbVuUyey)txIPAOwusV3%GQ^8Rc2!{keZ0rOD0MjRrr)npRL=Sb94SXnn&mg?Z zA?gz_YKM_rs-1?SIpKwML-z(4G)(E!{|GpZq-xLk6e-9ZhiNiu7qU0A@|YPEle|x@ zlKj4XF&FTo5ct5z%OJ?d2^18`*tpZCiTEkQ#wtI9IV3WcjEf@Vxd#2yQA!AkUMkS} zbIHhIQ4B6Vh`)iu0)0O)UxKTOUTz9Q;W9{_3#!N}l84*+b=KDz{ zJ+A?0nRx8`A9L!jEP?ZHNE!GN)R>J{-)Ov#Cu4|8etWu0cR7tuDDC1Z*u?GGx_;FW zOGtzfeHAz(*1wYaDArtbMHr2s(xa-DUdMpCpPuKcUf-F2oy=?SMx~v?CYO|%r(4f( zrp^0D439nv23Dx0IuwrO`@k{e%0Qg6@05++G=l2&36Z~b38;{;FCn5Z%|geZj+el5!#DH$r8JY! zF(zEZKJ;g}Xd2wwM=@diOmHD92}9?fq@k$b5H}VwQEM-sD}k*rAf;#NzU$?B=g;~s zlcvhHo5wa3^+BqL86q;B{uFNj>a+&+IX{@j+=!y=^T;F~cRFTDwd#w3fI&@(n$k01 z5rp?Bj>z59IHbA|>}x$Kq#80N_CU(rf8nzvuS~eMGBOQHB8F2sM1749kesE);}0XwA3C{b|@zX^6G z{?8)C3doZ~-83nAt&ZH>e$42rjEDVFd!#CQ@hVlgtybTZT?<@h=aiqZ;hT%<$B0ME zgIJ9q3{DaT<0A6RQgAf4tzX^yS5Zf*al~bp$gL@0^o4w}1O09h zJVa^eman4KWF&o!R!jR^v>%keeDOK8g>y&K(~c^n*6BNQYgMuJeukX%+YlO0MzYk1 zsJsz2&qdpii&hhc<_lQ@YxeRji=`5D&sVW@GBOY_u)=)e19H2j(+e{t&$9iG#;LC! zhF@TV&Sdz}fdy`7a8X1>%@;U|vJFaJ6@1R0IyY38W55C;?kKE8Zii3fCjSmdPDJTa zU0bU+C?Tz*uTyAu9E*nQft3v)mC0awsqAQMpzxGS-WIkfhQm>dHBXWw;+X$e)Xu6E zG#YDuq)oDmsGz;4Y_6d%Zz(*5CADT6kyAtqp871{T*iA%AfMFxi z#t4nP50P)%nH+3clh?wo@_n-R&wQ6JA;t&Jkopar4dCn@+o`C73xZ2P2cw zy3fY}59O2$id}(`@^^tXsGXEIh~D^wQzuv&B9^&ZswL(*m?`Yn&_zuA_t(+%n8RW? z!S_!8joa{KC*p0V(O(wn3-kP#Orl21{0P^R=2>C}^Me*(y|d0|u-p_>TY~!cUM>^~ zT{p5{t7+GgFchwT8GnlyKDqAM4ZSmAFTD!fNQSbm-;<$6WwcY`bj33(q}^Tbms&1y zQc7Ej@kOr`1s7)cEENT6TN+_pHrM9TE02irbN;(hZ_Log0)KgUnVZ`24Y~p$>!r;D zo97?ilu>Qza<7`@XJ<;5^d9Y`fBF{VDIAgc)M{i?C0uiiHGfXZ$yV|_RP2goVa4AJX%_XiqnU%wie|p95L@{`xF- zCs-hqgi?Cazhxb{J-fi#@m?I%EYmk_6yT2(m8$F&+%&A(q8kH>mN2^t?4 zp03opPi$&7C!X2vdx6~EQdMcMtE~H|_v(4WsQW11xaYa|->=#{(dV1Tqx3uxDS`#6 zI;ZelJW9=RlyOpv$*v4;L;yoR@9$OmlPTfL6k@;LOnlTEJijMn80V~onpQ>`dZ+x# zRDT$VHiBWsOISMAQZBIF7{(tHc`8R$K8E*xmcilF7JnjUn112$`gn!(e^et5pd;fv zEj=tTg;vWTWBA?v{ptRA@%;AV?|)12y@CHOe|f*j`^&v25H+)%C)w>-vU-_rd`y8_ zX@4F!`g^_V!0R4F_{5m~wZWF{jYc^75@Z85-ZWx3Dq<#}tBHj4Y)ulyugncO1<% zt1(V+2~GY43!0osy+0KQZkcw4-ycv*u_3F~SM9rM37#9UF)&oe8%2iRGgf+3Jc-p#^4}7W~yteCl9M_abCDH$&t|@R2JsND`%NKTD^GMg9nKJLOMH zfQ>>eUP}~YKLVle5j>js8tcllgOBsIaLKJUQ!1`B**LYRRlHL*_=EVjpHHxZ%rKw) zO0{2Cf}VTy?|pJnF-uvvZ*d@Fk6B)y(H-_$#_U$d7L@gP{LLv<0?;yH;4viQ=c+%v z`S|o$(fd6sY1WZ2jlaSZcK4S`fMy2FCWa)oHaujk6tTeU(As7(ttLwcPbGVY$b6;G z#D$UZp~8?!qbkfyVzaafchyDr4a?SsHJ{j`4yv=t4gJ18`Ct22af#9Pt95MNwpa>U zQQdqib4v{v<6!R+ELhWmpx@y7^RaS^Ey5Dq)2p)89*D?vRQc{X;j1>yQ#X4O&3d%c z%rbRQ1JXhNQKyv%PmnELw5sS#E@asw-jXHT!8-!cV9aosrKbnJ!sac=Eh_1gN?h3F z{r4=5hkbkP$ja?leMDmK7j0?M^-cD0%B}{%B$jl_HAD7uc;c`T#7a9$rn@C^P8*Uq z{;hQK`E1YE)+Pb|O?2{8@YAVlzM?!ujyesP!xaHyLeSf=>q zYdr($4Vp#eh*r)>y0w{v6`uGfzaYf4%sTm*V@9u;KuE;VjNLGrE{`{`MT8lWTzPC?`L^rrp&0@zhE?-x5?`5^#>p@@Gt_jIcpUpT*1eX-z1V~ z7>+~N0Xi%=O($`nPoHAG;ffiKMZvoF&L~i~Xb?+~W6VkllFy`WjFk(MU*>L@v^6yu zHqBI&6Q+`Suewx;29!<ctv5P#b*q6NKU&vzu&`Qmy z6AUUoA6FKO-<8_c?_tR%5h^Zv)3+_tLN#-h=orRnadmIRg%N5}1IB`9@2L9E+nUls zY1;o9`LEYe7>iCzOz@6xJ%MJ`61Z}wbe#xu7kr_ZWMO&}BA%sc4NFCJEG!Le)~`hA z{$wg&wWd0~@1dkK^`x(WIdP$_MfWD7?wUZB7-UyQO^;|5-J85_)o;q%(m|h)r}vQqhom3buUa7je5g3I`&J!ED*5BweUvkUKxtW zG#L~PU$ZW4V|s>_D!7gsH)qc|-+sWC*O8wl58(=xnDs6w3#Ibsj+%v%iIkHV-St1H zudk%(w6p0DYT_YR>}U=Z2J-M3oVAfO{d#YzmuYVoAGq8(1@9MERc?_Sy1|7ZR)EIj zT5idQ3oP&hG&XB!~L;?v?-g;3u9>=n1u7%6aAOxjfv=;k-^{uwO|Ul@eAtt|C=j zI8qw^D8C-aMy*kL>&_>#E^Ekp$4h4l+g{TpYgm~_%I7(UPy#;1ovPOboZUpj+WL@e z&B~7f84QJRfqv*ROUJUFkbsDTw07`K{FQB2xqO|8&Mn%Y?!GW@oT@rxC309hK=B!w(I}}e(Hz?Ay|XARN6Ur z!5C>Vs8<(Pq_Qwb?0T#4MX&J+sJrWDII{G;8zD z{6#o8|Om%R3~xRxH<`0m)G|Gx$H&AOVr%Snw2j<;dHrVyOd#|4WpB1vvy{*ys|wU z4>EM3$CDAT%xt=Ho5sp`yfRk9U5+*wNK3*FQ~Dhy50_3KDRu*btm(MZ=zNMsB#%TD zSa(P%$JA)p!oZb%KK?%tlS`Dsxnv*cT*zqFN|&k2M=0a`uQaw`I+6cA8&?`K)~7Jk z#!%PukwSj?Y8-j^S)ZVnV&HmoOUSx~0G*k$iY6qR9@-Y(6pKVjNQ}Hc*PytmUl{_8ezz3|@5hjgO9MO(BHBBEmd_ zq7(_F_j*hDiSDC zxM!b==;1Sew9BfGJ{r#_hzjqTF~XD)#M4dnMNJC%*5%#1 z(|Z|@76{4k27gGlys}%4z%fWeVE~_qvW1g)FIcW7%c*n(ESFo+#*6%%_J$Id+Bqjtan zJdgfe8>TuPWT5}}t3KyE(PkeB`dz+}vY-{Njm| z??ODR@LI|x3jt)VPZW!pM0oq6;*6IEnC3!susIr7I;>B(ZLzDI89+VUc3m+ny8qtNymx<{+5l&XdOC^QY{80BM*w2S97i2zkz&9x@Sl&Yhxq z7avs4YF9k2l&OUI#sT5(A7Xs2X@Bk+)cp8Cx()gRjc(+_sXqRBsh7R|*g`iXtnO-# zNIF^P48_6(MsdO#e2PB~ulUTe?1%<08fcg|&k!Xh$9q84TzcYw-S!^546@Dn=}lZJ zfeaFHM`qqTbrR`>{daE?P)y{N<$cB1iyl!KQ4A~wDP>`Q=sf2T9K0IbI4@v6zF=0J zeF!O1`3%?iV87(c@HPpgr)4iAhQ#rHN2g-{V_=RHoiHaEHvA7jaytYbv3>mb zQI*~_JJWW<0(sMdN`<`3$$=OQSo8htV87yKn_qmLz2Z(ozoeUQW-5)@c%B(~*U`n{ z2cGjI1Z-O7Lvdi^js77C=Jqh>7ed78$69S>q5>zmFnSX+gS@QnD`>8IMDek;aD&0N zjQZ=)F5q!DxG3R_d9D^e*1iA|Di%y4IO*QlPnI}`wR-Jy{T+B1p^+hLH)RszH{SXq zz$Wzp-hKOyt*)zif&rk3N+Hj^ybKPcpU&>X_-c1P+Dz38tjYnLt1{J=y=Ji$qUztC z;KL?Ssp#6Wnp|#&cf#|dU$h+#GSq@E3cR@@)}FySc`_in3Ne~I(QiqMbOJd+dhF+t zG9LKFwFFTYzxwVFUzBfVoAx_zM;Q1lfEYgDne-1q0?2aTgF_;(xUh#!Aadl!{zkyq z+@O-S;W}^@(Q=j%k-_fc`OA4*huhyghnWJTSL#yLjP|k4`Ctz-BgsW#+rsGW5s8U{ znq@V@pwnPX;!46?|! z&WLZGQkt@S+A9oU>&8m6ZB{j@TTM^&fUr<(F|zW$;rDKeLzl~4HUlv*Xh!wqwK(K+oDUq&>%;d#hdmg3hC1)RT)}X1hNV?wge>NwT&URZbjlR_ z=-{g(A3JX=6YJ2MH`x0d9Sk6V6!+a$ky=0YVf-me@L?)*K>F+^;kN(~lke|Pz~N^U zvhVBNoLZPR4I^)pM8*9mbom@ZQ%6oxKzQ3Mk+hwGg)b7Ra=~ID9{e)O;_{gVggIWH zR*dARn=r?TX6eC&O+P;_XWe;6?AE2IdFVON*fe`=H>kK4%{%T6UJ!E4&|AC=@rejd zj=3Fd!+acxr(bMQJ(E7a4*(eouMwrdudm4x7@MAu1ZU59b8Sy)|Flpg891<>QW)?9`+hwj-@+!D#~zgx1S!=H04B8b1< z@&D-ewH2r^d~ccIHJ9&t5-fA@GZz^*fmoe!PBbR?G+R?nO$PBt ze7qU-npP(*{Rir<` zfHo|YiQpTM2l`sbdFbZDUif7eZ8vARa^n&(8GP097+i3+dAQ5NgNi8RmVbAr{h!sw zWa=&6y-1%Shi`~%>uY&)t~7GH22cpn{@v3>xsF0043CMMHeyN7VVT*>+S!FdUxW{> zdvU}=(k22xK}g}Z!?UC=RfgQvo#TZjC#%VqDq9wX#;amK^*uH&E{v_WjE?t^Cw^3J z=S(-`ICMhHkpOt#gZGT^NOVqHG(` zXYuxbH%~$dRNr+po!vy{#K&&%ooUhioN^1W{Kr+bQ%=0z6H5ww;9Ex!g6d=9vkXR+ zRMJx*=F7#lt)w5N`NQy_*i*H6kzS33DEl3kH?nu*!PyH8QUhm&P;A5knxhep^@ z2muNU5xb)9)<}6AftNln4i*h#c*?JLf?br+k7XboU=#7kH;ACpr996TEdl}j5C|FM zmC^j73`PXi!i}rZdnCC9q&YI=yb-{s{0$Eueyb!f+Jm8FQd|?I%VJD?@l|=BX6s&j z`@zD}K8HD~D4&?eZi>V3BjfgB8U7u>KmKGxT0lzX14r&dw4W)J638XS-w3y=Mn5mp ztv1_)d3N+~YRC{ccp4+~GIr1X8xX>?l%Zc9J%Cxa?lC}`)dCi|B&i2P(=L{*Z}nA} z=UtrmklB}gs#6cN!0Vio7p9VcSd-k0%HJ(oBUeU7Z?;Ww9Mb&9UB>fpu@4 zfGXA4Qvb3lq$gpW;k8g7wkSm5^OT>pz%9>G+3NvK&Nz4Hv0kD+gkwqS!1DzpU{=n) zjP9?N_2?cY#nvu~aW9JWJ`7QnFs*qK-aR69Sn7Xi1pL{wZv4y-|@{@N_5-KeBqG2>oZjFh&|5?xFfw9RP-fCB5 zKlcGY(>!G*Q$I$`Wvnvz#{Cy1s<6L1d)dm#98-DLa;}a#)%Fg;Nt;qi?Hh1 z+#Kc;7a8LA)Qg~H`woCUnTAtl2E$*35SW-<;UWJop{lxLSa6iiUks1kPN`#Mm>ZrvY+w1NYRi~)zJWTI>8i?nsG-|`d? zQOJIJBO!Ri(BX?r>@G|$LBCwU<9;zVW1a^*ZgQI_ zO4P{J{n#D%i^rrXi%mTMl0TjE03a|g8y$%n|2O%|s$wgJzev)I+{l#}2yDOX(czd8ZH}xkqe`=l^C;ws# z28uZ)-tJ1x%lE5Y8Dt>LC?`-~%hfqqh7e<~Eh%7;3nD+iYmZzpuNMFD)#_<$S}Gp+ z(N;yIFcjziz=aJpw7=Oo7R5fR9c6KMxu}%t8B_5$;vh&Qxx2Qakbl}AyyU1D^uLEZ zft2B(Gw?gWt}`f~tcIB2$Fpx8e6H+8AkKOvI- zT!~$-*_4wN8wwc!GM=RWO|BK*t-!|%rz*kvjA)k!Ql#OlL8a4-W@muhY4P04cu#?6 zC8`2XwGO4gj`e`vuqaj|tDS=*ov-*VXtPE>)I9nvQfsDGNI)(my1Hk9Ki#cObIS~IAJ(`! zs(B%kT>+#FSVmY9|DP&5$tDmPgL@*p-rUOaAE3Ev3(}edpX=IxL?qSS#`W};J~TJe zc1<>get*?aXSKP~1As;Cw3bl5J@?R@Vr06zGV`uYFXMh6#PC(tO2%5g3rG@Qwpd?3 z(2Kz2`_#?f$E%ByTvLgs^XbU()s9#X2Z4aU<6rW%DT7G1ySpB))qw^KO4HFR|0COa z{Vd}EVMbgFz(3c1pIq$1KQ!AanG?Oc zQ8;XAUh+^RUObr7{~QB!C}?W%M(KzA68Vij;h%wC`iShgnPL7)*ns~eBMSven{vUf z!V^n=K6Q8qH}j0!{_{ziW3<+md!2nNN$JokNg{Dp!oL1pWq1#l>Op)J8x5LMHXo1R z3d&AC@-n!awjx_Vn)qNoAc$b=`T9Yo51GqcpjbaBXhFS>SzGr_d-cF$q%M0@(;_OO z-F+mo$leEC#ft0a&ahWH^z#y-Xn)SCG+ft`6EU-VWjy(FW?qEYMJAC9bR`mQ2KPk1GZ0F!(8gh zW1tXaNgy{@Ugh1@3O0L>qsCpOWEu^F^_BMW72c_pZIWDh7pzkTVxDdHEi#JXoeCUv z*>C9{l-b*nFMG|?Eo9}6hG*={m6={jK`~xs_e%FHS$_+>hG@l#3%p=M?&JuE^VKN= z(H0eLLVxV{62a(S-Tf*@G|RpU+PeJBf9vUMEtjwdSmktq#E*B{5>3-us6)2DU?fYQ z*48<2BFru$&PEX{rG?aYB6IA#NSd47R66kz&A5V=9|=C+cm@_eoN)Xo&!K!^j@WpW z7vk+r|Cp0WX$z~sD(ns`b@Rgj#&Gc=B{5(%=gZgZx)i}gbBX<@tph~uRn)rN{x`lE z>p%>+NXBc9*|}dsl(y?>mgva!S+jA2j{*QbX`J#u1>4wK zeDe9DU9B0e-U*>t5oF%h|0Al6w;G1G7dK1!Yf(k>Yo+wm^vd1S_tC20KXbayKPv_{ zd1T;ejucG())3)@n_Yf?4zHBvlj7>f?`op*_uC#w9CgQfgkSPipsgp}?!}r6Vc~2-xdTyDNO&2As!Etqcv}Xw=dtzA-xC$& z16Hl?s44@sb=oBl_27xRePDDOOc_6WarV~qfRNATv(-Zo9wukVIr8o)L`U(`dmVM* zNGG(AwauI0O~Jb7u2_u=3BJJ;)5pj5gP#r1Jx&LUUG>bxT>o##-$V_e-AC+ehfBre~}-#fb4|3U%A{~ z4N?wIYkJ+1@XrQmtX4V9mRkp&EU)B9Pj%)r4xnjB{zyE`^$)Wg6Tv~%sgk3jDViM* zp33mgaJnVp+gw$MfL;}5dB@Mj%(Bj4YLedpB1N!4uodJGnM^$*P3!sDy*7i{-xmgi z%4WcU%TX$l=+%MtkC=fLpd_*d?TK;sK!g0M&8gBBHhA-|97B2<0C`CO4!Md8_V!IB zm!B4u?NVmpx{lO8EpWf@x#9X($oWdPk1;4J((l_mHDWFI67&|rniU2Ar_9sPkYDi2 z+}tzb%8}k{I0jI-|33-?nL{=qxd#$_15c$b>knn!KR^WtiS!iEVJ?tZfv#IJAh{x^tPCHt)+SYq*E)+XZrq{r7mZ_15WO` zpyW?j+rx#mGI}BG$yd7n0pfq|S{xY&`y!x_?%&DMf8`BLfio=LXX1W^2aBm_!@y~l zX7mS zikCB_3l-ASW$-ggZO)C;lod82M?kI;{IfYB9EUkloX9uW?xva3TJh~VZ{oc=O5P5y z&fxEUz_(T1BJi9ZeL{M??x6!PmM1+m4c>*@IG*lhK}ddy)<@CrXC;2>|CmPhCv&To zCRy}{M(dmNiy=(}Gp?%r@kv7Rzj8^|>zcd{bx__r8VS!iUT!a6Nf#SkZ z6k}l7D(6iW=D(sr9Pir0OMOk!L5wr27~=(?O$*=@4hSR*VOL}KIIKud1wKw5iRiC= z1VVFN3VF~m^j2lv!g?AwY0=fVaSvP=`~5HaMrg1{P00WX4bz-5f%-u?k>~yCI@~}; z;RyjTfPu*Te~xh!cWaZLMjJn5wOY(U_p%IP7xz{EXW*V=#a2=J5DXl1O`on@&6V3h zC@P)S=JwDf)DXk1=+M2u&NLrBsKTiyyq&N zEZZ#$ATWLcqWU*Y7r!U*Oo3tGR5Tjv)l7GjJ@|^0@xMeXL1gYMMp;N)x~c%F|55gT zNd*9O`5!ft7iIn{&9I`F4mMLvc*=uYm>*MlDMXcdzgU3il>>6auFBC)B}d`U;~$O! zJiU&hm5sVtAuf!(Yh`ADZE+XF2Jz^vHp5r^o5;FyBMMHmgjX6n`RqOZ2HX-m}wzr$S&_hJJxXj9j_g zEGE-;*;6ILsrX0bhk*i<>*6_2-}^z@sr8v6#o`vRS*>m2X)=+doc(Zp`>Nx;BNlOk zY?cgalDlu0+w7Y<~&sj)Rs;>MDhd(oF z&b`vS5C<3cgBZkgG)V0+{Sk5&Z<2I+L{2X9(8LXhs?mo+)fGBPFWNG;=8}|)MflFC zsD0jftnV`Kex$sTetVfp*W{NwSfP2<1McJZ=FI*cZe5??i%IXRyeIDKsG=((?zXC{ zMXSF4*&rd~RdScOVdfHOuH%4FtmiHsq9!)nYm=5r0j7$geXYI6WgN|~-dRP8k5Dxm zyu|0P<3zE`68>8IfVpj7NN{>miCIxzUBrYODlU~Jl#Vy{)j)DrsLdYA*wj2dTbEtO z#5Stt^0g4$RPo&ePrtM&yE@+Kvs}7CoBirm;fnu^pTv5_>5t_TdwR%M14hNfySyc) z`Ea_71YeD751!E@`U;?fViir&Rv6lXy!z9#*7tI>Dksoz4pxyH8IXRf(6@r=tOq<*ZJQbRHc2?$OIePezu^x!{>ZlQ)8Rb^df97AJ{h*b8Lyw>P-B}A z=IcnuCijb@HS;E4uacU7Jk5wWCmPhHmeP(f5)mHz;ogB-_CYRe{qRA(= z>%sH(+TAgWCVM$-5T_bF>RL@fbw4_%@2)X<@noW$OxS?lCfOFC?ht?4H5+u zlGj8|Ndko^&R^$E>2jU7m?-lqgBsq;O}EX-P{oyi?{EAWJ#+ZYsA?ExHNs zQEQTPRuu-DMe(x4!0v<6a4nvj9H+PGEt|AfW+1A+q$`dOD7#Z?p6VRF`$j8j>OVb2 z6FooYEb+tH*H3Ce&+_=raV30?BGp*FEzF={tr{U$RCWd)q$0EWxEtCEk3a# zEKexWpJc)!aF;tMB5EM%$~U+oelGcz zPjPNprA@dw;8oFdx>$zhuqMP>yU87}R}cKX{dYM}aOFkoFwH!nD)wyBiU<@AYrG(rv06>SF(q2h?;U=cBLXt87f_u!11pVTS0uRWBYY0m7OUck?eg3#C2 z?z7Fz@ABfRm-yxW>5>IU_;a@$Ft^tvCQVK;hS0tJ1%AYh*l7*c-zEiiq#e(`!|bLk z_n!`ms;Wt&;4iRuKnhi>1Y$)Wc{)jn#EP8Cq0@BIl!QkGS+;T zOvSP7S-G+x=Xq@gx!5Z53?Y1i6NoNa|HEziNVQ=oyjangN(FgD!UU*T4`TUey`lm- z%|+eMgtYZ7rNEXUMBXBr;9U|jSI=H4VP6e;DFI-m=Zc24 z66aP%6ev$}>PKkmTn_I)rHlD|b~BNr^*tCWFBIS`c767|ti*qZ04$L_!TPaB;W0x* zoV)o=XsKyj$I)8eHIcWYQQ@2#sSj33ceoOn{1Rq%C7w4tKEl~}fo*nh>ZNU?hRp8n{c}?4=oH;X} z=$t9}Ed$0p%U6`_=^oN>Ho&I}uE3|_HiUxtefa(fhILzGm6!@w3ybAH`A&~zIL~(t z80lC&MWOt1G&UmW_MNKqNNM70q6eR5dg6VDw>@AnYqH0JW+zFBb?!r_>yzidC&^#9 zKnavW?@FK7=eq+Qf$pN~7m+T1FB7nXo^HD(9?$22evnsY&(CKZAE3K?W>)z@cV{&& zTNQIbK-!j=?^(_#RFEJ@mrEsmYxz4a{t~X z1l?UdU$$nozFu9xPg>@RAI1kziaHl`|57|3|D+_8XfB?wC^RH@bRKLeb>MZK;}C#_Q0xR5 zy|_k&f%*Fv9_HO!cmx6%Bp4JxUuqcq0XF=;{~HAUwSWCD1nm1cab!=zAHx>>=tLsl z#n786Q_nLz!N{3H^RJcdTIlZ{b{9TL$M;*UaGC@e5M9NFThX9bIZIN9^U7wj`Dcqa z*W~GoVg@RGdR09%(LVO}COY66Wc@)gB~bdE+p0T3u$ zgT3xwqsARTmOpyI|924ZenUZ~vKoIf|0>*I7&@E$Ws(Jn=7#-75nimL) z?jH8_v!oMVAUN9d%b6j16(7xZ=mC#5Tq3Sndm7k&XetR6WKpKwuC<}-g>93%gC5XhwC7W`j9!25rM zAoc&}5M&E4S+oN7@e30MhUEX_3jX5+_+PXy{GytY&xsRpV$}3EWJ4TB@*Ud;dn6k# zETg8TCd!>CjWXE2WQgF!NsG)oY765x97vZ}br+sqcD6Sza?TyenKq4aDnF%*rAAV# z8{Eh;x&s-!@TbjRe{uLaoh-X8VzK@7cu}&LGdJ$2fFcn5u72qE2UAt2tRfLjbI@c= z>gjOA9OAaCk&Bb=EJ95d2Vv_G4Z#B9FJ&#f;wyTLwnb}ZgNe%`D*7*pnSa1CkB(n- z4kcNq-nt@I=bDwbr@kVj(ly9AyFs!il@ktFN^cyjczyk}9p~z6E+9bKH8hpU-M0Q} z&5@+EYi9z>iE7OD0K=2YQNX@F8iH(lPmp=-KX-c}LhCoz%KvGZRXO(uviiZ0tfV;| zW7)#@5DOoAuHla`t%-Hr$$Myd0d$@<*q4P$6E{oxDVTx7ci3%zmFthjjB0Hna5yZYvhxnM_~I;jT(*{_*Q$embMWSDaQfBQE)o zt2>iVhd|>(RZBrNlzIEi1dih<@qU9i2XABDiobdm#%f8@M4)e^99+GEgRty~GWTjD zBxpVYuMzk#Ca9Bj^A(%}`UjIyl5gmubvD&m+=k}yI}Mq~n09(Y3>CF@fwrW59@f&^ z)`2z#e97y0p-Z??$h~%5$g{n9rDi*Jpl<1+;;Ib|J;C_RYq>gtkZ}c!sE#f>E+*0| zxlyU4RU&#{6=g}YhoqX(2GzoLXt+>F!C0@#9gAGp&q^Y(-+o}~k< z7JUkcs9n=gzHwB?o@#LBQT2eeqH>b+^<(lBMSNsKl7GVDqWx5+K$b&ePNG?O`;)H( z+jokO9j$L&1#SE8`GAOpZc`U3lYO;!c!F|dVC>S6Od_<%TfjSD zIBGyChi z=1oa{J%M9U*6$C0pXBSay<4()l{VAESyL73L6?v$5bq{-R;a!D_evDoI%jM)lYX`> z5{ps&zX#%6Kwl07OOpJr>-wu3%6~cUo?1T8HxsOinX~bl_m=Ai;aKuvttQ!sFJfo_hVc`9%KzyGAy{GqHQ=buQJev zUb%%@pfK27CmRTd$luPex$km>s-a)!@sV3iXsd`pk_Semic@>d_a}x%JyZ1W^n%a{ zr_RG6#3BgDOiGfs)lT^}U*@nkwO8k)K^oIAZQv-pACbylJ)8}mvR5%?5ut?zHxd#4 zcWYFYMv#BENeCv1tc(+S(@FU9D4vrO&?YHwBh?!3huhrM>nJs;!V8kQo(}~~D2{hT zpC;d(oAS1!j-Ddf)*ZL+55*Hq`Kd|y!@>)8L(k<}nr3M7t55@|HiyF19DIfaqp z#h_h&+++@_m~4&{TQVep1=aL^a)JE|Z=GbNWD>7FVv5?h2fLNeN>pWn#wz%(-# zU#c-w)ZE3lz;_6=4$jGGMkU}d;pm@hIz{48kJWDLsR#e1&ZnLbkWD0NlO;8*+P%JL z(_iD(XnmJmtXrbI@$?vxOwU@2;R;jO?9bfVQ}%9gQM31VT1k2}E7&i|8u(gW4Ou@9 zn&1buf%LWrHZ6;kKWY717fd0oex*bRD6l1JRptG_ii4y)I5E*ydB z#Bu|T6Xw4(Bbzv^DmS+M%$nQSeqesqWYVjXmWUi}D^R})qE6%xdSa6cmT8{ft~g0; z@VW9RG2T@tLYhjm5)MBMJJ1_^kUhVHF(vQbq1?+(~NSmS-%WS8OIe!x49U1*fNn@ocUBzl$^U9Qq1Q4ZQw}ze0BD$-B&;54dL#n zevn;+XNq!nu;6m|w52Ljhlx%00a7{Rv^WN7-*~-n$(!&FoofP#)D;*8=wU8?{ceO0 zG+9ZgquXG%(TRYWKoM-?VWse92J@R+Yt$88H0af3Ut3i+Wft~BOMpx=U4yx&->HWS zi{M`?5LsWMj?;&Bb9CtM>JcxYUJw+_7cv&U10+$tBlv*-3% zNh``>FVHTZ{|c&NW0F1f|q|#2z7aEE~Y18yn(s~5RiV8xQrWU z$ZkDRbLkv7Fu!5%cQz_^nqPK6T_Ho&G*{MlsF;&p*5SlcNkFk^PUpN?z8VhtZ~d1` zhZwFD5U(7g{h#BNf6-cDx=BJlCqcxCz~Wy?UkOQ##~8tkGb>Ma{zb>@%{FNbZb<_} zkL}fy_vkEDDRv!o?^eXc0{jfeFV8xMvc;-=21igV<`uBsSfyKUF-Ug@RZ++ft%s(f z4jU-ZUP=l1ehqly7OTDg?7~clg`-UItqNy$;KIA32yvag!Vc9;QMeQd%v$5eE_1{5Xi~111mcTd7i(U^>B!Z^t!Uz?i z*_p+-zI`cQV9!BXTjRNL6t{~Fv`3~q*9;OJ47leZJ@3`5T3sV08%jQA?%*0;4%XWI zCD0a!pAz97&oz2hcA89BQnFL_Yy~$wx}--reUe@!w+#AC7E$_in?l|->DWM+$Tm^& z6--BoK4P_i9W{z6Eo1|6TkEgUvgWSqQ9rL<3IpBr;rpq!>f7K&fA#)}$eIb`8a9=f z7a|Fj9ArO!fCo>u;!Qf>Oz@-p_6pO8>NjF~ihw(M&-X<2I{p;1PI6`h-wvvOdQ^u& ziq?op@817ywVgiMqCdFV0--nUm#=SuPUxE`s)qMtSXi%Z7L-kKeYn<8UB87pO=nf$ zt0}SXVAI9RiYi5rBA4}2uix+l?H^G`ZpxoIvT_be>G96f)ZRtGYSgeA8WUW#=Woer zED%;5g5!cs+2xKB;)$`@MDJ0mNyMd(S9S}mWl;vnF?SQiCW}t*+_6hKa{-T_R@G8u`i#vSZ62lYw%Xa%IHfo(_!{kT~?FD6y$H;d|GkV zyj{`itWelCon`3yIT6U-SJB%>G?J6cKnR-UnyIh7*s}j5@INH7C;;a@lvVO1_cY3gJ zV88u_j{nrHk%alAwy&z|##mBTPQR8=F!uvVo5oeBR#}(0{;p|~u2qrn1NMIxH_To2+$yTLnKk4~rV^{$SN*5l7q@vF}Uqha9uC(Q3Ux(}2G!>?t=) zqnnp)%?mSi43m5+*k@Ob&Cd_>fB9P&d~l7id+9sn9S&GWs!p;b{^|!5E;-8@Y#@#lKHSKRoI-`B7|dN-u8u$5X)c>bE87nD{+iLb~L z6%dGSJylPCI#NVUb+%Uo>mYsYlbSvE3c`~2QNR0y%+{vcMb}fGx|z6_c++G;3pLbx zju!^cWP%6Ptv!z%^}LOW@}W?uv82Ouo9{CwR|PzBfeW&;pgA4}Y*^2nj0X|=Sg+IP zWM(G#C+((G1A3zzjZv(o+bG*r=e;<%Wcy2|X1tDOs>r1<@OupgNn=jo2uZ$`HU!!O z>`V{183*!LE8Yiqag_pZWmLbY2m4lq!Nj$&_YU1llZn7)wvJu8Z4~D zL;ryWmlk(WVhA`6J72nh$=>h)pQ*(QmZ!=cV?1A)7MYj)26ZMFo&m4JrU!qL-@#*nhjwXM>G2ry ztIatPGvl2dw6h^Pqbg3$IwbOML}oTqRkqmk z*W}_MG#!O#*e>=#0_pPf;hRs*JFa4WCDO0!?Y4GoF*6Uk5UwD z43upQG#xI^m2Q*O9nQ0;5f;B+{Pv3S>=629nchPCtDw%;@6T1zc}u;=O9Ct+U&{&M ziUj1ZpaLvRU(4aDu-DH0!X>YkzU*)zQSND%;k3Cj{i^Qh`Jk`fj9S2wH__&X`lJ;m zi79AKcN(f`^DP!Hgw!=}(z)xCKiTsfZt5D^%Wx}jf=o@SLt&MhtQmr3UkaZl{_uGv zzD_;5a6*C?!J}}>wp(M0>-tP7Y6m5Nl7>?`2W6U3Cx5bs3+o*zlRKvNS0?0#*LJe5 zaqy`qZEYxMaimd_1))~2^Ry>s)twOJTVv(Rg>`zIv|T?1gwM$h&FUmdUO`=e2?6$h z_xEj~$K)Oy+kwkd;#NnoiUl!NqWRjBvpSPMnDp_)9?0eu2?O?0aBo4cwUx z9LW>Y(=sHlL^wZ^S`fUw4XWi7O>_M&?tq2oI$b?Ivy3|Yw)er*{F9hRG*e60(U`^X zq%+jxL(%X#e_aP_8)C_>ZDRI@gLtc~f`=9g-j_7JXxAcSWR^YE70PnI&cpp=28SzK>;?ndka^hVJhB_kCWk=k@$EuW^0Ob*^*X=Y5uI zGJ4B%P3K|vt7Av&rU~vIA4I=BxjcV3KjsCI-&}9{!6jaN;3;L-Ndi-MJCTx^ikH^r!L(}t6r3G?}lNBYVk4Y z&gm(`xNAJ`#3MXeS7juIQj0atOxab%&yz`0^S6!T#X0&j6kbiS@9TIIcVC9^w%I6N zN#Mb}R>Eri>1t&57f-^b@|ovejI2RJ`}km1}tYiNXFTD^yzALjUYG@@E(SM{Ng8tdJzEJ{I z-*^4;%Vvoa9qa}5mBl@@Ztibv?^(FsFzqGx8flI)`041Rrc3SZUoZ9XOaE1w%)6dp z{r%q28(uGdUTeQ15+8uMnIZZhf=O4Pn*F^p*V>%QJL`RiJM@2fhI18bK6d5y7#Dr4 zbg5s~^pIBV(C$66*W~uxFeRBhEXNky`p}~PDe zZ!`82<2RYAf-l&K7n>Ye=X=zMXW24LZOq4+wLvB);KDd ze@uf#|H*uyjmdeb$H55uT1VWT8jne-UHKt~*&k8hDCSnz1@6OjT;Eyw@5xM_*>ikrliHyk7)-!=XHOcPBlJx^a@txfS?J5`-@=|6C%{($#z$( zW>x<>*F@89QI6yX)i$`kWqiGG#1x5=;PZ+P<$^!E?iqU6RMe_k9hnMDTIT2!AFeg9RmKDRdR z$PM{YR{?z?aoR8!LN#MckvUFW)i&e}-?c|K`|f(cD^oe)G6e{x2A9UY;1; zj^-ktQ1_mgNv|Q&Q5W^$Ukep4TD2tK?k)Ld6{kpgOum{W!sojkvmD=Op1gzipx@VN zgM>#3B=0gxzxSX!F4>$vRNM2U_^D*SuZso==?QMWWgnw=JSXxU7#LhrwEdz+iJRN5 zM#)}yanL1?`nisL7#VrlzZ#>Di#qEj8q;4IE^BOqQEqe@yP#t!Q4?Em#xUSVv}VdZc>L zuZav^y2u}{=bw#ma>}Qk>ygTDc$%KDKm{)(KfCA>t0_5} zXe059knB~g+U`n@Ik3n%2QOBVRe2|{(bnt9vMT*3_w;F_5B6i_$BvxXcem%cY$W9s zaqWf(p1t$Hb-Vh;hH^=jhIS2HFst*!S0UM|*L&>U!lJ}gL_(si9l2i0ius2JCwO2ELppsEo7!eHt$mZ_Xqm@YH@MQHEMCjFE5yV>VDi_lyj+{{4N}lo|N8@ z?m{AMKV2}}C%|Q;{iV*+R{M*mddwFAAIVdSHqVOGUby)@sLrs&4LLrj?nx^7;--Z) z{MA%lixmxb`F^NLeuOFPbbnuzM4s#!a0n&-djD6sdtCUL>JX`l&;3uhcZJLDu?ji$ z*kFWT$Vp`6iOGnWg_F(Ri~M09Rb#$nxI~Cd55{p$#IYXNL8v~y>2zQ8g{)iC+?V*c z(>LN>E_|sIaEgW-Mgz@V$v%zjPNQ(&Za z5?nhG7-%-RC}x^G*W>lLxeF;}c7x03?_vG(&DZ|c+~UQZ*jIV#ubuqPZt?|RJNQy0 zDq+N}n9`d&Yn^I4$Kv>0wzqC+xR}CWeEgW8dXb;sViX?yp}llP z{Ie|g5AAR4AAgmKdy2d>jY%EskB$h^c<4x3FUT%tO0RKSw0YgLd!1I@DAlWb1n<$t z&G%9RarIZ0@xHK&Ecj;j?%0W0z0T5`?`=%3-@me~FR|(}cgrMmz1pR+Mr9Rnq zL@#X{0|WBF|Lb%ivoT#nfZL`o>Mo6OPVvIYXtR#7R@b!CXWAxh3h-93PuY+xR}&r9 zNY`$kcZ|C9wM=q{o0;58Umv?(86iSwujhp<`D2l`_&1GaB4>{biJwu-`H7|W`k55z z{QOdLJubS&b*dum)7sq9NP@k2!??Ha`S!05cGY-I3C0c=#Oh28KHcMV_NeX{=fSmn zvHoopS9IIShN*Kp(qi)&ufHYV<+Rc){Faw#=lpWb_tm>Mr#!{mZnhuEXj8EFNBh?5 zkmRmC>wb5ve|&9WO!e{}k@It}hpsM&zbMgpmR+GB&>-g5NGv9l?bm549^yUW`|PmM z)#$Z5Ok?j)=u={%+lRPM{p_1O<-v5k)F5^3(^}m%Up60iFK=PiMfX<~UG-LJM|Dx{ zzAg#Fa{lV0^0cVibDCTuV-6-aizdD$E{nTkt98flE9E}+C-L8}t8ko|`fwaO5HC^s z=?t@=TWs2nSIv)!^UwdrI`XQu%+W5|tnBl+B=M!A+3NYVo>qdGRrK`0NLjJO0y_V? zi%Dr%-N9Xf)_-kpx<0!+Pl}fGmX|z-oUZrEy+8A&Kqt}o0e*`hhu^8AF176F_=7m& zj&d$+-Nb}kp~*w@y_RPM+e>=xyl!)QK2mZtEW#h3YV+ce_zttuL*|k@)MQZ}uT$;& zK471{x~+oMV!?|O+e+@Wdk?NNayWs;& zH<^F%)CW6ArJ{)&Q=)}mGkNpl8CQ_|( zI0E`D!#@R2;KSz>wW`N%)BPFRium~YtnHSG?4H_QhKskq-AUgr zWoL28l>Nh3w*4o?jgM3rj%&wWLkhiJN@2fMIi$HqsZzx{i}OZ^KJC_*R729g)dt752Kijt))5R|zJzS6F`bc= z?s#%#!1h$4Ie6KB=d>C^1{J^Sc>0Bc;UkLCj8)u0WV3DWCG*k*yE7KwTjE-*k&MQH ziSIcbr7Yr_pW}9UJLFkfF9!R22PXD$IO<#UzO{7Vl-?D-htu&MONr&qBI%R%&3W!S z`GPglSc=rPxP|&_J^Zpg?dEE7+V!8`^-jyHCti36y?m)Zsy4$7?9t)0`JM>9>|cwk ze0=+*0ZWR(!&uRD=%x0~ou}VL(>Q=KDJebZ#Y8S>?+`av&ZU~9Bh2I6^=ikKbFOJG z3>fXGF!|`d^Kn;()4u)MPN7d5{J(7H8IR0odEAw*ZnllZ0D3(n{^f?nj>*VV+aGro zI|=O99{TEbuHU#QJbx>}n)TTdGW@&BmmvSUUenJ`9c}0JN!e8?gH-tv<$v;%eJ{uP z^@~5r<$=`&6MO;(+TNXmU-&IO%EI%v5Uh8&Tw?9u8jjub={Qd_kOA%Xf42U?N1t;Rd5xPw`9pSvK%77q-t zXzUA7o8Vq`;;u3bwM(>bzB@YZVqvvSq(%737B0lD3^QJBX1<3RyL!(3eA{k@5-O}| zp1Mlh(eyVuJS%O|3jXfPmPG7HH}HM-l%VO ziT3koyruVz$;=;TI2ZChd=P53xoUsxdp`ej@Oi2POTLM$Z0)UnOVjqw5KrBJ#x3U= zM6heiXutKTP67c5U>?K3$x%)=n@FN2o|_uMQl}!(-pgYHLZ`kYD6KCM zC$O$9c#Ilbp^AG^`VSW z9I!jqO^5NAt~awIx(U>h8?=Ry8I)4CF*d1T#%niqWW-nrOBDzxOI7=w}P^Yik!ig?M|sbN!Zmc-&U%N-NC%tY%HXdtsAm;XiAAhK>Mt$PGAUF z^NM}1#!h`>LX$?8Q5Ahk*{T(Oq-h7>1bKxf-Ev#VhVNGQ_Gjp2W$|bS@qxgIxuFT{ zm7AD%@*&689Oq{$@0KXO)Cy=TiabD5G(ZZn>4X=vT#|aUUWzgacF2tmxmH}CfaI;u zX=lY>E7~_k{&wopKv_2LeH}^(`$5`t;I4eHAH3Ke`wYbcAchqbVrg>%b?)Mox4i`t z=(6khxuI+O9DOCfj;9=G{^Iowoz3e@Go5~yh^-Z-EDH%%crUnnG7+X83CVm>pKf9- zHWOz~_WQ0k@3O~`V{vbQ#+I`|i93|t-%qhn9&_ePM&EobbE5#~e9G6h*yFFW*X*{U zY2RaSdYI%kS@Vsa8ZWtuptLVVudd)yXt)vmbhoXEoVUlO;-s~8K0`?~Z`Y6iyQHF;^f5~=6xEML7gWtIJ;Tj6Yi%F_h$ z>6ESxgzf8+$w`U^ z{AS*7%wbvkao$2pN~F^y8YXV0Z71)nLu zbSYkmcfhv9T9mfLe4g>Gal5x$q1`6-v!mwjcU5Il7B$x`Xkp$vw_%y5Pud2EhVrco zdYIv*m38y1ic@x6Ccb@0=-XoXS*E37m%7iI-U|0FKZ#xXWxR`9e1T#6d6sfyew^KE z`Aeqd{`qGF#h0fU?}c3dKv2#q=CElc9Oj`OMV?jJ%fMD3aCu7+`;hjzAC|_uJX&mG z6ZdR2zigS9+`7ebzbv%**XHJ5%2{^4=B!gfkzf$DuB0sreWsD?7{kl)1o9C>Ud$G3uB&>PQO>SB?EX-;FalfT#P=hkkJ*-!B=f7&_VWm^aSKeNopdWl z3vmK>E^(-br2LjS0fk1MUsS%A)_>_2{kiW1ALTwBa93*x@K$21h0_nqy#f)yE!QIU zAVJG_z-xKn^>ToztL(dERrM52mK5Bxzg0uQv2i=B&rF80v727n-I0ttz#|}ryu_gq zB783d7@{h-yXAg2kAPr7?2&Z!5LGdGL&@0vPuN7hvmKT14N=*xT_A8@Jp|&7O)K$f zC>u}s5up0<|5E)NJVhMoruBpWbqBKj#m#GpW7@!tfs*%{veuupEs6s*MKeaBpq!`LBdmvTB1sLV#K5YnLzj&sR>Z zP31Yhk_~0Ef&%gBQcIL*?(I-5$P2}-#6nz;L&#dt($PoB&^w6Pi)taS&M0op7|qjj zEuvN53powLz}tUcwtWK!Z{-v6W?H#ipSX@xwRMa}dYvsl+5|(58imQ}S`^tyHFxx1 zUk-p=4re{^gw2YMm-CUtjZh?jP?%h9O@i3#>XAD2G#Ll@SsC>=E_ZY`u~QNpa-0su zN%^w2`{!GU8{}>!!sK?9eGlRoxMK-hG&MU8!KqL+$6Ja=QSR?e9{mA?ZZkCqC{(@P z3`rJ&ZJ9M^NAf5n4G=e=X8~J{p=-Ler1D+?bISc9lr=;+;|;KO3z$x?aKB5&Jxj(> zBrz}wLlXHW%zKn39J+>yk~D)q-_09ZwOe_3*?&YQPD zDy#zxU5j4rDZNoY`-7xI#6=w+>P2x0xdtn)p?Z?J(=5y@?9t?HxP1NzK>4!?o~(=$G`EH3DlAiC*|&`RK;(MV~VTy{%h72}o|7 zr}EOcp=xmzP&a9&-a|guHdteO&ai=A)|og+$=uOL6#^G060-^k5(P(Cl5v#;LK;Ny z4f-0o$^wvSTN45vATQkqm4ss%!R~iPA=mazqKN$FK~Sxc0mTxeDR0$%S%u9+Wlh>6 z06SI0kv!_?kx1v371MXN(q!C5CAtV_5HN4Cd9~ah;+_?gkbq#im6ey0sASr;uq|nZ zhtjR%?74Tab-3oEtnt3HTOAYs-d!^7r)RBGxQBEpBVD&u_NVALU%Ig?wnazg(MT}s zJr_mOG9m8R_8fH&7qKb>No{vp*pD`GKP}LeN@`GzerL_rUuocfvhU0pGku#E*qmXl z18Irn6Yr2&UcWuVV!fQ?ICYt~?ty&Qv~rT%&+qQ#ay-RHk!gIsc)s+Tx3DdJKleNH ziThyapE4^IYfk~W_9^vdx(gSOvx**?AnethuM z_?C^wmj)l%%JBGp(^PN0-=I8!g4N&3^wmGscuQaYYS zctgWf>(|p%-sO`9nqS#Yx1XinND&*aO@tinay_AIQVNU2+3z*dU#|8`ino8NEReny z@NW&!W1h?VJtC4K_B#vh3_L$xAgiaz;R#38=(>S^RI*cvrJ?$D9#9#lHS~Ghj9T25 z165o~KBbSxhGxP*XSSl30CfS(~azw`NqpJL;t-5YM2{^RC9PxauZ6-N3Y zOuvtR1;q(APNr(ZIGO+Tbfj|Q=?LS0_D=8NFU|=q*|kBDl3g1V`CdpjK8;Vqs6#&w zWu3;SZuBuS^EZP&z5C6e?extyOZq(j(GG#0_Icy%G=~52)Oh3Rb>BZ=yC#--nV!y> z>C6@(F=K-04}csDFga{XUWup~75?`86KzBPC#B!|?ddTEVX3Fm!;)O@w^>e%eqP=r zp3yp#WBP{bM(Z_hcbs{zgbvE*Seld-eLNhg>mk-r62oz);oT(KiS>K*0IdL*jY!sO zz*i^<;6L4))o!q7vkNp`chjmyg?=5`{{*{dxqi9bFX@vqH+r>y8LF~~x44|Y5jM&_ zCw9N2q+63CM%2rNjJq4$3oG#jN>jMcBICbypd+%yPUA-8cHg6Tu-?q7u09`mtg#Wt z`yL3yeH)OwH6E*Z-UR~$8 zGeYE{;lTJHU1IL>wT zW^vs^%O?^N(RD0MI$sZG+&ZOff@7ub>pByo-Eq+U$gayiNk!TkjuJ19zU!bVw2Z}j zvMG@TKWb|qeDPT2X@B6Bm?ys`Z>`s(1xH;^iL?fLH=e2t(mq1AGw_-FTYH<}llgPo zZ%i`B>kJ>Vb9_;!w&PTcsHkYgu4_kxWxcIDm{|fIT7QdMLCeIvEX69QC79I*uDKq3 z!5D(_iOIKPs1$i^eQIAcR&akuLe$GMyX7eJzv3(U8{_BHYfr`eV%Cy`{?`g&W9Ju- z70`1*&CXVzNe%kSRE~X=pEIb0+?Xc|(FPB|(_Zx4?Qf^{&C;rQIU3@3C`PEcAK_tq z=So7q#JLm@cnMEJB~1Mc<9r*fnMb)B*|`^p>Krl*Jkc|Xd@4;6ZFPyfb3ApYM$YP; ztXWZ@ed8a*p}qQ*exm#qWSh2A2Zvvckdv?`(U zw-U22&vr1r#%}Fc<$F9UNKHEEG3WL!GMdMVKOWQVbC6*!gcG@r>a#Ch(R3)R<_+G7 z_9#73vBhBJ48ua9|27&gs;gSbE9pc{upDy|KR;fHPR~AR$Meamz*|L5j zu~KOS?cRF3hJZg^zYs{p8?)_1k0g51CKs?8HO02HT@;Lj9x%z=_h{m*(gKzt{RiRE z$>mvgspv3_tWR0C?Am%u*n8&L1!l+x+E1Qv%7W^Id-YZ7qFWCm6V;cBuN89dQCh@S z9MPMMobEIxob?2*MYQChn`qOfRZY~2THTctZ_w8efBI~W??NG+LMt~JpL}^ zE4G=Id1rj-UU?XLB?ccIxC0GNsJK9P>TN(qFVj{x ziFPx=C1mC)?EghrrrHi_m#%~m5;9iC^Vw`y4R&@xX3k(W!U}*fR4sL5Al{HrFU}8% zQ+ik)FU_*Msj^0!=EycAtYer@q8U1tbyJui?bOCjqlvs%N~@^tEGx^aC?o77K}of` zscNgyvFRXM?N%ceQAU~~&2~|ybW&)Q@XR*7%kl);6wC5xW!V>f+@ zmK@X;we_`iOsK|@6-}!9;KdBc68uchn#7Y96KwG^;rf2AfstonDOci#nkSYgDZCo= zD1}A>8iT0f5+;&3IL;~oiak1iKZj6Di!fvQ1l(L8pY^5%aUz%Cm_BKunvn|nkE6}8 zRx{X>D)HE7o|7NY>Ep7_N$sH@*Y8pe?)UIx0F3db{WRKL4nB5-=v&~&$uTzr(%{jD z25Rft%&1nBpu|L8Fcu^1shvf2wb5QaycXg_fd^N~b zGc>?)#RVui2xYMKtlJzrMFNk?!I@IIm4x^AL)=m$m8^u!&}CN*)}H`S2x}Pqx`}?F z3Ys&eQ$8DtTO+NCC7kpIWaDVu52bR`p98l6x@CUA$tUzI4UHSooxvV!njIk@+oIO2 z3zTrapYZalT1Mq!O+!Adds5!6qV^_PLiNS1FOE`7wV|u%Lt8$SM+*z!Z_@OR+7FVm zc&t|2$?E53*BL+=S*DgA`{21|uwDj&PiG-;aJuU@t%YtLv6*BHadQ=w(go`BhTE`) zFCb}=tDivar;#%6M#5RrB|%4HG~*96HXJd*%F#+2UKEoWV3(2FN-BC2~L!fJZLpGS=LUlLZ;dwwQja;nCxm&af^0BCtiwa8mlup2|^Z+T?WP!$Xj;@wdzU3Z%TCl-p2WIH zCKgIdusm?zWnGwdMxPP|YJoRxf`OAJPCJwCW4KKI`HQ-mkWRhm^a{I-Wdr#=k9F>H zXrex&#e-EqHCQ*+tpzX^JQ8%w^8

!v$!N!mA0}!j>f1spe%EdU`#BTF-cJ&3zRm zcU^XQU5)CVOg=`B=sYz{SaLGKizaaYgQyRz-RYGQhOnC!CJeetQidRnZ|9{;hUmj- zqCZwV=SNx;)K#-s^E~M)u8SKJuF$VI+QhZ`e7;H82`jB`r#1R zLvJClwMfR!Ws>u0qzTvbbU!{#YXzkYa+W1;g!4o+3@E@!4g^h+R(h&O_rioJHi?!> zJ|;JVoZ1Y0Y3BLcDTm_Z$R>#{sJhgogCv=1F(bVm%Q91SLrBDT93= zK_D%U`Q8fA1At${@c)b-5GtqXyhEqrOxIq}&bDK#ILFs?b!av$B+L;QP~8bU>n%^p zZvG@_1TpT(lvt#ykc^q@uU&eF9%86mU={}TvJZOVk8KvJyE-(xZU7qudd5yu(i%aJ zW|K_LVjRjj(gsH!l#QLHhgURL36IAy+g=vNo(HUf%9ruhoK1ipol#UO^V6+R8ej<@ z0q3exvi=la1Eqkc;9@r@1=N*hO*tdMNnMgL#FGWAn03@IkQA9%uD{F&b>|jhs5}u+ ztq1t$Thr122E&4@o4&5Qkd0N-(NL)RpU_BF*Wl-GtEiVPPKoqXkp|QwEx@H zO&~d;=>YgN%T7RNP;Jh6W<6fS@Ph<EhxLO+4R&ZlPWN2i(Je1pih%LwCOdNOk(p zU)fD(Ko-@eb_{jT@jER8q|{gRssTp=G)SbOrP33PuoODFuAr^2&p>eLEu-WpS;|B^ zP!H+guq~ddtc3;=c>PNPMAS)L@;{J!_^Ck5W*$euw1CRfn|3UcyJ=}zGwNv5_k=!l z{JA|f4h+@`wBlv(WtJP%3bf@pIIR5p^Ff#X20-6w1sYB(*yUfEgsYtW&#Y8=Do`7!?sP^q>5}YR>-F(q+fvZC~cXF}v?bypV&aUa^QpM;1Y_1|V{O?vGQx$*_o3N*T z@tRC%palcRVbHb7#yCJirr&i4D22dk66$ymJ5dPW-Qe;cC$^!+L52e}t75>^3rb2c zbzGZv5uFhNrhkC!9GF-(S8W*14Xie=!W3Mj0#0mr$p8}wX2zfMm#fvh*ZrTUpOrN;mk_3&E zARoXY;5{<~vRM~~b(64o)B!k!jg+$|^X9iK7|21X?*eVWbth3(t7Y+18Ppmrt(T%oL4 zfsg?9vaQW~-lJy@KbTj0m#siWT3a9okvFmu&UpwtPV~RS3*8N}Ad;-?1I%v2B0&ms z=nbI&`}pEk*GO655)1XeSuoxPqBE(Ppog3uLmh3JUj}#2gVgI}zQbwgPnA7XKZ+Q* zjYW;aRo;kZ25IPBz=Glj#$Xiat(>%6^2qac?Dt=d1PlsH(iMJfkOopStRV(mfvsoC z;bK`YbRhAAp8Ej=pIIfEtv!=U^8&S z)dYONK&DR+6QFJzL1#jK!)LO*MeDWLKm+2QsD|W`5U78E`5hKVt{co?H|;(SxH@qT z{5lI<=0mG`{%HuqgihME4VY)Ze7OV<BU1I%wKeM2?JRGFIBGM0pg>KffJOnH zWCf6ojp?(~<_H58L({K>dRk~a6Q%B0yiz*2#X~+qof@P$bwmj!f{`-JEc%!UDp_dNUD^Q( zgdymO53-@#H|Xm;pj$(e1O%@@dNB=0AL^ji*}g{iCv*Si5b$r|d-OpY(Xo7!2q`Ik^z0rKZ@0JC+mT zs75oG|q2Qqe;jx?gI$fZ_xfZ4O~*e#{yW_C(yu3NC0ygfZjx}52DBK*#{Co3}d{J zK;uiGSx}cTdbII+s6B(HSqxafqo8{zrqT4bEqN|uLDMZa)f&DiFartsDgnT zKHP&@;qz=j47am%!59Bbv^XHN$_TsI^lgebJShc1Bmbt3aTKJ3V{B&_-0q#zWAo5k4XUhFkG4Xpr1Gl(PpO9>4_z8p=UEFg;JZ=yZny zKA?a{_+JTGXf_fCNP%u!J%ReEl~86>S9k56qo2a)0(YkIiHfp|qonfkOnxKUIBRFt zp4_)8PMOtN#yiR@q797RTx<#Z62mJVp)!?G9cBO)-J9c<4E1Gynzg;X9C!6h#nOdQ zQk3-2yVTIC7(rj8%20Z>me!7P#pcw@dXL}mxiyKu<2TaVYcm(6rGlBMJ}I)xh+C&? zpz2VEuc_?JHvg{`(FZGo3&i^)QJv zuouPZVxz83ymdDBmGWQ7)y54h<%*bRyM@J)_O@14pG=o3@c1jal&ym(d<=Z>i@Bpa)53#p`EXnPeH*255I!U|O*C$- z)mAoi_ISlbwNa8M!l?5?Z*PmOBPWZ^-AU1=UNh9dfyKlfA1+FWBpImehz~mC%561P%-!~raeUDkm97#L7o;P4Ow|A5 z%1%U*Re3N=8hUwnM#*P+IDTEI*UYG3485en7#GBPQjc(FZtGr^X0PyV)miNu4^$8&=@Nwn)wxp2$)16Uoo<|%_a&4?i z1^`vNK*^18$;2|pzDHO{VKo0XSh;^kh}@;4HE9A4MWZ#HJ++d1maXc#eu zeq8ivf5_b7U|(wP5C6ct@!EByoYeEb426sJrOlj{hTGcC zNj;Y@H~i4EH#EHWyq%g;u;6W+K%$NWDfh2n(}Obg!N;1~Qc@q79(41P!*E^<>J{Zv zOy;T$&nL3!rA2$;_o^O#%6A*bW0j+6ep6s{t3}1zD(~snyUE?Z3Y^Ch4_9CHDwF(d z+cB2fC-qgYWe0fLd*S+92aX;Eh+k3M9{|sz&%cQDO|2LxdxAv;rk1K{Q(1&OHOWY9Zss%~q%6^pGTuQpU`_|d|;K+0VU_=o! z@ZjBnuX@OS$n~oe&+zB&J_3%K-`o`?wBe{ZbCeKl1^0bmk&oH$C;(G`2E(S_D~hq8 z{EV$HJ##MJyvg=q{w@%k$n+9N=!lN7p)w8l{mP?ER`6g$D0wF=6!V7=cz@bfqeJ^2 z&tIz1&%85qc@qpn1!zgFIuHf}q`URW;DBu~8B8O~w(Ueh2L{*kJ#9_}D0^-F=S1f% z(22*IOd{z7SwJRz{|xXG4&CtwWYBxX*Jcl~y|yA};X&2n$WIi1BfNrjG%FB#g|odzDk0r);!lZT*v z?QxvU$2v*#Gs2O(-$O`m@cVLv{AMN}yMfrHMH!o9p(IUnwuhdw6@;lu1?g5igl>m0 z_zm((6q-M2t2sk~WS(Y)j>L#m@*a;>w~MRF%%u#Y11FYh>7qn&tjXgB#5>wqfJM*nbfxQl@rr#aYsLH;U$mHeFG7*EE-Ycy9Kw6v z?RG~n&bEy<*jkr*pwDx-MK@p;+Vbk`!J@yNN2gcu@Z4WEg3+k7RK{{5Q)23aZv(Jf zq~Hcjdz*ik17l0u=ixah1zN5+`z=}DJvUJp=c2B~{HA6CqWm}l-kd}DXLC}{;H|Sw z!KxF5EgK<)R8Wo!Boj&3MqArPfvGO#M83GOXLtZeQjJzhR)Yh)?R||FbNMza+}iI= zWs;y3N|*gx@2i_4o_9?O+q#!G02@htFoTRk%xr4T0rk}j7o>Co!O)Qty$KC$IKw>B zx10#O@{t4^&cE-X`TsGzK=QwaKg0iH_*~m(cSKY0@^1t@?k3`Y*?FKGR$$f4?`mK2+gLO-TZ&IiiZU{dn#czt;dQOX(0pV3FVW{s= zv@U-F0m1+n&mcKERH3I{PMn{BAk}kNVJRm9F_1%i;{TW;GdeVn1RGlhQXiNHek8W= z^(96(KF@N1XR-ERZWLE^b@Qf4( z@O&O=0PG6+;f;Z|O8m3c?yNcTmz4NR1pWaV72XScy7AAV*TxZl$ZamEf$A4}x*7Bv z&X%HL_*A*}fmFsB@I{H>iE{#74WwXQeFu+XJ6bQ0~%W z&;;QzKT#lg1@2xV5VjDG=D@53!10afEkHm*5g0{4HD^-_1kW4bv9tkvb2Q8=(INzd3SL3RL7AX40fL=<=lCXx7`fG#;yL%^t@slG&i}{ti?= zaW|mR*uRZ!X@dv@E)f9n0!iQmJX-ko&29t5=aCn#S{BO4QZsM{W1=!tH=+7LLnAO(&I=o`Pa0%j-RpfjKn)xM^!<<88O z^3FOApj5X7(A@eiaH`YR8VH*wz660_bp)?1x(r)QUdQ;rU{Y1N!hrjy@ zL^BbnYCyFr>02L#-ju*rR65{_C4kTi)cvF52wr+k2b~ub%e3AdlhAxl0>i1S)Hp)( z+|LXU7TULPI@R)IeCQSO-M79SUah5HKZC}P5CXhJ7vdnv0Q1G%zZ|9cy>Z*e5eYye zM2eQM3Oz&zUoNgf!J8Rw4Djl;_$MeN`1!-8(wApSq22@)hiy&413g0|U%=?9zS##K ziH`Fg`(*hdG+zLp=aH5UE9c6IyZMicFN!8sy{O3o_Y$H(H=p9>(f9}Q(tGYLO`{-D zx{Ov*08i82E7 z$YOI5T+9%WO&~@u$}Bu zFnb)LCa@ZeC#dv-sJOAYHvcjxdf;S8PE20L%wAjqv7#acAY|VIPf?@2j-atK6Qn@n zD<=kCxLY-L$N-uj+P@9`OQpFmAOYMRZ-Ztic-%Y{^y`FV7tqh{-u=TFD433Gqv>SA zz{7H)^xGeUjGTJtB?w7Z`yvxCqWreA3rumNy|bs_fKD+MG3Gk7Lrq4ospbwiMLG=Y|*e3dL0^(9aa-KnczX+=0Mq7`Nc$d-h{P;fayxpocVv-247fUA}2v(8LybapW1$V z)%pgW)qFtZ=drr%_Y&lFr)?vB?(;d9`bT%>UkVP}iG6X=T=ac&v$5^aev^>M* zCK0^q7Rgqq!=avEm-K3>$aa8ya4cCf?zE!)bYzeb=m z({9GviZ=C`p+p1xzka(!S0l%lFX)rRrO#ec+>O!y1n%XHmJUVM<{W1|@K1;DCtEQh zCcuON4ABY{Zw(Yzx@&OA%LM!piVaEE0M4`NNzd*1lS85krJy1PjEfH5uFKwpkhttI zHAbxLH%fa2_=oFr%(!>hYo6GUZ3Yhqd|{yP%y@(2xb->Djv^#Lt51?CtB`~`p+siV z^NXy>Ay8>O{g%%hTb$tz`5j%r(W(k{J%RL*;rD$~!+A1h6-r!ZS5yw8EUoXFoEsP( zE(`wq`3ukvR?7Mt+n})t3Ecv~UW@o_y28a^FqM^o(jdNugw@UNi>=|KOTlK4u2J3R zk<-1ivG`h2aI>X@2h?L4KSFZ?7=O>m_^^57KvCzh8q+@qiWtTex=1etgR!T%o6lU7 zFTy_-V_izq6yqlKz9LO_V6#;22vL4 zfdAgy+Y3evP<#fS;{9E4w+E8k5ujSwLl=M86st)HLCteG=<^GZTVILL1P?F;$(2b0 zN$mm~1}^X?44|7KG>47k$&|gWbAaya;9g1WCcdiB2vq=E9&#fhq2D->gc{Y!4~e*uj4KI>1??gHI8fVMQ=RFC6Fv z5cV6Wj?T4>uBoJg4meXxcW+k?fs6e)-m#o$1WhrpjfyuRyg}Twguw{q0>&zMz?Sy; z8d#lWE)4pHCIIT}&h%dtA$w@}BFlTN>Sp z@#xh9*5hhob`#u(gzd29E-j@pwe?#}+-UE@ZaA=cwaA@Y3b`Te(=MryM>O!1!sq$o zWG>-i5ClmCyWNVR`Mn&=p4m(7j(4DCWAO;L_%8a{vFI z)GPCc2e95Gf=AT3SHuU1g!-)F;M;`TU}4WLl&*JZ=6!^bRRs z$ao6N!OlZV;RtNK+u|X-1#ERq@XV(QqH%G(x8FxX8vvw`X!0=3ewz2`NHzmy=u&?YV4EMr^Z?YG_s{Q|ld^b7V z`12PjCMXKm{txI~$bUh6+VkH=!ARst9f!i!1lj5VgKqoZXnr^Scksk8e|P2mPK zQp$>UjRXXhJ-3wvG<+VsT#}}+Xu`gKFYoceD6^ES()=ennCm+xG(0)|hv;%YWcbh4 zs|)J;jdF>n$n1gTdMb$4Oycv_IS-_J4@Mrvjy0Yr*7#^ATVfZcki6b9VmdhYrqICi zFy8tVLX*$-ndVC&1*nOqSX|c#bHg@&v8?CLZP}; zpE!DT-;fi*(KY-D`yR2^=w%x_4}epwN~nUo{uW<8^*)olr*KV3IgwI(6aQ4Qj8mav zV?`;MzA{7(E;J>~W+{jtYW3F}{9tNfY`+@;EFArTx=m9UBRF8`;V?q zadcfHM>^15opx3ZW;n!f9hTxRSS5IINDJqXg%)=25uMp@c$uc}5MdYq5 z?{N({4P;F()Q!UCJNx3Ug_O6?d@viD|G8Vb3?B{>S-4QO({d)DETk@7!3l8(3cW*d z1ra8-m~PrOC`J^Om<)ZWhNiGa`Ydn8=)DGHKNV1Cpn`~b9_&(S_NNU7s(?KvwZ~GS zh=9k-CHil(r63!i8g<(S;5o6)6WVrT(FRKCl+N>U$j0Cl+w{z{ z8@0{)^*Di=R!c%S2rP-$dfQpoeFJ`??!OcPAKXHc*PmKJ82a_-ztssh%WZ``s%cZx z)HMqPk+FX|V=j&#&2v}o!`)JQn@0@qnKgz&_ZJ*G=sn-Zf4k5L^#H1< zZB6RDp2d=7T{2}L=WE`EDb!0j1{Bvek5k}p-Kgyt$4%!zuv<3E63`a1B55?-2E1T|1PKgy)$ywOz`;s zL)Tk}Rk?ic!zhA^AT1#!0saYykzOQ&EtRE>Y=jP(nb;AVdYEBsU$>(k&p} z{hN6E)!lK1yJ2nXVA9?aWhpkWd{IqWJSwiZV$Cx_i*PBAjK`A4` zth$*u{*l43+I5Jpw@-io6a~QG&LCTFa{}!CVNmT{ra2CoUh3nsl8j+yIJf%ezATgg zTx$0OlXjePU`+(>oatM>I}a&MY)88GiSX@s|IjJqoWzP^0H1ii4m$up9!^HC8EOd0 zg2x01AVt{zv9vBQCo~o#v2*d)8~?e_=BICcQ}KUS91W`h|9f1@GH``#AM@~m26$h_dV8Rlcp}qxEnBlY%bt}$V`~%}^LU6NL za2ndZx-t^zvg@Pja5e-M7EN7%v_Ss8qJA0eLyxKPBD19}D?5l(GH(37C_#&1*~xc< zI!e`EG>t8{K0z60GC^G_O%@>LKyb5qZ{$|!AqS)6ao z!-F&zJ)ZTIFtjbGd07%8<-=CRn>cFVNl@^E3cSo}d+{c)RN#^xTdy$3#q*-FHxMTE zNNN5Z-M0)p3GAsS6apw=@P1nLu=i4uE}(G_>k;cPEM5WI$H7q3{;z=HPHz#QKWs8` zMf=bngBO^`)c4I*z@yEXAQ?%5v~#a}qRT*#hAR-=(UgzTt+tB^u=2$3hORU2)#f<> zdcb8uH$m_*s6zT197JkUr#IR#{kq8G7ReruQO|lzYJ`N1>fgVb|k}JVZqN42sVLy;?dQ&{6S}`0en8}Vu)jm2}r`w7NCsHWoqaer3Ho3o;OM8 z6u@p@`Iu9*;@^TQ9MoZ87uSd%f-J%pXbQfma>r1cgt8hhzOl#LcQ#rk@At&C$M3gVnjs`m)h;$fK#w;js@M z17U&r6^9{<5~T)~>QL(;2D*G1;oqqHlYqIVPKILU}kiz zncrEH^*+F+gznXuLWMCt4+Loj{=h(m2@~TgE0EX0UDq3I?d<-#>S8UgOO%iChr9o% zkG^Xeg?=I|sGL^%_ra$*Dg?mCEjPkr?Se7d_9;hor18@XxWn9!L2ds06;PBT5||Ul z9B<DU5z9D`$l$r))vRKs#Yb%-%TKeJ=lZ)rvzlseyoJWU*1kvyLw2z(c z96RSOFp>AEI^Udew@;X#$Xv`VCHI@M>5lauB|izhrw#KgXV40!OBAN>VlG^5sfMq z`OReRf9PHZ*c~lf{ zlTS(PUaHL;w_SOy28eKID6%3OX|s4Kgnp1$@?oJxO71lM1u`_D1(oC`VQ?K4nf~t& zJH88yA;}+8Ll0yNY*=cM#|Hc+6jFX0AGKR2prGVeJ^CcZx4X$Vc&>)%UtQTlf83VQ zZ;^a*c|~@@#;2Ar7)^BnIV!!Dumv4|!Pl~ByJOB6UiU3pSVw!2YtI*VauCW1R${kP z&Wfy!`!0{4-XcLBvt&8X7q$ZK^GkRGwcD?DAeH35Y;LsQ9+cp};$8mQv(I7N*JpC@ zHccpVJUy8s2i&v?HZhx^Pvt|eaNDhWC)f0Z<~n!6*F&i#J??w#N7aA?w>!T3^4x{3 zLfo*4+rL&wk4C4*Gv%g1OSJRga=q$+?tau-m+KI>M?}0`rNuq~0r9H3%-R}CXfAR` z8t1CJz)>Fl4qNul&4ua;ab|&;7tzqXxD%N*({Vgv9-@-AJ812+dQh@RC|iM&W$)@? zC2ieITScq)%t5u$Wag=vEA~W3n^B`c`mMrg`k2d-%pz!P@5NlE8EDHj!gCSHB#9IL z)w?y4MGfE&N%knNb~;c=GG7M`E!hX~~O-L2E zFUuf3_uFBf7}&9M^Ha^r0WhDAXV>%9PQinFdGwy|_v#*d z-9)>>&JGp!li%lX)S-DbcBm$7ey8p42b~aHx2atA0e>CQ;u?BIxpruTGE|m+PXRwK zCG^}hjL_m$KJYyHkQh8Z@uC>G;@NrKa!(#QUy037N&{JXislUf^@u4TQcCD>g{bj! z0(Twm-g^TTpCA73JvtyHIUab_InnGo9sGMZ@%DO{hyK+Zae)=Q#&L;7h_jHpbGOr8tKH&0rt7L z|K0a$=TS-M|1SB7+@-eir~#t%(HQ}WZysgwOlO)lw?X{}WP$!%v-AS>G*>SPdHm0v zwDtK!1-n(7*VgmJYp^cvMjUn&uT<@S-BEx#EL_6vYmWutVD53hbw6lj+gDF$TY;%e zvhGE;XP1=SN2Y}Xf~Kec%G={jb56UvunbCa!&OT94Cdml{XbKcBg-?U9%>hD$zCD% zpp0AcNeU+@zGZTIq=`!*sVR$l4~1JPkhC< zyo2to>Wl)fBzWD@r)aZwd36#VxjwtEI6WgUPILX*-Q;G%lZ`2=)2B&i*4$Ej5{%Q( zFm&rh)*;?&_doH>WX>y;1D*C|bN9w8Si^Rt)pnKiuN_&piyW42pXQkYOO@?A-m58$+qQpJOp{m000SrNL`Zgm7jB@M+{$R z^s!b5&Dv(x3UQN-FLyyDmPOY6J*|yb0jC{~{YK10pO+>&`GJ+_2 zD8L4Kj2&dD{mNnZWE-)rffU|W@1p)AkK0br08Be;1=v$K?kqTDnum#sY}jCOa<J<37;aZr?c`S=qnbkevM0Z0cTdGhs{HSuS6Rl~5*6kDl+*`ctW@ zYj)#pg%mAq*#;|nUwU%(pX~z#eUv=IrQp?!Y}*CfL_K)HimyaGJ)#~*MWbeNE8!+M zE^=Qa75#IqZDod%ZiTR_2?gL@e3L-JVeedw_w)1AQ)3-Kmk(}}kE{m~8IV?$j7 zhJv;O@?!zsIkb^=c(8M_y!%6yuxw71;W>TAbu}JO+|;~vlAZ@;7C{A*>@)&(k4V^K zsFg2j7v(+hA5F&2b|aS%7-mu;Bv%ej=RQRt_;k%m=w@eb70UQaq*{KL*8Q;2Dl2*0 zz#lulAFR75GgY#*EI7Ow!Q;_`OqvyV3c)Mp_uv}UInMp8P`hcChFwiz3w}G6nQKKF zk8D=&a#1tuR^XiuCdu^;m=cb;zzUvC8Duhq&ziMP_OKRd%rcJ@y3nGxul@ldz7~nx zh^Nj9K_@6HS*`qbXns6rQa;3FK}i0=Rrh7LjbUueAY;&ByKs3hPOzwX(b&%V)_G3N zbt;9APlav{=AI+my3e?!mQRCDZ4t3pI3Wp=hJSl z@jD>}h;+fdt^=%8w4Bjb@ZQB2lGb;p50vQia&+EQJQ;dX?ty`j|EO%OElr@r1ncGk z3!503T99odrGy5D0C+b1Py54Z{A;FGB(<`}J?5f`Ny9<4-n!JDfitC&Nugw!gG?bn zcAJkU7PfgFyR)2}Z{KF6NeU%t@C`_>8+WNgEfn>BPr775OFqYUGl!Nw<2PT(lM$65UlF_fET!$Tz6!zB2H!2Sw}o zE61Fv3_5d;Z&1TMJs(K_97sPZd%5hSL*yAr4UQ#yAP5d2aF(Afv~b}){a`5DSwbl7 zcOb2g>&IMv=!a#sw-T~nuCq5MP+`A8guOftwe)k;h!cq%68f<508KHZ7Cdn4&cO%k zxL%TZ2rB4>73hV%Ai2HvxQ+PxGxj=tyFu^v?u`kDn6;X0wOBkC6DvxkK8}q;E;kf+KUkOc0?eE58R_*Jxa>cg=gYr(eRI<<2CX;`z}#Jyb7Et=b5Z)5AFbQ zICMRQmQHZ%c~X?pQ5OI${@57K@Hwv0VG*wn=o0PC-^q3_pf(9TcRjiI%@!7AK?V3X z%g8ww7*4e0DcqR0=_tLhVpA|5PyHnHT**eW?!&zg%RBfL=d6G|C$z8^S0aMe;t>h= zz`qO)gA-3LtWhZsAtECG-dvfg1k5)bD zB@R}rGb<+O^$(xZjFw0qESDr7&2Am7ZjRIjISK8NFBM5#t8`dLQ~FC&i_XAyVHsp_Kih3D*aS#1Um=O4WlE+;3bePzm7CtRcn4so@NJ$yy9 zdY6(6EkSb6&?2asn(b4cbDz~_$#5v{nE?By#EzpKN`-aF4}D1|@{~hsFXnxC>`zXH zE@;lJYNkY2WBm*m615Q8vtL4=K2`fYx*Cnm0S?!>pZ`E};pY_+*)4eZT3;>@#WQ`T zKN8!aU}Rg5l5GC->rf)Cpp|p2Q$Obe_lEePQd_|lqCaL8TV-MBK8}uU z))%#f<5$Jol5XZHx1sP8H%g1%?KzQW)NRAXJ9%#o=C-Q1>*k!@bSm9~CTwu}m-596 z4Pwi)M+rX8)H1Wx#SwCAv7Uci{KaVA*{tH=p#CMY{avLDBJqGh>~Jon=)AMd%>&Ab z6~1dpRx4pI*C|W(Ergt&8+xD2?ZxiCdh+u0D*kP1&AxE|fGX?Hn;KY2|b7+#|*} z4C-F{jqg+2X(?=!a#e3p?_iDKi=F;ARQn}AL5JeuHlsd|qn3f5-U^Q$^g&a_7+op3 z#L+_A^oaGj^8K-``Gbo`5Blb*L(H}p+BVuB(-2omIZ27FhkPM@;ngQ5qTzPE)Q5^$ z;uH6k4vswrhHt7qShj*Ee$c-j@@bjO%kgmYQ%fnisFS}<)TU{;C@XAUs?2puk)}Y< z%`eZ|9sJZ#;*=(bL`^5Z9eouC(Ms^Wf_J2s)C`$^KE6~PZn)C4`m7;A?oH24Rka|- zvMGpVrga*kzk^|D-28857>W zyLRpFZy}|em4pK~t{++ClHLythtnxo`ANjxLRGpa)UCbu$aHw}j91jVI4EjfITQZo zq?Jtx_Xr!hY`?KhrZXmibB{wpz9o94F2@5;jA?4in#+xoIq%finyAFM`Z8g~7=;DR z?CaTaUCs|Yn>Tz>kI*yv;QJ&-mX4M( zRY#7dNUQc@B}WI2dfSpc-H#--0^HUllRXdH4js$)Ji+%#{U6`CacO{fTn2o7u_wj< z?-xo5z%P{gsC5&3eKA>iDF4w3o2NfsT|+5;xE}Ue;tM}@i*1Hq+p6vj0dkRBulMs)?YR{1-!~KgJwh8`Ec97(=h`#P9tknJ zipg8{rvmm;Id<>ewxHH5-_Fl{BUr*!xkxc?x>Mhx&%gV=ejwwqLmAGqZ)zHa&Q@)f z2KTQO;%NOCwEFUl;>}3?c&q&_*RPZ3cT3*3C9V$`9F{+QeVS!EKls*ZR?+)E6SS>N zmYq@`-;c>JX1P@JN58ev13TS)Jjye4{~}%5$OB_#$A07fqYkm78-WKYzOR-m&CGU< z_FlJho=&dLyw+>}(OLZ@&c49=7tDm)9Ij(+Ge!gSMxD$t^rCzxttXNk4l)d)GQuSt z+|>^*OPRbSVOo?r+2-}CnL}vRpT6{^sbJm@JCl{+ws8WEWg0Cv^s0_z(6BLaU+d7x zws7V=nek@xu?4HMxFk;JnNrAi$|>ZQ7`(oWzW!l{ANH8It+=w_o1cJc8q<71_h-u_ zf-EgRGskAFgGe0Z>t}W;^~3Md@FvQHT@M<+I5E1%a9vb!J~O)DOEQD{+KCli1tJ+8 z@-G({mS_EOrTECBR9=XYN8NtmM*gM4UIuUI)}sZvE7TWtoK`P85$q7#-s@^;@i3vu zKf8DPymca0vF$af6I`Ox2dB8+{d|$iNOYMzg`1yTyEm?qZPl#4f-k4<)j`C23F#B$ z48uR1Qkf=Rd_G4NH}}^0)n@~~6=%tW^Z38FAKm5SY_UkFJISOi&RKugb%uXD=cawT zn9QTH`0ah>4=Di>Ef#g@+QE#UFEBLB*#LG6!P7k5a#<&nG&%O;^l-_WJ3PWAs%+Q~ zE00R^Nq#0O{h-ts76<2f&Y!tM$`CBtj46Lw2JJMp%m^`p6DhXcFMS7TZw zFC9_(#&{MHpAC!hbh;FMfsFj@`q4$w_7Y)(q*jj`K6?u9Xb(>^d;44^eiJ79lj^1F zi)SavaekpBQ>xPCn0DpX4dDgV8Gy;$Aa1G6qYiwHRNxwuFVIXAAQ9jBJn&=CouA}erTkUX9o+vy-xnk z1>BS#f-s#u3W5#$YqvkUG2VW-mp<5u4j}9*6CRxUzIAf;8HG9-F>CSSiW0kV7qzr( zCHV;UZj@?Lj|Az9$=6G!B3*GYssTD}SL8emTWvasR=(ZBzc%m+kFV0UYyJ+0!cGxt z3j9^Wh1e%D)s;}1fmdcpHS+L>@)E>XG;?atcItmVOF(k($;mHINXwJGuByq0xabB< z-A{-*a7iE%|8`R+D&S&{@wZIL0tfxBMAT2(itSh5Is)FH&_>tZiF}?{^ElnRZk;Jo zPCJ_VrfMO;Sh|1dbq2kDpXs03Ikye^|1Q1^etn-qZ2*{%Qt|-(I@2yEQ?Js%;Hfqcz*U z5tY?BJWM?6%*$9^;kL7Mw74?Y9 zVQt{vmgI=Li{sHytp1_|`e>~)HaB_LJ@9B}<0;po=Z?$PB6?LeS)!a$HFKjj(~(|6 zGMBjg=ojfkld7b<6ZqZwCh*ll-}m-E;ex#@LxuH6hcko~gCnW#E+eFioh7-RM`*62 z%|q~|MT|9oBlnjV^qGIJnS;Lqc9iV7w?8#sQsEI)v6o!Ezj$!XVTYdNu+w)-zhcmH zXLi7mcv1eA#?f?BU{j#q`tDRH{WzBs<)*p*l84L2zH0TBXS{0X=6>ybtf}8&n{Ua; zqT|s)e<4@J{#Hpc_==*%3H0fmsnz}dYNq{-rq~L}hevDZdu^)3TZfAiLwmksP7X&$ zR^dnd3DawzKM_{y@6)*-jXbTGwT#a_TG{9ib(AdIL!+M_tu;M8T3DFU#g8q49lpB{=)R_uJ`}Zwqjux9-&vzNhptbYtJOBd={gq+^lmRPVS* z)}ktZX%v?@0)IMCB36Bem8UA>r3ylA%-`%bv96P!p6-aLX)ib zr{1$i(=wM^VjTp37hVgc_!TL6#da11XNn6ZdRv$8J z#J=mlcqo#1Ya=LhxHFQOs;>A`63H63GXB&BhksY{&C9S;r=Ia3$En7cP{w|9QEINv zuTjf!p)1S0qP&_EsG%CVCH9BZKUi01L(D~0HD*$rB0Gt0iHaxcLsHaMkO?L7zhmH$ zJHvbthC1(DTuOaq2(H`{XIrAGSb8chm?wk+@NPv4+lWzViYjfTr6$>GPcmc+iTkrX&#Lr#3Yv!!| zp1q9J1{hbl(KXugE#UBHa?tgyr;k3qUW?x$c`#Zx05r!WT0c+GUTzaCm z$i4=dLjQ3zxDIN+6!@<-(TM_D>Hrm%F}6Ke8ez=Nq1PYhWkB;PLz7_ORuHjOuZ^u% zsfF>ic7yBW#}io$%J`+K`7+h8nrstRtUrlmm4CFvDjN8WaH;VFgOFi#L<4S6$FGmM&d9)B1x(FGjjs? zj77s87gCp2Y6Disp3wxLu2n%)0WJuacXn1*=F4y;hU3j1b_(feklv(awnK)i%J&dqS)#2CHo!%Mu+ z@A!Ih&dowpSrrV@=4SUY15avgB@DKXLYQ9DR(h(_rj3nfZ+rb^EX0mUzYAfO0mRPV z9p9k-AQJ7MQ2|!_zy=18#9Ex%kRy!Y6Ud>06XJw!frlGTAk}}`0{%O7@p?b!JM~7l zak=80dNj)AyHtk1QC{Q#Z4l{9{E1JtR2@BDiZ|jTPAA?XC&-LCt66NqPWzB~PMykB zNn+CB?1Y<}l}e>V-4N>QoSeX%O~$0WRVFtUcd?4$4sT;aA@zo^`u%goLser@yzkhb zntNK%`kV0YP2RLZbHB#1HO9Nk+bB{-z2T(N5Ub<+(^`p2J-R9GTdN!|wfbsC;Cz^P zdNZ5orBM&|OuU;w4oO{|*gtHhYSP@PDi3@affP&LgXfL-jo#&`S6v9Q#r=Fky!1Ak z)?mJKF5k9zvC5+dmL#DkwN3`HT_PXHo#Ab9CJQIJA(Btk!fG3?ma!gEzrb>XLdi;{ zAMPv{EzzN%i1h==F>`38#>Y1n9-xR+T z3e1h!D^>b*IBT4b;U*e4c#>@%o_(LHSpw&x!vkE^+)f(qONT~IGU0X|Old$79p6s1 zKAeMIwv_XALru~1_P@MuWmS|o_tEOas^dE>il*B~C5-1ltyWokXEn594=%E54oj>p z>ER63eVI|j#=Yne_<35i{iigd&QZ}6 z9~zyM#)1BkvZ~VHM{VJ!@db;lvM!z0%Cc<$Uo@@jhXWSu2xU(&u8*Yqedb=&D;lo* z(v(KjKiVpR@9l^P_`!Plc`BBphsm{~H9}cKIwoG`&|hVA<-w0)6)rukO!T6({o&0X zJFk)DE~WmK2bk&lY2vc4*_jeD%t0lw{TM|!iwcNj&zGuA@n(#pbbrH(*T6!#+EhgL zpAGvl3hutqR=HO#8D`06@Y7c1N{H|`91A~?Dx0@RQ{tv_2bH`$**pK`T=nxxT;+$? z9(o^^kcCs;c$>UQ6YA$nto!?X($Cie^Os*$62N>&U1GHk;+n|Kui0Hypgx2mHWIK=~xkoW=I7kC!4r z+8x&tHOvB@)+L_3bqNc{M*t{~X}y1+b~R%>{e;r5kDJ}N=v+Tg$<-`1kCen%X(`P? z9wWWgOL0Eb_E~=*{VPA3Wb(QGSQ!VnMu`X49Hv|lB|X4WIJPkUD_y^*Bwv$DPEZZ0 zHl+QD_ot~bWC*A(D#;&&9_5aM+eGkR=~H?O-r}WH$2V(JAzPL?vRC5wwQ)RG8uEyu z)$oS_)aWw{iUyUu*+4AzvY7Lu)|ZSVRsTQSN{*Jn zF541#FZ=mOMT)AW6n*j!>N_7qbo?<+j@@2#(AB-fH()-_!H}LiZs8}j?Wiw%tjd%-85ZLxr#z*9 zVwn5%7cC_cEW}1t4mJcL+;Y)ETb;8^OKIQRi71;LZKpohN3@u}pu!ymV88afCG$Cfr-gZYW zAnp|zDvfSfm8}n0ciMm$yMu9Dwr{~om4fr+%l@Y-wHK@b+uY6AeA)W+an}S-?IG(7 z3TL_9QdBi`H+O^<$TnO{-v->gDGfQ(3PoKt?DHAT5A%hyUNE8yWr zzOrzUA2m|1{2xWxYfu=Sd?{b@x{2R0CzO@6Gbek>A<^Me8mkt+mraJ(>1Huy&0?L* z)q^_D)>F6zi8|63n@#b=OFMH8GD02&yMU~1k)Nnz9KweJ+3J%*xXMx{WwV1V&P5)f z3~MtZl2*B37qJW?j@OR|?O)$l2*y$F2+6i)QM_TSL^mZ`Tt{P`+Q{7LKr7GN80F%m zd*$A9M!N#ldDbzNt}Jvx=mE-%R$y9~RFl*A*XD9WP#xJ`T95)x53f+hm)r~y-wX1ao5}6 zI^jvM!Xf9km{|^jpf>HhFewy0SfmwLIv&sbg$aKK_?4l^tJ_K0zpk{_Fv08cHre79 z{@z9&IybIjz&+4_5i!28@Ru?`4RffiIm?TU_&4tN70#Nc-Vkq%5^J=#4fZ}0p5?xZ zQ7zucGs<^8byTqpDDcSSOZ zImSl`$b)!{4;#}0bn3wU3~BvWpdNoclpAUi#kQ#+63YJ3x8_gh9#A7lD(o$+2Cm#A zl2$Ju#PT0$>N8cSUl3TFILq0oLAa#&(C?-&@Dq4; zFy5cx#k5)S=I$##5SeZN8sX_<{qlyJuu5ZfG&4dR$4ef1^2I4rC0F;quH=md2sS_Y zvbIU%9!eyXksmr~G{~V;;7T_M7q4zcahU{`B1fd#(z8F~Dq-xr_H@xuD6+*&D3fmH zBxDS1AzQ<2;$AXgO3a^G8Qwj!ui(_as5NV#9KhL8*Xi9`QwB zFDGYbf&wwLU`=0bJVUopMLM}$`{19KpMXoVP=rHdDddaIazxU0@h>n-p?v8+2E7=( z4EK06#XH$W)*c)Ue3;p4)34ay*x)@o>6O}Ii9Mjd?3hI3!~P?sI3@F%w3k>{)NoODl z8YB^)Tpr)FEL%1)o-;M5dV8fO=LVJqrme{|ht1f-PDfP!Aswg^bi)zm7ux$WNK!8g z0(Xz7SJh z4`A{QRs1Q2Cd7#8MGX@;83n@V@0Q?f8Z9XrZ#`i7ze}d?zl>b_gI00338wa2eT1?Pw3bB~Vlo~D2 z13WXIMH9j(oEDW$^In$5y9b2(-m`npWz`)${+eiMpNyki(pXP>#+vN1HA@Vz0aIE( zT96$CIE}pZjYpfcQ0{_I2!-fs)G6~QkQZcVyv=||a#C%fS7i{XLHkmWyoliE>5#@> zH)}#SUjSX^QW|KGA{0PaV2~=-m?9bmp}N?qd*b}9AyqHFe2mwYGRc~Sj#UW&%^v8r z0K$zmq58rBh=344cQveNc+=I#qVrGgO`vWAD7NIC_np$@c4CFu2mxc5Q4;L!)DY&&;=TOLdC z01%v@V&@|sZ6A#LsW%eBU~^GD8WHv?`xNT`v#Bc%1jO()_Z(w91mHPiS3yDod7EV= zi)3S&6X$&`k}+bzsfeh51L+?aymkj(CqMR+WiRS~kkY6jhG#>z;6ncrr?5**8GwcK zug4*Y66gb+HOY>T4gkMnXwH&B6O!6EVD5pK3P3C|{*3iQ*j$^fu)e*k1_>L=n5_bW ze@T!u2L@s`YYnQ1k5nDz2;Mym#w(YfR0H7Ifii?S%op%_D%O4CmYc0<06^LG13bF- zL0FB7rW<@4d)zq2`d$Zsj2$%IWDwOzj+{inkOm1|kloRY5t`)@?N{T|LlzZ}Y2}{; zGJK*EY8hi?sX{deegue3`3i~|!OlU^_w83FMJ?Mla6&ZbOtMn*BpZ7?TGO5*V2cC$ zjFo0~k;I=pA9aQVK|pmts=*b&8o)rBoCRETIB(C!xmTh3Zs%k#Gk-T^I?mvz3vt13)NI?9S<`>XL2Dk`8_^ggZ@9q#d>w!Zq$4$V}$oHVH^Nys4@^2FvcL~*bKf?6QvL#PrOv>y$7B52_R ze~g7;1&Fx`Gzt=U)?}DE5!?k+6Bp+4m-CaaffqoD{!h^iZ(1OwHX5e2E0RcdK-3uO za{rE`m|2|>d9n9_d??RClet!9VEIa_?)hiLt*08^riSqWvcq@-znU@OET}O0=%;#s zRB~@`KT@E^8Vd@To^^Lohaa1O2bl+#&jVsbYFjP&x@89 zCIyo)QatIaPp;g{QwBww!ZldOh4O)@d4MXm*QmTx|0htvE65BJSHNv4mtuxU4(1Su z2!gQ(#xPS%7_G}AuOcAIKLff6?!Ef>JkZ)fA;(&|{))}c4z~F55r6nH5*j>|qi#qd`ItCiN0cFNp%fBpVj)K7;GUz%~A0Q%AIeN(pF#p8S>5PzA<RG0m;18UlPGSB+C&$AW8- z4#OO;^4PgQ^^&bw0J}nni)|o#oV&V`{`$Kh1kd3Sr}{A}z(G%*fu;@~y}6swlLjBW z1UkXjuUGAMFs*mLvtAtBEktlYs+ zOS;MR;%SJ8fq9sSkc0v#3A9%Bco^7XG%L0zvta=Oog&seWPsJ=f>NvZnT`t4ORY7Z zU77Vq-t=Ul$-OaHVGL*MYXm4L4&;-5FMM@W3=GL&Nik~X#!Bi?&BCV1@*%tH>%QxmUs_qYikId;1^02vrJ zKr2Ig=}bmE+LM4a7VMKj{xd@?0UHkUwgq@DahCcrbY~DRNb@0F0u+pL6|jK>Q6B8# z7MsdPy7)%N4n~x1VxuTXe_j9>z5fFqki`*LV6ymplrZV>3an6&_Ly#}9Ks-K2`E9g zTLb4B8;(Mr-ws$XCk4SFG7P)CJ-52Z^NScvfl|zxjDHX0QN(use2DEZ^8{d}MNu%x zroC8_gE_9ScXqMXfo~5~mV8)Dsi~9h7-Bj`Xz^_r>?aCT6V3u!M_?0w9P6W^$KFRW z3$^;VO3_o>7D$P(LV-*xSo9a?8ju0JD*p%-gTVW)d_sy*kmXpPLdWc(t7(~z*&rpd zwAMfp=&(l;2S{a7iB)rQ$Djn$36RPQRO!B6_jBIBU~u8jk{&gGLGl_amST-PLXUB5 zeR%@`p06KaoDXaXhXHw&N%8f-k64Ow$HJNY1@9gtXIygcgtK5kjgCLl#nyF*Fcu;& z0&tk}Ajbf)thU4eApbGyrb2O9`M;9GuA}5u&NOGVD?JXDf8TU07~p|HM#h}{)8qT5 zM5Fmgkvil$G={A@kQ|f{z>k3Z0c&DV0VX#XlYt>QMyMgxe+FBKk%f%E!^xH!X8aTgpgV z^>c48EG{6wBO|zZ0HiY{aB>Fb;|Su*ls~~?izzU}w^Um?`2_zBgdWdWv2T}yQ9CBK zAkR>$|K&851by>!C7WyBXgwINdGm&&j+1c^ z9eT7Ydi!335pHVmLPti$=#p6ft!A1SBNmQY_Po;((ivobOoVvsv;yL6in7oCfrArT z&B8ZvA{_EzC^mKN=I0>CJFq)`s5fLYW4!q>jS>em(Yu3DLp9BYY%hY8jM=%oK@V$m zJ(_O>oXfeonepv9xs5Kv3y@#Z=1LyabP^PTAK(tlC47vk#fL3;rtS2b>O0M^(zS3l zL6c54kPQk1J$>RBBl133ER8AK43*ie@0Ryg>z zw8r$*Uj#xCk1{C#ObYT~+aqjiKqxTRDd`6VR!1qHS4O5Wh)%~3!nyigFL5x{g*BHT zPb^IgEDAtp4BBbusA?3>9MbZB_m&@#%p0&COJ_ZkmUzcO5ERArX3|~S>`rz;jK-h|uPc0MnyVDM|ns9ysB}X*w zL7j9(y1&a87D@HIL|ed6i8&86MZ(a=bkWs!IKb$rJ10%?2D$eF=#gx-0vOV&5${CWfZc13;6>oqE-%{OFi-Gn8lXPTGTUP#S!B+^r3RWZm20i(fo#L#ik^+ar z#lc${BB3XT<<{LAMez`WJ>CayeZLu~V^$$v1cpRCU~Cesk7zW{iZ~1+Y%S|#*l!PJ zN)wGDWr$V46t@9W_@--}QO?Ih91Z@a5Io8X%pp!~f`i~N_woLHAU}I79Gi@u3Su*4 zdoqEM|4sG}ILeApSP(Qx8de2i;El)%*1&ZiplL2)0tIHroRzC;nb`r1a0ThsS>r5^ zj|K_ny&M>^gPDi7m0coy{Y?gRz7Pi9t3kQ{dk_Ml!d?Zf0D!4;ARfT$>230?P96Dh zg#|qa-QEnTTsYDOV`&Hu&`Yhb{ldK^v`tjisKFt|YcW2ypLP%S(dc7v^Q=auuZo-%@z4IKfY z+~`cU%)+SNKaUNv<-ed2RWd+kl!@!38Ar5&;!JieJo={&3AtVFYpF7pA5dQgipu0dx;~RvTd+FCQ=X9Ip{zGC~@;8 z`?ncg`KdgzbIU9-8{k6-$ow5}iEsLu=X@>YPGpG9Fbllw$lwzy0}^W<*$LZsfbcMK zsXF1LU2%+M3`Igo2aGDR3ZvzdH&;=j90ImIevo9L0^$UW^^}P-jSV&(Ngdo{ zFrx^-Er`doK;8iggVatr4nLr5T?hF$<&p0w=xh^jwR z{^I%b$NiX?#i0F^#E@i*AzM}GLok5^THd)Hja(qNp_XCkNe0N`jM>GCmm=(1&Eb9Nftwfjbji-)gC}1E zz5dL9QuT?9P8KTpP?{g)yD2Mjk$_qmvcOw@=iuNhu`&K>h*3UKtr6+?NpPX)dn-U7 zWPw=ObDxZ^1ExW6B(m0m;<%8i1x|vjyP#p^6_=)UN-?@lBPcb{2-GJO6)`lmsf|;d z%r{QtoudXB>oa+@tGoQDKe$MlqV|PG$GAcHK^`JxNH!6LBCfF#SzzZPL1*Xb*EF?8 zmjY^8YH(oNeS3z;Mje*mZ690Hal^jgYL|`?8 zlFRKowMkUkox|g8+S_1dGz|b8&LjxDjsV|*ln;}qg5i(~nf^oC_0A)EgXAD2z0t$~ z`P5KprDSlpzW_(cS^-$ucaX6e810!NR1Fu9L;i;6|8WREW(Ua3G-VcSSpJ8%RI2Vg zfpkH*rN-K4fE)y#8(@X>ZLEaG8e%aEL-Fn1(HzbJsZ)x#h3qB4VxazGNTU&t=8>Uk zVxtD&IXh##Z=Vr%_;bd}X`H&E2hz?!07)Nq1A}_i9ej|e>$9@^uSC?az(j2gUYCMIjoi;;N!S|> z=iA5W;*R&c#^1z-gfD|;Bc`(jw+HJ>-)Paz{1WoIHchE(VjeuzENTJb5B9C-vmac4 z!p6&i9W-7X@>m-1tpFzTaCzWF2?&AF7{bry^hkjt_Fj#{1ljUmsa0SJR1Y#^&dOut zWcWJK-$i)u?P{?83DaA;nev>VZSgvmnf$rjR%?xtRsgUXCK@$0PADQD@!6=*UCMl( zeoP(DKZ7@#VjyV)+X8ccowxH`^$~je5l)Ezw?;TsO%C^gCiqI|eM>m0K`?o8gWZz| zf)LirnyeRWW8qr|0Nklom5)GQ_<9;pZWx;p8(=B{$W#po3w~r(laGvm3rM*|_ zAie;j-y=gk`3Il@QbvYse+74BgHg#V z&*6QYFCWCICbaO0m>0aYx$4CMAUoe3y;b9NPa9YrChV=Q*y=kU!To|rkMg(X08$!5 zf`CFM#%p2V4R|yU%pO4sFDnPd$`&gUby}EO>r)nZQyXJ6V1mpBouUrLdtZYxs<_$1 zH3z=gKBiwoHjp(w0&1^JyMeHr7T^I`?}V|zstAe5g+J$zddI`6vD*W%4*or-X$pXU zq!Ia=Tz%(Mbu{e7k&dVJ77#8P1pDIH*7x4i$oN@jVJ464sv+CA0)&MypQu509p@v@ zC@3y@fOi*$aYbDhCC0v9crI75L<%hrs?(y7R5;K@U<f zY^_URu>B`ep&DSL~MUCL~bNLDJ!CS_#*&hvTQw|alRzyIp$x}Mi_obx!3^El_aYi>0cUSwB= z4SleXhqCMY+R$5(kJ>*z2MjFB`AAiVdpOBF2?;=u$A<4=wWg?7NR2tP^VDA@7*nf@ zg6}FJPfwrUk5molbb{RQ+mRTYR1%8oN3B=)_dLW3g9x-fvfoR_?E){uv*2ArSP!_2 zHgi%Gl317_l%K7I89);Fi1jSl3N-0f;fsQFC8(T`0i!WOvW@g0ux-%8zcREEntsz< zig8Xd(v|+b35!N(PR{4eTl+qshL261LZx{0#K&N|pwJ{aSyhr8A&(Wo>-nF&8m2@& z+1@k9_QtbPBrYRWRuS$gp)WB`Mon7MpdUidM|U{?yH~K8wn$YSuhRz?gO-Sw>xq_# zQ^{}WS$`8H>*i2hb;;rA&Iam@P7sAmXw`AaDS|xnosL^pwu-!AbjbGEcqpc_NdMJ; zL4|;zxhndvMEr@{ayyI#=#1(?IMd_?whA@bKPR94)`X^}fbIStp;6?}PcvLEB-)NZ z1<}*3kC!H!5GTkGz@iLQ&(mt~PU8rPDmR%a%_gQ_&J653-%ZwRv1+Pv_9kKBTdga> zq*$a+X!+g%V}WL&jBOycAItjk;s+!S?eZxt){7{sgiNI_ACCRRXT30_lB3=z;3zS- z?(AXh+p_tKbkd*#GBj-JRQ%NDBB%thdPC-CH9DwI!up258SPu4>^#0Kls&JhTyTPG z|CDv~dbPDsr4WfIsJ3@=*Tq9YfU} zxPzv-yX(|pkc05WUnyO!x3j0gltKCpNrlK{ZO(_y4=PZP&8ApQjF8%SeuUyD*aZr< zqJAt&hV#M)h(NCvE-2VSMFXoio5as4;9Z{r zp$qT&^B;qANRuPAb9@e+*1}7{J-hf?n_B2OynlFJZllSd_drV^$Woq!Zxw)(q<%9} zg%}ZYE0bKGOxyM|C3L8_9ZvS&t~5LeqAP7@65vV^vXG?FdFWDNslG|p0T=B6E|HBu zw_L2e5X62m@KB7DD1O2nlZf8S8*OdJuiaX6GfSJc26V7Z*CkP+)k?OAaty_I|BHLuHXVMYJGz$`SL+oZb1q3Bk%3ygn<4D+as!_gCF4vDp(8= zpg{Tul^+Z(a~eb!Q%bS8Y%i*Ta5HLdlcgygMfFf<^WIkkP_;>C->!@QAwe2^>qz65 z^1A%>9}iYUQ@rrm)WDlpS+~BYMx%YC;{O(3Latep?K_&j1Qj5U!*)So51T2`3J6r! zKQ^xhNJCo#dU<-jSDRF>sci*Cc3%~p=JD;wDO@@WghueuT8~{xMR|R%?mrtg9EE=4 z%UOXam}jo#ogLGLtE&-&abdJtFZT&_I8|e!?gm{AAjJcMLRIzeC6em>=%L+(ccF-7 zIsMbE za7BBM3dNX^;i4%(jxx43%3(aOX}Y}K4McV*H{h!6p)Y4ZawTG!S;LWDsE`IGqR!}A z)K>#qMWt*1w8w#i@TMmqx~t_g5wi53lbkwNxRFkR;s5tGJQ;k;`ZI&5l(O1gGyvBM z&iGSm1@5Aj(0YNJjsD*WBgz35{4C&?!gBRvRkZ6MjrS`@yd8g<8$D4mG&XK|LyLg?lCXHdfVFPc*hQ{!f z!>dIGM!tvc|EQkiQSDgLXcCZ7HoTIriT%Y-@h;vU@-MZSiUI~E9k2jMttLiEEc}4kqs|l3OOz8FU?pa4p)M8>Or|b@#mAB^7}C@XLOk6^CLt4 zl`w9OZP)mRw0m2yU z;#-~KUD!DLu7H*!7B4BP{N8HdL!^f;qsG-LLCVM?htbjEk&U(56c}7s=OW2wmqy+P z8uiC9hgAp}KWiMBlRtIHp}o)xvqQA%Pe-f6HrT}2)516A%Ut$`qw)7w4SsNr9NdLo zX*m+9Q@1S$OpxQd$yeC4;Sa4Rg_A=-G~h`N(;8iGay{^Ej7>(E&Wt?Fq!(2u6t=(A z?qn%?qf@kN1zM5i*b$49{*T`_$%O|{bL>s@2rJulF^+e(N+u!`ze=oq)Pi@MJuci5vWS~bw$@4+1oC*qy>se;(99Tk9mFSXguM^wWm!-l?_ z9e!|&N#o)wQRO>?=Ypu?;6a?2<93dgO6}uM&gb4S<%oEEHg94;Lj@dCHzTGv0K0(z zEDfA?y-2b>dXvAj24URW^^SEFmNRK+JvCS!gp|`cw<4%NS@@^ml=xNofHcL?$G0v@ zbjY%zxAEU{+&;H0=!FjGa^+}_omXYFj#+Z!3CvD(`NR91pKFKV?Y##TfwEn}*hoc? zs>hccq=lb?m7(Jch=EY2@c|a5*xNdmjCN!%(mfV-69a>ZfuqEkN00TQalagealx>! z`G@P2OyzaQd&9etm--)Q9sDmD-vm~;J~3xi(0e%;DDN>CUCa@tnaj#ZvKkE2oy?WU zd(4H7q-sD4Lgul76I`RZxj&z@-D^T3PW+%|_i?ooXKeIzzn<9zw($Bgw^Z8VaM);U ziB4T*jny$>0V%8X}eSmMccQC@Q7@ml}|gH*E8U_19rcKKtMC(l7!g&z6Yl_SFOovFQi5H4mW>yUfDxVJ6> zR1Sb0P8}ZgVbgRB-{to8nJM`A?j;Xh2Fl@xIxCcopRhf=2>ytUorez@wC=Cqi-I>! z{TRSEfjjOi;^MG|O#oy1vaJ?nMFI7DSOX6t)KgM{MRulI5cm#_QxHu02F44!Pn3ra z;c>t!2T^RQ-{!pC03ZjZ>$^(=wh46*6qX0<8mHR*YEb}q7=)&Gz8=?G`Fh|KCO>Qh z5?U(^)3(&Dz7Jj?H-n@KG;08ZcZc3v)umeKLdQ~7LEVGH8x*7swVvNkxw0Lc3DZfD z?H#Hstg+`~(|Mf|unTN=b^=ctsBBh>Xgss%^^Aof1JnKIzH=WshA-N2(?Ww2an}IK z&&hEYPx>B_1Ox``lIU&KL^+rbP^4GA%Ud*z+Vo&cjw!w>?HYBlh`GhPF*!GIU)tiI z0iQIJfbV+b#Uvh6jcwQ!w!!+E|BSwiyyUxA0P2TT^7pXn+T~^cbS0j|kqjAuBS-i} zK`yGGPZfw$8fpQjm)zcSM2?CFTXhWmcD;w?###m{E0oZZVHlQcdPlN|Gnn6}iMDQb z0v6~o^cwz6>EN&_;;Va<-@O{xGrCas@S-3@hX$0b1;l8pK!U7VeV^TN2KK=a1}}gt z1z)(heJ%yfIb7$GXai;?#8uqkrxCZ zh*nJUT315Yz$*#UX~Q+zy{uF34uPdK?#NguAuJ<}vfjUMgwG&}&Gruou(>Fh@=2Pq z){9^|dl;g?5s9sZg*+_Bu0ytXmM=#zRs|Ez3+A=F*T-ArE~67-aAMRHUha=U)~yw1 zJ&Gfl;mSK<8SKh1=K=pc!d#SU*-O+?|BI4_=Mz!-Y!8d}-f8bFsHBYPV10#{tJpca;Mhw0OqA2pr`c&W#gx#W%0)7a`Oj0a~1Hm&`(h2cEjSqkV zJnvpj2#{@HkmQcHWj1rneM?{dl##Pw+`TdK3N=k7)2i;rnUeu#eh@c8u2*($7)iB& z&0C8;DO*|h9F*kpVRQv7;tgTgB#HY!&YSD#)foqZ$5$?=ttaVe8KI`Ig$7{d`Wf) z^5@;^*d>ocEJ6ndLXiHr$(ihwYI`wm{sv zr9ce!gKPz9L$wGFZ|;(yxBm7X1fevb1N%<0oUd%8>;u`sEz#s7jZA+(4c9uJQQe%8 zvQH~O?5NyitNg*N%A

;U1^fh6lQOE&Zx#Xdq20 zEkFAw4)xi&tCh6Gwv|QLx;}!D$HGi4wY3%n2!m+~mc54%bz#?sL*`7CBX;zwm?2ibIKiO8q8VL-E+sc1MjP3>}jv zPP`Q5+g`=5>u=q4!)Q1;H(iuQCycTE3jKZR%X898Fwe$5& zU5U&n%N@E^zZ-5FRn%9C(mX$OXJqn+a$Emqj>j3*AFT}NGE#npS*F9223Nnk>z}N9 zDJnbBdP1-nrd7S`YVMoMH(D}%VW?9Q^hMtcrmYKWvo4Iyq~S?$71jKD>i3q>7*aHoT$~ zR?uaBLh6m=V}qDz_wt&8O9_AA#wVAZcOB-k;`nbz($Tz(>rY)4uUs6`H-G{2_Y?|v z1fCav9e3*T-ZoL$wQM6Vt2mkJC3%hFm><$V6~FYVD~;2NgGzWxy?;YP@tqSY20un^ zj+kANw)kEf&*->E52oDU9;?28R^2KyVV;E*hfuN zPb`F6eo$=TpJh7dF<6yp#c_NWnB~Q`6C`T$iO#0-;Ut5P2h5ulx!j6|x6AIAaJ3hH zeQaZ{NwAMPpy>5h(zzkNw_?gtzA()4K#j}C zg_-+QY-_r&>YebiG-%kdU_$!fVZa!SPV>p-Y5Bv8wx%C1X&4BG1;BBB(vB#S&eSxB7R(>rd_7ubDHdJ}FOiYDY#kO4h6N4X&zpS2dh0pWk=Ju1LVVn*S9H z@X(rCVwau1;fXbQ0Vy1z$9KhE-ek}F+RobW#6rIK&>irAAj&moxOTbv6MFXqJbJ^Z zR&p-u2|D^Xi7EJU|KowPa!d2y@0*o0BTM=sQJ*>b+K~ND-@}Sxd8vWYE(5VEA(l%6 zsY@NEgEaHqUURRzmwwGTEG@bfm07eYK6LV0SSaj?e&@Bg*gaKIx>%_A#cNLdXT<{j zTT?-6-c&FW zF4y_%zl@&FGfT6Q4EqW+rumG=Oxo5=yB`|9$5nirdP_%@)vmb{it(f)ElhN+S7>is z-SQ^r(T=p5BTXH@qVinpYG=qcd+EuY>tPQrOXkj#~yD?qsY(2 z?cwu;=d?#k&$zuchFKhz^3skutynKMOlAG(T-@Ce?X&r(RMgtybXh0R45ps89ZO=u@Scq?<9*snEmCwUUGZS`Q@4C34s@4bSNhevs*&yO?yt?N*9gN-Uh6^c zFPHA# zV);K;hV0pz*SOcl3EgZgyH}oFoU|*Vc0ze)u)*3bDR2U;dwV>yNH5Dc|5N^9FpZAD zY5bK8vz2Zzr_|wm9hr99(Q9`{%$=i;<}>ZkhEw$YL@d*UQ{VEXF5mN7_rcgXt}d&z z{bjDN@55b^+DmeW^9^*?ILQ@<*_2<|$#*9V&TxebKDn9E7c@-kUacHgv3leZ29I4G z)tNJ^-YmQ+%;q+jlZ%sZ%LX@}QExB)cnvqHxGPk;zHs1ebd`fNn(XQy8cjV@qBP^j z-6ezW4u^~$Ty;8s_B!cYc7a;j9f+KwZ~|6FtJ9R$%icssTB*0=iv6-I3_pB6Sa@YH)54^z z&trKtzf?N2P}kPTj`a0w_ii>moPR=R%}oKcmd_i6w>zGV)IRzZMzWTCK4#N*qhk8f zjRSmsFiP0y@(eDUtwZZ5g>^gu!@Sv;?+qu$S(o7+s8x7|7)jf451bOipXDi33gA(G zE{{@U*;X-K7;(_cV>DKBanfU>8s8uIJ)2u2+eI%pN*5pEzaKs>F(|FFF_?ds0wevW5L$93J`J8sbaVC;i; zQY)%-z3aSQ7Bwajb3mc4@wG)zcZ*t0JY(vQXr|<~$0aAs^^XT6oGHoC|80CjM{OI2 z>k|=Y9`za$Z_6;__@HiYh)tJg={UEEhv@*fm)z3x?nUh^&&i&*G6U@KuJdE@8lj86 zQod1a?~6X>&gb>o%MXA9M@D%vPFWzdc@IS=Sp2+Rm0_ z;;+F1L25QmiKnknZwVBWe%98k5Pb9pT~AWZyQj^&(X+gC>8kJV+CM9z*`R(W>jwkC zem?axnUNN4Mj7YlqQWInA^;uD3|}-)YF-HaY!S!(jqSPC%Cq-(+eI3#n5Q4QW#5#i z5iKilfsMNO9GvgNoYoxSr~&WhczZsU#)997`1Lf*Hb<#O#HDY{Ytxn8f6SFMQ2Wcj<&U3n%eZ#D?r)(Cp?dWOu`LFl zrCRP5KLG25xv;RS{p?`eukqu`P{gF*Jk9?#n`76U$uFb zUX%Ij_Dz%PIs)}4el&^=w?up>*=m~l(Kk4tVrj7@wESelXA60UcoxY{R zUC|`?ZC;%c9xvYhjHFUou5F~@YQFocRdQpvr0Wd?h zz6+8{X*-hpdZ+uPr){WYW*P%!uI~(a6e;90+CpWB?7?boJZY_p!kZ)cDmxiTzf^4o9Vf z*H&@h39xw;PxH_i-^r4{%5<8am=v10_S^0a^nWjmnEON<|Ien|UHJPd)$!!$OOeNT z7S6-(8&cNl;sod*jtGMp|LrDuf5k2cIZ|Fm{Jz0QR`MByjqcyaWsFBTBIO-0%-AR& zwKIg?iTm@oeoX(_-@7JS%fL$2RO2;@bBD^6HVEx|%6Ps5MpEf|IBk<4QevOlA~n@0 zHu7(Ls=CEIQh7cY>@nWH1~$7WQLk|HV9C#tb~xST2z3l_Zp!BH^m2rb>U z6vqFU{(na{aJ@9S+ZQ-N5*}sarp|fo*V>uSnsR2)vF;JfdGXfcYQ}~DJ12UT+-+SD z5dy?2)gb)tMV2q+8xE`8+|@Hy(V9+&B3MAev!>k~y#=emB*^c(AbC7Z7@izCLT7g& zPh*E~@Ebo9L7&cHAq=3vqm$ZKi2qmONWItR?#O|(8PC#hhx|gXYU62JgYm-^{JP6d z=yhDiYEs>SGJfC!8{r{!pxUWFz&%+P6gY|(TzVAQx+AOe6&a!>%+u+{^%Xxqc3+cL zv!nno4-E0)YEq;TT`MJ*qNy6tU}~xEN4jOAJ+@k^Rf9qFLFUoNk)rjj?3Xv$hV~1T zb7wzqdSvXs|GOZ4FuI@4l)?{jP znu+Tv>l2X*ySISzYklxAUoGO;b<3+$I_@(yGni?f>jvwi))xLtJgevkiG5*0iO8vI_S*FuJQEtPQYD!dXaT;*4`K(2Oo%t z`5pw6PvHflC;TT*W5oN$%1zFIq%ubVIxOhGnM;nzqjQHR5n3NFgIWGwu|{1b((@+9 zc{M5Th%n$f|N+GA+3d0m(WZKB?kjecMVk2D=@m_v^DvZN8eU z;o+MD-!7u(x_M+nwoy-3o>q| zH_2Nyj`u@;Kpy!B-2giuSYjDv7)&h#;*5QR|8#5xSlRh$*5V{`|AN~NWE265A}*}4 zC#Awqp*K{#G;LT~|WgH$Z3eOWjW2X7J&!o%(?K0FPS6`Z0F1%0NU zK_36iKZ)~&nqHzCo0yRTEy`FOZu{aF;Z-BYnfO5F~T}UN~D1VA+tMy2uYpy8v7|m z3*wC4xf-pcIHJxS{F)ySXd&JN%5XOZeUUkREjS|&*_-6z;$$JchJ#qfWs=!pJQnym z+p5$2lo`m?BJYbSfw+w}L;ZA4UDje2B>q4W@fI&HL%3xg#Y9*Jj=xVJ;N_)~Ap8o^ z;0=2NPBkFCauxR>cz+XaN#+Ih{!z}eag{6?wWs@3=?83_y5bY|e0pTu-YIN~cySe-%=9*4 zX42V6^W!s|D8lAbe`5Xk&CHMV)$iE};t~YiX0d^qa@z51G zewybzYqQWNX<+RA5ot&&v*2~DOZyA#8fxMkv$jVv98FPT(l1~-<(t3fQ=2wTJGcr= z=)9=ZwTtNqpe#siD;S-$tDvW%j8I>hOpO4 z^W<%xEyw5}nTD8!=s9r(cyLEA(*l7_-W z&w6xpsRTU%l+XM39(-^W&6T=9a?_jwzuCTK^^N2-7KbUpK&p{)?4=wm#9pN2_0g01=rNg$R=m-wo0cyuQfy;RV>=OZ9pCM2Ye-FPa(L}~~$_+HNtJ~rCb}M$Qt5n+nn3TNHsHD}^wvxl|9GFic zL|Wsvd^cpPRB{OrS+CyZwjjf^0TmZW11*qh|EKZ|2Z8JVAUc9;1IXoY{_;Nt)3VSS zy5g@9DUaM(>v=X!>NLM@wn?8g3QBDGMkDrU#{+@!V^GcAJgafUj)+Pq9*QtHlc?2q zhG0J2lgyT)zvT>aSCyS1BO24leW)Rmh&23D0z5hxs1cD>VNi#8=eAmokFmaN^~pfy zH+gusn<#Mt_!W1>n#s`xtYt*Q;kGwE5R?-oq;ySmwy@Tsw9Ugs(M0Q69!jnTUH#q} zA64Wsz83t6IPQhXx;UJ$s^zmr@;7l=pq+RJZ*%XjDXCOzUvN1jkh)`fE+fUWG&w8j zSGGv%B<(3HmgXKWZV2nD>T2Q!H%+v=i<+~lH+3XxghsgNeHsGHa) z&#hFjkjIhkGprv0$=9N%=pa!lCqp}2knLLIdj3K51URvqGJ3G?z(mN=8BQb-(#iaL z0kImG(kBKbe8Y8`F?r|xz_5~l>l-jHOwN`5k^-5Hy!&*zAs#yADqo*R$1}ESl!MB& zpMzfePQO6M`tr@IFP64F~|0P?vEsKXOf^mQ`T#SN77NnP3^cFq%%?){ddhtq=Z z{tz3e&oZ*PKEgb5K;$_><>|g2Qd7&L$p5)mcm}rgR9YrRD#==tJ5D(C@5q-zSz}8U zW=Q|)0=5#$WerA%383T&U70tQ2MgZKID8|JyK^ivIley|t z!b6*b;+OQ_QGrs36LQfOhTm(Vxe-tgT4g;70essPCm@PTX`UYp<=YW4|VCAQh^iPV~I2rO`d}?mTE4ccv zt~}j?w;)^M5z@OXp5w)Ef781bOm=Twh-a{wLNtl(f^PX*g}X3A0yF{R^!=ISMo1=s zrKIc)kR1FzO8V|B)%4ZE+ZEWI{-;qp$Vn_@7beCJqXY?34E5iSxU zAkuk6)hpd!THvSz>G%%hkaWOwA!$O@GbA8=L}9)49=ZjqIVcB!SsbN9MHXU1X*kyn zw*bt+(VRzgo^Wi^a}5j0vjCRZk5H%-d7&mvk@Fx-7Rb7dQp+X8GLb`l>%APjYKk(! zCrD+lz2hV%nBivp(a1VNuTI%Sd@hC9`KUq+%mZb%X%EW38cTzImB7>Uvy&j{NMp!F zcR@@tx(SR6$_LyIYfxYVxCVtXQ6<&N;Wm;T`>V2Im81cA#||of=KPyH38B}h{)M&(zc*9 zt{BBVbOkaZYz`j%fBz0e4Wve4enqkMQ#NG!j%*lW25d@m!3d67l-)%RvpjEzYBit$ zSpgkt{5f327!-`mBBkS`&2h?3EzT0A1C;|JLQz`)Mxf9`-;y3HI7j=-`|3(nSL`8A zu7M#;*(@%&451)gnQjZV09>?)u_7IWoNG7yH12pps)=_@?-wY+cfer) zjI+?kmcXb&@-!>AbO2n!VZ{0IlTKeM6fr$RyPdwHN(NDR`%&-1xnuen)ek?kL!25# zK7f_0sL=@T!`I?9CPILJ>$}!1J@~jZCB8J#z0}RUG&}7z)4F8vJUDylq;sw3(#W5r z$p#&*x`F*kgaD(7^j!;J(^&}N`YCEE`2tQ0k>ZEI)B4fB$huzhtL|4cxh$;9!ZFsK+fRNhm(<+h$gfQ&6AnL+`x%_*$*zT zs^ngS7@P=j>3^6R_$3kwZ~{x&t>>ssR)aW2Qx+$SJ)$IZ(t{PI(`P zgc4~B=EJ2XK$DCIxRk}ms#d;G6U2k~A3heJJ}sqG6A!lMq4;^l8u|nG%=k+{95(s9 z8B${)(smbM7FkZPJQ)P0pc1Bmnyq-bu2dW7H-L&HNFk2{R8245Smb0yQ+jLMgjrYh z!IG!gU*>+xNH&3gh}65B-DtRCN_iCPl3_Me3ognWEU1cyWL8wg8>{I+RN1r-huTXx z8m~`~*lav&OsJ{|HAY$noxT6oOmMX!C#O+t_p^~?=Ip*p&P2KxX><8GYkMNA8ggS) zpM}@ut22)@jgggRG5~3JDEv`L0yFp;y5cl{ve%+p=y9#;y!Qg^>Se4W48wqC@mT!R zzq;{nT?U1oG-U|Te{fs2l)82!MCKB%ud!Q)pqGd(wegDn?fd3w0 z!cTznC#2Vz;R+A*gsuJjePsxi@<2>CkNJm897m!UTmd3MnlV049O%Rk;tEl+Cc9a} zz5XD0H)6-W!6#iWNxVb5jjT+oP@?#Fb~#s(*l+MYrZPE>38XS28f#U7GE(!$1RFpq zy$4zb&@kczc5xte5iiV%`bzzuRt`vvaVm=+qMRH`d|1^mx1 zl_qa1xU<>&+Q`tLRXE;x9VgHi7wro{cwKxsw9{0A+v|w9vHUjAGHwSz^Ol}K9}2$z zN5OZL7t{gcJ(haYB)3~iKWZXm4K|_U6Blwn1b-hG5zZFkK7Nc?Ckc{+oBQ0am)K?j zG1eV>IX7N_^!i->MArK_7l0VxHxY6z1q4S9vrv-*laNkl$MwTRUF#q!z(nH&U2l0Q zeg?(<1{6C0V;!$SA_&Pp9!bBXz7>g%dQ@JO0K?LcBZr9#h!D~$v-F9Pb^jl5K3LE1 zz@j%DE-mGm20`dh`6qPfKn=i-5?dHmBOv;cM>#fj!qvli&migFk%~~|jm!8`=gf4^ zdEPQajYcD)AnBL}`UuOgpaLaI1PLWa=&%wsa#(!k5w}CXc)S}Di7!ZQ_F8h>`4vDF zRU)AbQy7Z_)Vc-+f39P6YWW?hseO|cRA=eQ)rJ5IfIotaki}TGL&g=cn4Ba23FHHg zLh`xE2$p(&Tf`ByVaj7Y@1YV8X1V|U%lFsI+Q}e>b$mR9$W`}~IF(c`K$+?roEGA; z=0H$XyQ=%IWsUl^BeD1YjP)5}#Er#$g!~KekJDo5Yr&lu{(K}V$292{jIl7(Lfu247>pcmHuM(dYm}Sfks%?%`Gg#CUSA@1y_44XC>^fD zupQc>qK{N-z=_|u8q70jp|8oaA5$Exg|EGwE8>0{3rZRepPAX!E*SZm@fRw4p^`{- zcZFwnJ|&<DtnR?>>Yk z0Eih8HrFrsi9;a=Faj*ox$9Zba2qPflVcB0K(7<`pM~d6_|ee)Q#J`N--EU`Qquv3 z(`Y(E6w;xWt7mM>afCwpG}ba<^h6Y?F<~R92r`QUWrfEss_E}s?M!U|%l%uo zMa@VS_+1)D?WaQTLcWUfE}{erLhz2$B|(VsU$s=HMhGEFy%RmJ_1Ld|EzyU%H!oJL44 zd2YABI~%z0pkF}de=4(8?#b`NO$*4)Ey@R7)g`*?Mzf2ihEEa4 zU9u7Cw^i;!CB;TIO&TdCF9M)If@-XFllwu9+CovINaq|^ZCC#)1yL61Me#$PGNL!! zB5Ytz59+-dx;{^WD&4J^ImixG_k>8wT=#I?Gy#m9!WHNuwBECPXRLGOz@q z`2<>p5+mm!k>LjAz6hsQIBQ{t2}7Y8-?c0fBl{^s3aVBcmK(M}`4T}B)~%5EY$3#6 zH}Z71NkbPV?)~j3<%Yc=$D;Ohg50wPkl&9b_7Rk~f8U>kN(*ry0sfip!I!d0|5FMa zhI(}UjzfSTnX;}d$jEXF;gypk0F$_3QP556{e4(Yd5L6Kn@MYfpEp_Q>kWsfo8e0YN>$aL&=%t66W8Y7FD z=!$w-;i-ymooM1QsLci{85bI)N2yra#)yVq2#lyHsEuVoKyVcMJ}~(O7d-hV=|sNe zni+_S!vO2fiEhJjcz0o@-H;tQ>KE5Aqs)?Iv*Xz*Iar_a??fRVT))E#kN;OL1rD=p z65N;4@ka#;#8J4esJ`OiS*J;Rd1xr5XbChR*N`jY>31dY>@SDC>_@P&rx?(lnAPmi zC4}tD^;L8XgY^95CM^s_xQq)`@xNg*eDn#ld4RcfY+bcGq5Im2H_nDOvn515{LGut z7RUw7G0UFp37^kHO|C?#(Yk0i6vVJCp`BKI;dCT{w{#ngsFu-%>=~F+4Ki zv&ax2^1z#>P~@4c+)J@+uUx*1P5wt%1ng-`nOU26k+J@;L{@&HLu zvi*Zw&S2f^ff@fa^b{il5-Gt~VB&apUlvh{%E+k2DfMh@DfB9iiV{gCmkM!V2{NLU zGsBxeq6h1NXx?2LXL30Ja;H(kI#h!P+*l+V!;MkN45?8MAe|yX#TBeQ+Gf>mewWd8 z0lkntU_ZVCT?nVsR#+sI>kgvIRoi~Fqg!?cSvZ}`Chhw&?P`Z; z4}d?fzN>^9X7NG4F^dOP2C}@-b!D)=E|B3HO;z zRS^AC{DgccqC1@7M96{WP-CL6L5~Vz5j-TRB)d z%4i8ZhkE;lBPiCkv&H+cwsp(W!`wXeh|TIDzfWxQpnCVxlt(Ewi#9P~c5~PdJN4lE z!Gc%Z3}5nn{<2^3&Tiu)4l1v8K7821$^6U%v>H&qewi%hr#*k`ke~59bM53)c9g{B zX;^kltr_BiEM>8rJq$4Zsm8=Q)4)OqTtMr8F$aNs#@IQ`QVZ3Qo31CBoIyZh1%Y_O zv$jmgZ5XsPN#C)8hAxnjBj+D;Wv`vI(1(_GBv^gyS?{Qzk*_0eOSw{hx(iVhBxYXf zR9WpadQjekx9??JVqW_}REXs8T5PD$YnwFMfx73KlMmzWnN?kWuBGxQlNF^y556;x z)6H`@IgNO}Gv>thQrCiy6mSt_3Sa>mBS}x5W0kXwUgeiA)|&9Ffoo{7NIbCx#d^g2 zD(>;gg{X6-DCeiAD*DKwRbze==uEKQC_?!Wy^v>(s)BG=Dvo-h7k;DpT?>{AAJy9C zHluG=a`MZMLY(VgfdaDwVxP43p6S=EDL2ji7}gf{&Ljw0_n8BLn=h-BcH+IpDO8kA z-?Ka2OmTC^VfTroiZR$p4hFU=gs1?vEayx>60JQc9jHA(h9+4UZ*whO@V&9JTW~d6 zX$^Z}-v3>@%fA=g2MrLjA5SxX$Id{FQ!lSk zg#KqY0*NN*G3q^f&?6oD@01Z2{MuGUEmMN(x4eVAEzI(`d~h|o3vqx|E^1v8A7z37 z=kDm=eqk(!gT!m|#yn0C8UCFkabSs2uw$Aa4n|+as|~m)t4a62yFX`=#vAbJBf$$S zM{H1V-u>Bc5y#Eh=&plkr}G&bLs%x4Ln&0w3p5;f&dXz-j}}6Ch_Q zvNDBt)h#I@>BHxjlft1P@iKkRtx0g;iH6RGzSqOEnHyqJ5ILnFT2?_X1G#8tWZxg~N$Ssj zd5q3HEP&S+Hwm5gj&P^UwiQW_@U;NcZBuaeTI;tq78w*G8RH~8S5t@Y1Y+T2fssu8J$Wg7rdplkH;;| z*SIak!lYsR!WRD^?gz?#i=NL=$+=c+Kw+Xri~ckNl6w?&J+WR$sj27iiU z3!a8XJD+b2%}TBYOpbiN!JAc~yTBX7V%W-=qzKU=TGec&Xb`)!HTGDd;Z z&~trI{PzCOD?$+01AN-r>v#LAiGj%|U0H0&83Mpx<@M2T99XhqcfF6O!#Mh02;Z59 z);uafj1PgPQZ05R-(KVoF`#sQaxJw+@Y2c`8+jEq0P8mc^Xie-UQ-P)jyJ)}l!;{~R~aS_ z*~_9!1EEZf;#S?Xw&e>tYvKgRmI1uI+3()72{o5w^vNK3b;`{`CBNuGa5%=ky>*aW zmpCkC6sYezKfE6by5<7^hBfU&9^?piIRACwU85s0JA=Mt0Cnwogm43rf}wG+3o*KV zs6Q{D19i`Wv%1}Y@Kd4a>Q z{-W&d6^xyB2w{03ngJ}v*UsghbpeC3lmGnN_Xa;n>iQs5pXhe3LkpPek%#a=v0l0)kqjmb888*zl}bpdL#c;YYCmfWk2} zl8F_NmpB1A5c*l%^ibCN+i$HNCKN~p`Gsvg4+cW*zi2&#^^*YXh)E8O#|km=-=rsx zO)B7oL*)(<+6~T)M0cU*YB=`UqsCA@5D>$emwQuk5R)P-| zaSHbDW8_w+E06>b1EXZfu~O;UJy4!5_8XvfVRSaYJ%k`2X5R0-%8wdnDKGO<;HXEA zqk^W6b2gZyT3burKW41y9S~-WDFHP4ldV6OeS(?)xf+>Ng0E9?q(Uz&WO{&Hb2QM) zEw@4vcVE?zQlAswZ)ke^{T;`(v~P<_Qzl9gM89=B8VP*7D&SMv(n3~Vdc{L%%s=*L zOf^#Qyu8VZg}m-VN&=}0;rJUYKxQwb;|n!v)Qk1{L$?rm;WqjK0nIr05cBQ&#z(kY zM<#=}toO>`nC&SH=(-GFx^tiqYeU7O+82dxL)e*@x}`}YR!M;TeHR(^Q|YL76CZqG zg6Q&$X1n@Z;-j!|>OW}U1Wu~P;Xzp?7-T!`PX{Opt4mSw5WT@%8ltQB=L zr#blxUv*B4$p5clGNRyBx%3ipu#HkFS zaw9;nb^ZzM^UIH=>aC$Nlfa(|u;)B~n~0xkk-0G!*(6{6>_J=NkU#-2yv6&*$b+uX z?5#%4u(!qnopI-C&8wtT(p~foEW`%#QV{q(BcTQ3yaTq-=qSO36`Ii$P604RIy}qX z^b{fRb3}86b|-jgW+BTasI|%4Ec7jfBb5cT0XgdNZOJBpUuo%r1pYcGpu>QPZ0%GW zZ53goT6d@ot)-eyXzWI$8Jy&KJL>pxkuW1tiC!ufHEe_kY@me7hj3C}kPD|#`Hb-W z$~Z&+!}BPIB<9f5ur$*;+sF-T2ZodHM|8xyKe0vG)m|zU?L3h}WwjbxaH)Ac#s-KJ z;K_(4uP8QT!rbBF61nZ6(S>`q=Y;Il3xJ_Ga9#na90G`q(AxIIJdiW0pTXxsdU=yB zEys9>%C-dbl!IX+DwDQAm4TJ+hhXtf7RJ*+3MwHM4UzPXSb+Z9bzQF)@nEv(V~!ru zFo6ET3W!B_b-b3|qF&2!VxM7W+F2UgapmZ2=^&AVQt_qc<4@}-AsF6B_SXmK%W1S# zWf{gEG|*#ASqgkOf+CTGeIM!>A3~ENiW?}BgDl~YMWRL~Gi(}J9Wz$A2d58XiVY*= zo%a}lgb}A6ur*r<4i$^EInL~TL=Ls;`9T{A6h!{;@Uh>@u93yPyc7=w7a;ruCf>L% zmNIi@I6m`61Q};bql|GZ*i1PX`a6X)uBAQ9d;=d*QJ{SL=)FM2q{2~a`Pg4lXXQ-f zp(gMV<^tu-@7alCRM1q(nQi#Ejk^}m915I^iO`Y%br|UW>vaujOG**#1b82Hh0Mqy zbp-4m7k$}x>w7y^=4m8S6>yEMCYK7}3PQvrC>5uA(q5Q9P8LA`Gr6GCM%z~ZQlh%} zUZq0gZoj3{kIueG)TxRqq7Gvv76-wCIWBTI6nFBZvOOoy)FDq6*AqZH0puGHXvtP8 zY)2m#;1FX3GQMsFb#8hxYAvl!XSScp*HjbVd(%YHcvh#P;qg&d$g4>sC?u?UuOSF^ z2j-15Kx7m@|Az|E1yMdflDsu zLizdX(9Yt%kJ3%M=Sn z;&jC(-@0>Rp=2oW-0zwC09Q+^(&GA0Vjee<<9hKRI)8*h=hOWqkfc$!e`g5Xneeg= z`Ya&*1xSl=H7J>-Tlbe6`9NWn=rM8yGY7i33i^bI`Z0WR%$+^UVqpaOJ=|0M>`o?K zk4GBHVPE(JnDKu|tQ>kkU{0cTBL+5C&8Tdz)mzli*(md->dw$@t2bD znaqJ=n_E_1sJmlOpGxr}It))qfJ*{-WIHE)21T|L*xP3#TJ zX*5%7Fh6|HzuT9}1z+i6>qD(hc|=5X;DOF1bUiJ@xUAEX?G2n6YfK6) z=v^=&T(L1>a?<-f=>p7Gjo96ka=J3$hmeaynnj}y8Q_YpczV9n#Z|vre@(hvzA9F{ zd#0)TVad=!3Fn}hL|oQzRHojq{(@Q!anhKzR5Rl4MXsfs(%WfW2C7CE3RdIaGAY@i z{ZfV2UcBs6Su!VFdC(%3pQ>1%-jeg)U?g#4$+Yf4OfN%ir0l|M&~4ot_5+#K_STr} z^&rKM*;x8$AMNK#Ia303Z*bh^Q-8)(Q@6D~z7%FNTA;ROQ#f_$g!%Nlj04LCU-7Cz6sbDT2Xji}?}A$!H&-~D_ALHNWE})qwseE=m3uZ+ zEGX#6v)2uwXayS}z=FPv3T>1(=^>xye^Az;9fbZnKfgY_ULpJ<@@w|D1MjJdKF_&GuldD}iutm|vF^p`CD3GM zA1?iJ@LJHQdzrU9nKxnyp!}sTsk-R#vDZ1xz|S=(fAk41U39;19Bso9kZ>bemld}3 z4-}cDWnC|=*_70tT9FLvg?-vU69dVj3BI1U+6;atti)@>!64t9};S5Ss? zy@l_Apiy!9Exgf({6@k&`UNiK>wD{#T)6pJlMWJs#uM}r^0%!fLUPlEb#3*#SD@dh zSp@>Eq^mm6$r83nVrnQ&h=M7=55MT(o8YH|z8NfxfBnjw!k^DR@p=OmBgjbsO7tjy z_e7sbIMvw98!Xx2pBH-jUxUpjBuhzR6X}^23+NjH7y5a@d2q}xf$`wbTwUC`syt|d z?ar}+FPMh3(&)R;o@u{r>3MtEUn5JWVnVXS)s%*Z4=K)fUG%)%2~$9g=0pz6q@wL5 z55mT#_tWjP*aO}4kaIxoknE%&)zR_6Dd{0oA(Rx^(>x=$tSRLGYn9TM>G5ur2%raRf{ zqg&$X?vjmuz6oWK5#YJ(3GJdzEP!ngq7e4{M54`5VaQn9`SPp2;{;l6gzq=tXEGY) zZ8)PGc=i)JjBiYS05=kgsJBP`hxf0Kj&l}X)bkmKX@FnAysWU(e}Z%%i!1vEp4tD$ z)|Ut5l)mp$g8&dYaqt;b>vugqfJD)qK!Mk7g8v_Fuul0WsG$%Z`< zP%^sZny4C4{yTe*g~ASng`PF1o>ER8T>7L*z>M%KjIAO)zlXu}de@P*v_7>BMUQ>mAi`s5|8?3Cj4+`7+%9mCZnWfDs z1Lm?3My&@SF5J2?h`{);j~qTJ4lmy20Y}BwU-;IlLVFo4(ht`5bSqb+LqEIiNJ#nN zInA5qf#WU`Pqw@HeUoXmoWCj<^^(i)%BpGA1~0X&Ayl0^jcxHJCSli$?R#N0$w!X= z5XMAzRvbV;zLq9^bVi{jsx2gL5=b2bv>mE%yyyaSm|tQwZY86GugdA~Bh z{(*GiJPV0p!jo|NB_x7&>E}7#p4D(5=xkE9&=SIkbb{yQcir7iy5|W}6v&@5hT@@C zaa*r?B*v#9NKD8cTKL>Qs!Z}kYB58e>pb)7Mv;%%)!&1h<7%NL@z<Bs_V2JdJQn2Li+;MUyJ;-dWYz| zFj@C@)6$F|EG97$NA#jng|?fhFin1BRax}~KP}%UOn5@F-%0s+yH}GhJ3SbEsPj4h zCj|8CAm0h8jPJi{mXiylK?)XpQ4z6P&MhYYup-WFMY}=a)+s>eoH~^Sh4sD+Oo{)N z0}#M}C~mw?L*nMiabn`?E0x^~%2N+aLCf(rT_G-93ptHfJ+8);ZG`fSm`B`zm)P}X z*~e*PVZnj)PrfYERI?JeY2>s)M82~kcMvTWA?X!H)h-TrX)-zWfBoyu#D53jf|!duyD3e$~R?*@NIC zDizcAifMMO&H3&{5eMvOs($3aE_N3R;nO;M@#MZNG)oH{GXhPd&p8uX=f4W&Uz_6> zxcihRr4{Ih<`KS!+Msa?{UcPKaorTMJL@>}5kYIyTs1WoN)T!flDHW+WUm#Awx2al z3IchGDw5&Vs7T6khg|C#b{%>%hqE*7xCY&YGB@4%WBkv*t}oX~lEMhpK9F{@Aopeg z#wFE?LbKiu&90a{Ll9PC3`_(i$VX*B|EkKQc0r`;JCZ83hsIL7#B0`i||3_7*Rb65p50ZLR zL`V*DSdrXm_D7eJDu{vmFQZwhitytdAuFr+w~g_D*h&G^E_ zK-3y{wMR_>awtj&^~5(NWh;@J#)292sHoAyXLBj%|3BQNnq2~{uk1@J!crF$ zuEZKq>rLTFxJEvdw5LQCA_*(u7Rv?d^Z)t9|K}EfpedE;3-tE+pLtspQp~np$hRwS z!H&h)F9r6QAGh?iAmvdy%gAzmK5?-o<<$Wo=ss*?Mq#hxwlQm_NmQ#sks(BnTv>QU z`aa9!YprHWvp;lAA5`6VRq(tCP-2&tSNkc=)U<#^&wcy&zxPrw0rU7rvHBsxb;uUh zE$*FaB2gXOSLoTo1Wo$|?ZDa*YJj-^G1fd=Z8zanY95>fniUokSBV2C;7V`+kt3N~ zijag%J#O3egBW2Up+i+Vvdzl##+oM$qx%$OFFkBF@z3HI-J1F>npBB?O0BxtcCy1m zubCW(GaGgP{*9!gom0*3{he)h@An@nrh8_e+jWEt(D8Q5-&km$hdUVk*sSuUx4iOe zH@g@0=_KCokA7Z4MIVRzFa6YIF0>_ljz+8Wxd9ViYhrNPx}hg1w-X%J3z=s5@wI2& zH#&z7=qkKR=!yw_0bKXk*00T-GHE%1*9@GM%U!r|JAVn zAMhdjk@X-icwU0MK-{&AyUsfx5(z{gwsiW$SKmSguJgvU>;)CZ`leq}Un*>ESzb2E z{D!>Py%|>BC1zs7rxp3Ey(5P>V66oj4Fs~z2Utz&*PbDy+SJkCc{e%uyR)OdGMHBf z2m;z~v}4X=l>C00N3}xU&PJEBeN zmY|}GZh?9|^?ON@XH^*~Ai=K@I7(RZf1d(gw7b}Qa!`s-v;E&^{ROF+4e>z9?ey19 z*j9QkJcpu#U)vEB6cMnP1UlKOQa4$x>kg`6oP_5@LD&yeoO^$4quQI^+dF3K!^yoeM%5=)j|ci z_rUfY@KDKSs8EY4Ne#IoNE^xdrLY19Xqv#j+S}aj#ZovRWt_q1a73D#u8l zj(!*(NOd`p9xIorYOSKKgTw|KYSChbtXNNw@4gZGzIofJ?fc#tKDiNn z{@=Z8!mc~J^Bobj@gnBGLmgRhxJV;oFBtVK_+BtlW0Ddr{TQ*k@^{kAfP~US__L6J zh}L-q`wT^ElD3eX%Eb^M`6U>J)5tGuqHcfwqVVzZgU0vOHOw%Iv`H)v@;+!#s#JUM z%HUd8=|}Cn*iHI*D+Uiry7*;a)t3B1YbTTf-*FjMc3uwOd;8)7v?56LjpvE9D#C0A zd?*qswblXgjuYbt8K5>hug3Rd^^WE&Z5pQ=omD`y2j<8_BME}dE93nim9IYB-2K=LFy9E#6w_9=cw3r#SUJ-sku z;mP7$G3A)Py*NMF~-$blnW2>xx0jg+%&cp8t#BhKa3YoIB z-i#P!F4Zj=Vnmu5)-{9Fu{16t%B)@FUPj=b_}v&iG3sN5P%M;WzNwkg`i zM6~i&xjz4&WmShq%6@NdPNf3Du(%MZ z-JEEd#AWsdu=>c_G*8`U3_*ELTe=ZIB1e z7kPq>eYDvl9>aJx?yq*2{iAauCi|dtOZ2N|R~B|3wJG`-g$j3VB>$q^u}FKAqo%cQsc8aX#Wyr4ai~}rv3|`Rnf9zoB7?cSR-wF%~tx(t#UY=4;E(# zuM3Jg`2|X`z~9EHd?Um`!isgI2tU;)3bEb4MqoY&RIn|FmcBo_Rk~PWT{(D{f$~!H zJYROs?24{lq%u=?gQGHFE<=q&39noVGeGHDG(kP{%kg*r0{KQ-yI zL@3Pj z08iqbQeNu9e6CSj1zkWYDeTOEv z?47Au-Bf*oyh)_GHdmuD$0!FL&^_nBbjkQLx$g?P-^DMf-@XP5;9WM=c_k1TKNq>Y4#1Jx$Qg|`=;r{97aT0kk z7$A;u?)AlSPkU?|Z==6~(V+cM5em7eo+8Ev1*1)ZebXs|fe`qeTz_UC(en;Wv+gGR z-TkIzkbf#xul;vsh0YR1)HdZKkD|5&Fh!}sj)=AvP;H7hZcEi+IR61Jkt6g2KA_S; zXy~Vmk~u@$OREe(Mf@%&#`Z;vu8T$}a}SA=f0`_jxP3U}#o z6wF%1jkn2+GJ6Lru)^zRc{ta)0nGL;jXt!VFZ#%-BtZxu5aKBeVd4x`+y%GO-0WU& z>Q%FVn&BwF5QOKPYlYAd{YW@lunm9x~mHkQ#qT!$IfIa|Wo{xK~97|Z_oZI7} zU2U(>tdz&U`dn2hDK?soeuX`T%cS1&gd(Z?YShL3?KUw#m;nwwk%?0}>@)xsrkK*# zbC8;S`?EnpMp~y3xx&kkW&h&)7pE3=Osf7gc}7&j59|B=(w0gm67c+ly)N*#-KWrz@9P4QLSIIg{XJF=PH~m(PGPry#CU_WMA&DK!g)7#bbXje8})Knw!n|pp!D^l^1v0B{>IU&kRg53Sm#;c{pCudg?D{=T5lqn$_>B7uk#pI zmt$vp2z1d>+v(^rMysw$M3x%~&}^!;u7@JgiZ>QcBa-(h0S02orI*)u zu;v;aZUol&s6_$mfmA72eqASgUi-&-SVkh{2aGmUzje=$JGSryDuKvT3o`P{;CxyG z^(+vfpiXgtlM#_=n%w0Y#Gd4TvJ|YLvM~QBDQr2aM^TS6>+0J7491a$(%h&Sl+|-A z)^&*@6@;nl*td_P*|cI>DbSwiu0K}0M16GeBT)U|a!@gk8|ak3WjXP#2ufwSAvpsH zO)Zu)+yI!DPpe#h#9)1D!Ls&`jLGtZ_(LRVC%41kaplY6(oFUMg-b;7YirBG{>cKx znK5CO`8s4I(0k11wqfWHcmw@}7YwttWyv#_R0w4AR)&M#xQLB;)QN06tADb(`j#YR zgaKWAjx}+sPC2?7lUD1mR=Z^Zlm@*mm*FO1y+IS3Xzbh@<`Yi<-t+%C6`6eRKL%^NhC=aJMQ#STvj5QPaen_L~9by#UEWds*zBpj`H8QmK9)W z!H1xOjVRfS4GPW-|NkJ1gzz7Af-|M!2fo?)sewSBI6yB0o91Qsg_LIeu79+W66XM{ zdKTE4Z^MzE9NrcBz!qQ&DAYoq4`tyKDQ1Q&cBcF5BI{GyP$P$v7ujbbdFAFi#>86?y3h z18etrcA#Ya!CH-^g|~&$K=USEHH44IIe`lqP8PrHoqKJFOeKu}B`Y71DQ?~if<7ea zgxQco(5-_|~a)KeMX5DvM$C!Mwf@=%4{1Q__+j5@@79HX{0n=96hopo75Yv<)}PzgJZ zNaxz?a|vHL4q6ON?n#?I)Z>#__493 zF*&9EoMr2Ow6FpWAQ@s@vjXh{QezZy`?eR51`eyCl4hCp+GQ+<`Rq{zzXsnqLnAvQ&sS&H z_#XJEEip3Dlo^_9jCJp;|I@Ihg|lR?`}=wYo-lj>9^%v9&spB6K4?1o9Zp!Yje8ic z^Eb86fP*wJ(%auy@YuXdDi{;$3_b{Kk1RN}9@;Zktm`MNfgzaT;o+mtR>}tSau$KdEmxqM zOQ@M58`m1{7ap;@b$Kxr30{p#rSk#fkhfc${>MW#G)I|b71>Ml>X0!@)W3>G5h zZcR<14lY+`MG>Odf4__L0U!uIfXRVqfrJUUq34>nWgC#(k{PGjnLvYxoym2SpU2$` zj5c?}&Q^(leH48#+M`gfn*=T@wi!E zo*|TpgiFoqTm;cALzB{peoQUb0l6EJ1_)nKGgh~b)<78*!;9nsG;H@vC`EBcQL+D6 zYIKsP@6~@!b3wa43v`O#0ql%GIkvJT>H`%PokQI>!-=x*00+xx9=O5Kq3Dm(W#H$4 z)M%R~+Z>W#6ifnpHK_mn>xm8s?gZu%JELEu!~AQbFr<6oJ@+s;3{cB1#Ft>GaybkI z((e{p2bzR)h{STrZm|xZ@^ugPZ+6S?)*MU0Bqi(+bu(Klbt?-HP#j7qW z#Ku;wSxH9!?zq!3dOdt$d60@y3@mdiD~F)=_;#B}D`Q3+R~&e?d<*I8qHqF0>&ND> z2Ls3sqdE=aK5=twr<(22^F7kLd>hY|I#`53MhsHe*%(4IvN?1JQ zrOXKuT1e?29rM^Z+8avtL&iAvA~A#`aVN%Tz*gNqsDV$({kNqtWGTU@_zTz8>Q+3K*GF@tVHlOz6&_< zSM=TW=aK2jC>H}BVQElY!AJTGxH+Q^%8dBLSW$dpkE#92Re}^!Khp~63;^T3u4!v7 zXj}_zBq3ReK0-elFfk7Qu|*S0pYA~fEQfyZ&9m&7E$Cwhr%^fH*I8e6v2mU5yYr>h zHnAuGptg$wz?nfUO~ja`o`7i+uDz=5J5+e5^l3j0yEWPbB5zVMl;oide!1NrP=5Da zij1l4@b)cj?7e%GN<*XNC@Qbgd3}Ir8*wTfog34?J_CwD)SKOqh|(MhPuz$4JvH{K zQiH?V33J1Jgg&7w%XY7Xh3v77=suin0Y2@LBU#uD`T=kZfoL=PXUlSFmB|#uw9Nlu zn z(ndRUIMS<|0XniHmh8@d?yZa=&GWZ{uNvl{VZB}3{dO#;Ik8!iaOb-fA%t|2&PJ)y zj2(2~LSc+aI5i*CtDo*xM4-UBfI%1~B(cXfPyVtYk`NQ9BQjcp|3V%nVgY!Ut1!nP`u0Q5 zOCc?w3azW1v4*>L>O-|_wBc;Ktu0O7^-Z>mqTk5JgonOnceNVlmhD7OH3zH02{We& zsw53ne32vJu`0z==o68U>(Ze9znEJqI?^vJ=xhR+#_y?Sq|-JsZ@v)lLI+0phGwxx z&j^Ttqm0~vA3A%X)@qI29Fg{{_EQc-q$O2{=Y*m zTHkPX27P_XgiMhMZFPkGN7hkg;{0rDafFF|29$TcAEhhHRh-781MpAOEGYJ+9_PFE zr{A>6DY~F4NJRS?vBaJ0aXxW}$CYsX`Hp^&E8h@7T~OF0%EcXkJP*U^k!Yn@X?GU3 zvnUir0FAV(ow*ksoAl_oGlrGWCVKe8LWS*U02ZWX$3(FJ)^{JgCMJ%Mg};H1!x3{f zHXC0vSpB~ryb@Np1omh*9bHBrSjJ~IR7Jurn2 z5L%X!Tl2uO2TIT4i2=hL?#R?yr$$e?sQd5|SFIEq`132|&(*D+fOBt+Eh4#XRnpJ9 zX@3mk7GKz!kWwHbo7{<0T2Rc*;QWUXev}UK5*H^XQa@cBxD#Vtwjm?DVoBGj+Mz*s z*jlYiC|T^ALpTB!0;=-bv89ABIVE^b)MEC~QhycKd&I30Uyh}gFrH1+-y-SHM^ZqP zNVqe!ep90~eL77Vz7^b_&A-$yC!#|xI0hLfH*28K&M$IjpZv^*Qq%S(G$(gL6{;mB z-u!aN`*gy@y~n~`qH6Z{o7eW#f8GoN#7i*3DT0R}?P9dFCF_*X33nl}d6zmjB7yB9 z_N6t1@3^)R9I&-gI=aWJ+2rd=}|tb1PUZDgs>j#UCXH^C<>z%r37T^u6_9lHJebJYAD?3%(yYT5_fuae@``tG1Z&V$~MEp zDQcFBiQ&%$j>%B2CU9STqPY4|CcdJmr!0Sw%Os;=w`oR+L<(H#NAwZGB*daj3?z1G zhH)duN&LZ2qN7@L>GhAy+WyX{!=kW4^jRaLhTsbj8F zsofH#3ji+`45+C0TP^q@hp+^$B-#4F6F}-8t~p&YfBqC~EWr=KS3Q&2;M@Wag()~b zC(?Wvbmz#-ov;qLd|hW1Yd&8@$Y0)hQ&d=IjrK8FORVhg;?z7k%(BqzRKR%a8q(&9*+=sG-*QbZ&tePj`|dn*zGiH zPpl8Rqz$g>LurC&$9Wci7`79^9<6d$Egvb$!V!d9XkoX`$$4h0X0E&YRii~%Be60y zOGtXJ8U_~OKfcU3?d?%!))fbFATXQ;pR$#ewU@uCp0N6gfmWfmP)(d$G~K+U#=1kW zX(ji|)=zFbbsz%x&u;PNgyEN&x+ixYj;%&!74s7rDoo)poI++4Kk8N_Ii+~aVgl_@ zItH14cKbzWLRQJOM)yj|(KK~)-821GZhnK~>KJ>9hkH~wXz>jMa>-Y? z4}uNE0<|H#l>E6V$YYsP>p?h6V&_C9Z5%Ym4`zo0hAWDHv!1w#V%Hq3*YUpn#G?<= zpvDQ&P#UmvaYXoawlM1Egt*V2|2N!4U}E~NKpYQ>N0gcBp0TtFq&jO>R!WZGO>K^^ z5kfa>8%y^cW+9g!DcjBGSCdG1LxdbzuJ(L%M zFOE_GrbqEgBMIu+pmD9-n*)U`DGrs43QG>`)HBaG9+uw2 zHY-fudePJyJ6%1i;YIF@+)`fOun~~;=Cga?gB)3STNs6&GSVzMP{B(6tJ^mANFr&a z;aq9VrmtTpxZ+JF#c*H4sKb=9pQ4UF$KLo0r!TphP20e^4d$ti*TKFwa2LYXHC@7S z4AwvE?_xz#K8)kb4w{!_^?TS}p?5hXNstg1$_RKBmVgbG^1^7{Y45v1j4`y`WOicl z-4O)g{DMIjyN07p!^XUS@?!7$2un$lmG+>P0`02N?+PPI&J(*76#qBX`JHq=zg8HBe zC~t7-Xf*%ci!1T2??OGwkSe7f;Wr2e++j!0`a9NkBf2SK9j6K})!whb5<-0<9`y+L znwL>{_95Y50cbWIgfXn2I&xTY@$GjG=85+YW~0MB^E&O08lU0TQzCPafV^=|RX3*t zd=rXh2~yNJH}X`RrimUuFlicF@_9JlEK#+p549h|z_cIL`64VK=DqcK4@yiuPZ?0N zvnDbm!j0$`b#%@oUd?qqwN}H`X4lCd)r9jXAIyZagUq-1jV$a~D-|)QeqI^0s_p$8 ziz7;)#CF&IRfoIyQ2#!M_@b4VN1mNmg>E(nByWfujD=&u-r$%pD;%|q@T%R7+Z@~6 z3H=?%`Q1jC*5&?ecp=2+!V4cRn#G3zAo^iXCKyWtr{K@0O@$!73}Mr^A0bMEtR)Uf zCJA5YE1FX*^ZpJ$j25B=0%|gi>%L!i4@%H!00~yZ8NR{^IZLAh1ErqfD$n2s_Z&pP zfjc#H&zmRs{MEy2`*hvRvT}6L@PP_%b8Dx_s^8lv@2nsPG@z;)V` zB6anW0SyXB*kwh5J)k!-s_6!LPqBu-#Et)JJneP>l$&gKQPU6Q3l{0eK=4cOy` z55(9$!e4-Jq;zT}B7{taul`r_IsIQrspV{DepgDFMAqyLz z3wc2`BDQp2iC_ULtNc72CpQU--deF#gVTdcg(w}PIwg;A9uCJeC$bpoO6>!`O6#Yx zVIu@l|&~+q!Pjj*JMr-)MJylMRmpEUeFG(PX zxsx`|yJQ!MZ*p|pk2iQ$I6Xz4Azkn{+|V)##Xl4y@~1olQLfI+?a_OXTg`=!rjLST zmIpc!5srMI;?XSRrL%|1%rpkV7IKhq7-l{bW=o~_4Ww2uolB!t|5Z|@G}Y&&S@KQ$lRgVH_!7H=tb2@5hH1 z)1IoM(k{)XVE8#_r&N_ds_NXN_gRfK@v*fvfpNjok47$*wz|PXJV`h}wCljDOvdVZ zURE{yC!GpxHg@7RF|KWM&hhO!gOc&o6ofZV)8M0>&;j&DXGHtEFoY}&pOk3mz?l)- z24Rf|XPS}WH(MCA6<^LCxf__`)?29rpuhVzUSz@ZDyeQDbcJ+#OtrNQ#!tGYGpql1fh!S&FhyG6qp`*n6HtG@5ydZv&0lLsr)=G0$R zg)-ca-Yq{Dr-rcMlTA9f&O5N}Z{5?>-5|wcK7Vgy=8odGD~)z{#D)~kvQG#JPcoLr2Zfc;=BgPQD z!JPBcu9i83iJnE)VdUv8iCzw9|YR zftXCJt3L-CDGyER$>RrUX@p^BPRCKk^A!+jCD?v#cB&N4+i80|go4aelaV%2pI~Kh zXaQ7-C`hP5h+dMlCJ2S&w)P>ZGEK|i!We90ER|Eb!M;l=O>|3Eh(*NrU>XoF$SCFB zH|1MVa*I24YpP{U>T28INP82#Y|0BttJ&%3zR^L11OG{ywD6~tc(T3ai06XQYrBim z#-MrAbr)!`LElF_pAIMa*i{aqY=9G)Ovuwr zP9Qr=umGp6;6a4q#LW~&Z}eEz9joX>fRJ!QP@qp|Go|1sGW?~82#E*|aBBMExD^f! zMzB18@9h_|1hY`UMk&1)K(gp`V4;EgxTQ+LaN49FY_|0k@G~q$?4$zI^L+HqjUyR5_MXU*6(T`-O{a8?+G|eB zQHKy8Ua~8N=0gJ@R;l@Ye_o}QTrBA-6V~y7+jDU^O+cGjJ6v#fC>=dBDKve~pd>{ul)_%3Nkpu$FdO;A$ZrYi*gFcI_27k1lJ`KR>AjWa@E9yY>o zb*y8%FnL<>v$-JXYN`Y`tVtzjld(IZ>{L38xC}4CjvCM_*&4@ABC00F{B)mAA00hw zAq@cdl2J60!A*L`64I1uFgnxygU@g8E|IB0h7~&5yz9BmS~#tfLQCuyO8;0r*FRa! zogxEv-*lJ*?IzVHcm8a zS!7=f_zo<8Uan}=!5`YH4amU}!2~!E9KJhcuI~%JSNFdVG@xdnaoL^Hk(1p@?Z7&6 z{KH0YFUGY~&V^n8=Da|NpKE*vT^c@XrYzSKN<$}RE@a1j`A2S7s2im z@S=YxvXk;6<3A^luGgNObKk4m8?*U-PM{H)>K|PdMyOPLI)yy=R$b^^--zW$Jmyh) zC<36}vyyR2TJCwbA<0SYykUq8RwtyI>Nw+mC?Y`MJ$u*p{lct@(d5atdBSfNDAGJ{~RrvxNuc#tN?_S-*G+iR*_4HSTiX z2#LF@l_R_`|ADhs$G)~B(!>qLQ*AaRi#Kc5a(VuCPyTtS!+w&;1>8|;@#E2P3qY=ZrArhgK z9PY0SW(+k09X)X@6n&M*v1 z|9>S|i_S%$b7mdiIy7|`5Jwv-40sQ7)zTBeHWAao5eTL6=lBpy`nDB>MXl8;=5vrK zouyloI~Knx`!$@UPRN@5(;@bny(zea;_3qaQ2O;>sCY367hzH#Jf4;=s7XM=(C ziFEy93aEux7O;!_HEgH!`PU;)`6%ocRt}eQROh@#z@|1RVEkP~pd9pK3^AQ5>x*$# zZO;e-m@#l%TZ4Fm>m1^Gkk9@oYj$aF17FCo8^S?>rKryN>wkt$0JsoUs7AQ;U8~a; zUugfud=Vr`0RHry;kom^vbxb%UYdAcpT+@cCLxu=^ucfcXMTN!^Pdq(t>Ds3;Sch| zb44g5#BJbW2Hdd*q(qd$ffr1RYW1(U@a%)nbHB49yhPy$rZxbZUhthwLIDR0x*Qiu zBoF>hpaY$qMb1JX$sSo_J(NSR_q;{odxuYPDtDzXYE8y|CG-`91wJ%^D=yTKd)iow z&v#}~36S`8Z_bdE{fi0+&OO2@a))gE*WjFal3tI0(R|o}stJ+~kGZIZYfRUpgh{@3 zzF56>cXV0^Od<0+9}*!S*aGB#3$JVq-!a({PbCTzRIEefJ0U4CkUY8=LfkM%+Vds- zt$U>o6|2(xDIFX1p*Ni%LdTrSqyK+8X!=~7ajxoxJr%D;AbSZvYMlJP_Jo=1mR2{{-g@0EDQPtLD_--|^`t~*3*FAR>H4*PwdbjwM&bXw2u+T* zX}(;htX4{utcl*fT?V``$#XNVkF}f*Cx_7K@5Q2V9;M{Nw8(yA;#K8i1|WafRInl@b+% zr-fUuKL0e=Qq!;PuF$n!{UfrzWQLv~F{I=U;k&ySSPgKR5<64#%XW>+eRM`;?FSi_faoGV;1mWZ5&#Q9Jm^W^Xg=D|0k=wlu%ZJ_HS>oyB$s znx`u7i>N-@xCDT0_&a*1Vh~7o#;42NYJBUf9v25Fz4Sd0?uF2Hc6Wk3IX0yfcUsr{kVdC<-ST!9286okab476X7mU|B< z0~I=_b|kCWM~8OH>7>OlnuZSur-wjY#p`4uxdWrmp-t#zE( z-*~@%a?ZrZ)X&Qq+d6RVpQ!w8r`fzk+nt4^x#GXy=(4ZO=U0~PqIV4-~v2l=l2^~`78isA>6h$ghsyDKRL+gk31#Fksv85`n z?cQgP#-Y3=_%m=Cf_l)0@uSrOAjyhEs%EJ^BRDZ_es$;((gg7oq)u-y%M*T{XNa-~UC_fhK72+@A5%%`cMcXe`gZ9!uCSeL_wSI zv*K8{c;5q5K$)kpA?O7f08=*+sBMYO!e2LiwN$R{P)Lk;eK)|T)Ik#2|zoH}$dsDeJzneI~z&S%rmS{ia{S<7hu0i}l6 z5B{R{)c}#I4%#=kxwcRcyUlFYK!g zKHQ;)-8uhx8tHG|pSd(gGt8i?_?KN4>WqZDsHWs1;(=&e`_}f67m+vMVC0kgA{Kir z+p(jQP@BJIggagAu^wB;;x+8`j+XL6itB28W2VmaR3w*0hmT?0{x3{MDFUo=Nqk;h zSFGM2$n@CWkBZg%1PX(tc!b^0D8=pCP~v0c9q$h}qh>C5Sy#iI7tL-*HEG9l0ehZX zJB_9kB%^R`jjsx7kQXb#wLA?fTy6m2ej+51Ho#Tenh&F!oMs zqnB#RJiemd*IZrS0`c(rmd1R8mP;*--Yqzh=D41tHePLEF2sv8NRByl*`U+shCM!; zq#8|;!(Zb{z|Kf8TsG&@co@I5uKA70SGx`P zbhu7UhR`+CLklN4X!@8{Afd1hu(~Iko%4+55ak=aIFb?P|t5)Se-EqIgtf>QY3+p3-{-n&yxhpDfLbmI8iyDXnx{-$?iB|&Ct-$V= zIAU| z+(zp*7Q~rxOS#%w1Ojcz-IFbPE?|xPNonYyvym=nCYr|u6Ao8F9y+>cbu1sijJG6s zEb;70jTsywUZbk+d(2shWsNpM0J1+0ihFSKUgx6rZ=kfoh~M-60vCzu7Vx|JE?1Qv zo=uweaKW6dFhGsrvneB%3|o3V9sRTO`OzlGQz16oi*O5pAT&kU5b9J3X zzTf0XqEI{#KmcNZdHr~UtG`5~+j2;cPUlR-f$$R3@onxqME7)!dRVqpyquD5?h(8P)h&Fua5;+u)b!13-1Xyz59O ze5WaqW2T>ov22-AJmi)#YS0k0L*~9_@Hzh<10G!%;84l3cjr~sB%k`p8`4CdmC(N| zf57V4o9CW=B78xItC zQApbVJ5bH24-cVr4Lv`}gk>b5vwnza&W_0_L*E%4ARNXy6665uir@nsC>g;U%KA%x zj{Pv?8A8kU((-PC^xy29-x0h3E0*0HWrFher#{kZ?<|9oPP$e|bAGbhcPdVNG85>M zNyG5C%|{cD_@QaHOsSH_%ZUols-QAc-zO2fzMoG{>KJuUv3X&eGVvzCS8|RPE6a5f z*ntFb&^D*zN_a&oy#$Ye3W8V`>F@mlX<12*R0wG?R@0^X%byZ9LK(K{(pfl~5eExR zQRW5%yyKI7g52C)`}m25@$cs|shU1BtwZuDLPzIxj>)_nvj>Hb$CG18USiLT{hPI?=vI2)5zFFY=4VASdrl4zJ(T)O)Rzi#If z0v*#wa5A}~vYbHf5F!BQqlS!Fsy0FA ze~gjhWq4bG>?xY3Apbj#C2oHRwBaJVi%L&}>iwjiX5X+SK*LGtkqIky>mLwgF6el& z9qv(ftNIWrlo$vV6nemqc-OCn2e`O!a8+ZnKsw$LzKoxl%Hvvqe?|INsbX6KyE$!l z*q6hQrmGx^vwj`6?bMr`Te4TL2nbn!^?*00SAb1@^@ z|4^_Y)VL84K@Ft66hR69ig7P4iP*Vz+)=Ntf!128voR4zJN}&G+KAb_+NgY0vDe>f z<#QZycjVuq=Wm4SE?(>z1vuvStKK_Qb=dy3xi)zfq#gJXQT{p82X50fIl>Gbg=J(( zPc9rh3nBTwV}~il;ezp<(JSl(JPBAl>n5(`bDa;EfC`IZ{{_KcFNIPbUIb|Tetu_XpOw zV#I5qcIf9x-)la_KW~jjpqcwX2^g>7Bq=Pzq3Es;b)d8e{9QpPIp2gk6RW+nxPbrD zs9N!Vo^^#~JnIcH&j%<&o2U|4RW3_!xONm-c>*i!yRn|^c8y+o35QKy^SA^d{Adea zNX{n&vk0}P#>*6LS_3f{TkwJ{I{g`g^o-a2If40E5ZGf+aa8Dqi+cWO#GSKAhby5? z)hl{}%Mjwtut=huY8;5tWGv2`aEte-Znr1KZff(4}44 zO@QfL>M<_r)-1Wj=fZKb)nDN`S2R$R@gFg^dNY%f{AQD?8P#&!>Dc=b=lsX8dB)ia ze4O$;!vUFn**hP&-#w#(@8(XBYMwJ zx8!r|*_d;}FR{ZMBv$oS66;AqZ@3sbD|zi)pO+I>uZ28|&w^D6*pEH@Xo?gOVH~0c&`~zGL%5u{6qepfF3@ zB{Dso3$=JV6f+M@5u^^M+5GyF>atw@GsdYWQh zAE7lz0F!Z4u48mh$g0)8|ILy85E|7{%Eto-HI)6A0Dcl2BI3=S77kG0Wk`T2_}*#g zM!D#<_pwF;{ty`h(YvQWG|45)Vr8150l*;JlS~wZjwRL|lS-jVg~JCqET2pqM1RVV zsVeYG#=lEM1Hl3P4!LW@^yvV;-~tDO+p?gppte!3zz{H)(Eammi1OxzphL6Ge@J2; z7ZwvBds?+jW8~6h{3JpDatRT(;Ly`RBC~l80U0QhqLm&skqrMU6@w7ZMka#mqKqDKLluVnjzjs@I{$Z5&r~h! zG-NweR)#N$+L}2ZenBq(DJ*UHcRl#)$kX8_yDDAL=&OWo15mM|kMCAO>pE|Fz+qJu ziUV?fS|EIt(+!!sy&XPv=#40mT|w=86!nD44P8OhujP^~+e@^qc_2H%ByT}X1WGqI z(FJx3L17=K#y4G;Tjl1&^tsHRrb}mkT(y|9M66dB(><1C6PYC=mX^1S{$@!9l2mk` z3ntOCTFFRB>00K}W~&c5G@+l94MW=?ey`0&F;FzXw2Pj}B>Bs}8F=pBeL}W8LWc_l zRKBXGK}HgI8u_Sm(ZOs^P2A#truI!IUgHC;_nyi@>3xr-ylDg;T;303&`*!gFA-@} z4fgw6Ia%Mh%@zy1YwI1(HMnvyQohz69vtDdOJt|jbp&QwgXV&S#XV5!>Op18S;kJK5d zy3iTB!rOQ2jyY^zos44YgGaa}`=jz)x2mB0>{B!h18X3!PzJe)kgPvm_$^G_e2ftj ziwv|jPkdn_*mu}v_uErZ=02M=&KMS7WDcF0;g$?)dMR`*3LFb&3***@fo3p(XHv;h(PjMN5?H%fb#Y@s!~_n zb=1;J;wBLWocPj67Ex>M$(Xpv`1(aM_`=>ccT3j9Hd=6)68!JV(+du#$|f4hF*d>( zj3=~9jPTmEV7U?hDT501GT)8#m^#u^qpIh`sg9>Kd{9V54N%W>cz@&SliIm? zp~-d&M{Fv%V35Zeo$^{Lpb*w_^pzJ*#sAOXt+~sm7tR|OWE-(cxFks-B#p*|4u{{+ zxwVpstraLoj_Rn4`2=llq-g;{ohA$zsaA5Fgvg14{0i^M-`B(e2TdLfrj1)?z7Ghr z`P4@RHONkn$pz3k%K{+ugz1c^DS~>)HAQhiD>)%ROp7vRZ0X~&oiMfhcjWxU&Ipp$ zTp~}DC|9FjoOZ&|^y0EvJ$xcyd12YGVI)J9Fh*P6w1tkKT{jKeoq{9(RCD_4X;LyS ztoLaC614=MJBLW5BfKi9zN}11k4$yU4ip`h3P24=2E~ju7|tFAPmRL#L}Eqr1Z0Hr zQZa46!FZ76E5cr&ipj@ca};tN4a+oEJ=D{|scCHkqia_3W+^JlVw2tS4C7^wosm5h zVaGo>2vh#Cq{E0%P(|`3fj!#-Hs0CpkMX@twgmD5^O`5`a}b+%@FCujPo?NyfBCxG zNDwi}m>f$Jl(>mQrqy20)?JV;K}m*7!0Y&NNTT6=n3_dP<08uGer>TBM9bd#BY8M+ zQaoOpqNV6r(^MRy9V|Uy4!RoxO#S= zbai_5DC_#paamroM(EXKm=B~hcSQRV7?iP5B%Fs1QqqztVXOQ<7l16B9s>%McbRoB<=PgzWHIeW9>i*Ih~!R(X7J6P!h_c6W3 z_acdJe^)ie|DWJ4y9tQRoNX;~pRd|+k%mo#Y$#rGgwA}ZJC2^)QJ$b-hXUcjAA*f! zI*g>%qz>!ISMoOzqqBsN*q|3V$Kz^43X>t~D6}H)5nBbAG$t7N#{*`Y8hos3cExId zuSYJYaas0sj69{){T9ORneAspDU!TH5*0@L%~JnKU#=2*Q}JyZ^yLT;yf6|z^l*x@ ze%_|7)^C)pa$7-1wPD$lymVLv>0Y!h`M%f}3rz}}a(%vClQb%e4Zk?S0In9@ zIRiCmwOJ{<4IjQJ zz&0#t=b=rfr*$6;?PEIE@sx!Q#o^qAa(LWb;+hCJyexrEyKiM6Rj&V#qmRP5mDtlI zzQVWRt}xeKrFM&SxA8=Y$%?8Nw4U?kx*e(@4&xa`i8!toLwf;qs5af9f#@q-ND%b) z7AmlbXYx2Nn)%Fb?4-=JT^^ZZZHL}!!>B!(aca}t=dX=)O2*zLxD5m@o@wG_FhmE+ zGmCDPuu|p+3a;7bL%DFOyrGsaw0-#Sdf@fng5EQG$4={20?k_+uwhGEsbD7TjpN+f zb@u5M*o}`eVdI530N-kg^;FNA=vmZh`wYk-7K=>%O8smFYT;v*QF-Lf4cWr_`&K0S z7ru&?iQxRX&ivmC0`s=1o6WX$a>6cAn8rXmX&LX>&?-BI>BB15PZGlpX}}0LE~>3# zy|8SdSuA#^h7VG6NR~_@eI-YbrM8f$iCOF%C*!gh0J{8LBircNT2eY~Wrs6w$+=*c zd9lM~2%X4d{~0i~;$yesNnnY04R>Bb=xFN&an;klq;13;Am;zxD*GAQx3f6BJZ+el zUTD2~c!ir@@R4+-ipY&pxA^GFIr@2$T}QktcR3wzna0t53Y{weGruv_WNv*8mhqPr z&U@ywcJwfZ!mkh}U8yni&RaJ~S3{f=za%2`L6Hnf)|b?yF@}sI9J|A=FOwtg49&Fu zf(Urjb}Zh6%~C(eS(`r1dff-Q6u8O%`H5H$i0mndXj2>o-$13=%QrJNK-QE_J7ZKB z>e983m-*pt`L<(oKE*TW;X@b>0=XHe)iijiwZ zmE)X;P3@Hkdv_)DwDYDbx3|gxjRW#+hc z4!P!ICk=aHw%)COyu@grLAM`nIIWCIIXttUigCDkl+ncADhr?QZZYdBRXKU=NoD2P zIET9DZ!%}yykaSvKCyT1(zBUSjVeDr*j|!qTffiDU-7p25lKLt`?YOzY_wx-Qr}ir z#%+A~*>mfmr0|D1xn6HvoqKI9OR`&SHf*AAX0Cos#g-3rw?@hSb;Grqz1C;s>W}Qc z-v7zm2E9D}Ny9c)*NuNQcIKaJVjL5Swt9ZvmFV8%>D(3Z$+Zbt(<*OD6}ENszW8pF z#X7Z#zB_9r3fuJJtX&apzBUUVzJv?md?BcC^x4PWatn8y}eahjG zd)ZgZ%Vv23q6d|JbhS%7q2JARwibWu*Q@td<9Bw6eIJ1`#viC?=cXcPx7Py^Ik4vN`{+N6Ci>RZ2eo_&$W@IArXfr0PUT+NQg}4pZmBF*FA%GG`&r4@ z%E}k_2OTppyYjd&?8}Og{T8V8bE)4@c=Tat!ixIq5BY=po7-=5>G9_sbH%4~W20x` zlbo{F8fKA`d;W;-cnHM47>q|xk69$^EB>kEWrgsWF4-OW?~A$M@4BB@{ybinW}#%) zl{oXRPv@pzetPJ`n@ZImA4I5_Ma6)@9B}NC#Q>VpU}c>hhD9m6 zX_0Gh8WxjiK48+Yv(>|+dD;K}uh_`cj;@4yYPtBlBSj5hr!B|ec^R!<7c6;KscN5d z?1>>w08gpM6}!nvVH-E#HKzJleHeCEkqOjz)g6Zmqizv-TT zD^Rz9clp(9ea~+AOryF>vYrZ$yBJZM+p$P?*!HgnabDREW3B9`CC2L&)u((B(F zNeV|EEbL(&P>vw9QoVF+CxZtCy7}2@6CpTJ?>h|x%Qac?Rr^y+lES@$a$k4jpa)AL zZfu_4A$+*ohWPMqvHsVRTE0HdFe`T$)j8KB-SViaLd58v(4-n^=#TfTR3DqCs*pd{ z^Ks|Lun?zynO@(!_Qd(j+T7G&_s&Ny9;(ch42t#7Nlvic=Arm!AseNr8RCy(!95o@ z{^ub_b4>cyXDsRw`|k|xgMK*A`(LGtyDVMxM|VAM7tuJRGghouLb)fQ5dH&#{Zv+=FXdnZO-Lw_fgJ4 zdpFHCU)iov?|ZLFd*so#*yWf2_vAA?h}H?HRCmGi!>_9tBrO_9FNl@JV_#2`jTh9| zCAE}=SE>)jr2B15<_&YT>zoro4H}o@HqKo%0#;_5i+3aT%)LK!U{g^E;AzJj-Iu5Y z9IHW0KM|iyG^&FYuoW;@-&O|=cA9rT?7rxMPs6LQeCb1ca{ZsxQg23^*7E4O3~=Nh zY){@8iAL#wV>!w6{2nmPu(;9{8)k3U;0@dQ%F2JZJ-&74HEs0mB{QsA_Bl;%-&q1b zGN!U}+hA;`DT@=E%*S4~vz;BeH|{|&uh9#4n!G~OtFV7QgR`0`y}y3C2q$4yxg7nD|zcw-YoZ3HckQrh8_NS zQ!i&Sv6<=oubOU8hRFA%d<(My ze@c$^WBk4BayK(JPF=)tEl|rPTm4b+a;1IxJqi^JPp=sE1@vuNeOx;S`4rrUd!Pq1 zy>0qGZU>t9`4JIWcF{e55)Eej&*Y9rWF$%#4}6S)SK1#FuZYI!gD~p(V%z}RG+8iK zS)GU9tG)xH=WaPO;Z5Ys+3SWsE--nzLj%uCZEpT#ko3Abee}4$Ow68=y>Gv>-#nAy z(SonA?CuQnZp5y!EU)iL@`E0`opWK_mQ(m5xqiyC!)PsD_-j;YQMJXzzPzUOyTK%P zU*8XY49Cr|x4-k+OmW_9TKL}&e_EyCy1i5MyCod5DDC5~PIv3RQaNa+3;w35DI?x} zxxvb#HE;#6KfFB!H^m>RV)X|KMIPQU)bJ5j#sN>!tB`|d+Z+F2>+7Z66{eJs+#|jb3y&9 zWXS86P2s}ldm5hW88YQWSF;Ld*BjwIX1KO9UN>AC=YFZvnWn4D$1R2JxY&1F0VbBG zZCHc~Us~X_KIXihO=FJ;)2{W&JQ2R9B##|xSWP@ITS8l=vSm9-^!!uk=yeicv1^#`Zvfa;)nu|y4`Ib4Y zO-a~yf3&M!)b*}G)}y>CBM=4cbUxc{PwCXar)S-b4<)@@kKs*u68Cz$=?7Ok`+m>H z9lv$Q>_YUD*W1SQd$bC!Yg61Jx~f}jliIw; zFB=8lN_D&aolX|KGqdLhHx%+iqRpQsZB~r+PjQ`v>H_Y9%_Nw5b2xP#dBFC~) z8}nv{0P7^|AuaJWF*QTN%UmzKbk6*E`pH~gsogh^#lM!akDAD<+z9bJe)kw3P?=_l zm5$Y8LyAzTUi+qPhqth;w+bng-rwnuCrBZVzWudRv;#S=b=b_`tOZu~6Sy0} zluvKlpl9>_cY(EEM#;~W50pA6VCvic->Sxjhcfc7b@+0MO{CnQ#rOd)_ezM@B9JJH*hys zDyGAwP-f6r{d4}2?4VKtEwtcZUae#X#r z;4*DQMju^G$mh-vuaJEg!K^5__3r)6=lVg`2iLIo%6^$_nJ( zZDaWL9`aB8Hfi`^tKrqo7>?uB`$$;#;#aSDr;hEfa`#^=#3t@h>Vk9Clj7m2F65oo zPF7UTmqxkzZE{ijiNi>1Lj-SK|2}ZJtYBU0#H#7MZShO~Tb(#^0G(cT>v^%ekkwn< zw4HgC|9HK80gYLuH5C3to?P%i-I4iM6du*4`Ijl0K@JU1+OKnb`C7OPnAv@X6c@`I}}>yAhfBCgOP| znM1lMa6)tb)~a_&cURR6 zUBa_yp##_aO*d25b?eElp8Qvs*Hc3*^GykNJJ*7eC>Miw`O5tVr^%NiMG#q3PA`}h z4;1ZY$`a{>tCk!(>24aNCf3{XtQBwEw75=oJSO~pI4OEoOLSaut;Qm9f99P9yD-@_ zM`Xwyy47=Ld4=H4Aqmf2F!CwT&%Z{MvRUs&_SLYnjfTJ*KVBGSUm&yx{Kzj2P`{2NA$3 zgvqw84Z>}?MfZ2~xNEys$X_+nRB4 zhZp-^n#Fm`x}+>AUOP~g@uYh~v+KA17d_ZouVH>p#}}cuV5b0`t9e|UvR}zEwky)N zf{{!c6&#|y0lp6rN4lAXYQ~oiVZyEey-fV87ZMOOAE;G>+fT?7XzEJ~jP17&KvwAhY3V4?X_5> zFR_pF2`w7Godq)HrI^VW3aumeJKiH;;Lg`WjeF4MHF1F-=fq+TLQS$$8fj`zzhL0ld0KtQo) z~d+_A6Ddh zm9c>=6Hlb;xCFnEyy&sEOw$!x^Rg=N4o8wL?Er(Vc1@z4`Ko?x%m$H7?)LK0_wg+c zst$U#8O$z91tluF&Px%0<+-%`NwfrsY-+jYAfzs)AX5m#i;h0|U{jSjk4wPXfO!#K z&wJ4Az7jI;sq&6?$q%tNG2}yqWtSpgdK$!{no(!kyiKu_K)`is!z|_r zR2z6H0N?S+TH0PC4joIQ1dKFDyj`Z*ZcWp!Xki@73|wM z!N05i&SR!~R<_V~D=XM}prRojZ`)s;P*%_Y5_PovK}#H#GFxj=QR1gwWgDljzXtci z>>d_v^bI+=(N3JXhXc0ft<*q>QpRpfDo7dxikOvLcfYl(@NqI5Y|2Mh{s#C~#h3X6 zcUgJg)lFVoe-a1oZ;~f#*MUyYUemYoy*iL@)tvvjwQh{R9H6=SW7JWXiPv7@ljX%$ z5c+^fwKUAUIK7K~Fj(QGW&$@$X#c16*WZfwnHj8PU4fv+cA)uofK72<(B6Z-Z~Dm( zte^>GDo^_eL``xE+%aV!+b$+%v^F;7cZ-|?UBml{7w1feun*M|mH;GMXyfovKeqKyON0_Ya_L?6(tjP~F` zoD&d_6@f^JKpskiR>Ni$`fd#4B@xY(B;sEV$g5(Z)At-OO5`X4<4kLoxyRBec)$X_ zdI?~eK48fx+^b^v8!P=D%ST<2l}Xhm46Ndr9g!f(F{XcvVLxxm4I#Xum{%bm-|y*- z3o4?T7$t^K8{7G$irdZ5b6_LpbI)h3$NL^0#P1q*km#&x48_V3OPe8h1v(tkX0&ig zC>}*rZKK43YJe5CAzguy?)iPc*A(~Q0U`DQp;=ShH=Ad<9ME(eMnIC)Wdz<*@e;9z zp@zJTX$XNZfI-j4L|Gu0oiIs+yf6|&Usfykp6B)`)>cMDnW*}G-asKRHDyN8DhKkA zuRV5pwVY_R9ZbGN*^(;Ovcx@^h4%yqf$0EZKuY(-_yM4*SoZ^AM6}EdVhMz#e=x*1 z`UuBv1%H{;mmO8}?FxWd84-&k^?~jL6@gI%LO#21=AZk(_eVNMdnX*~{9ICW;NoesC$1zg7!>y#@dq$4&SsZ&m#qxD^Rh1$uYWq&y5ye`X&mgQ7wls_K`&djXLR;M;AWzrl^*C%s)a}no!wi6z zSX+Ca?YL{=hAFapDm4sevZjhfR$u`ROm}M`OsVnzYA51Z8G)?MZvI*iTlM6J{_e^s z`7g-P_+{0|Vjx6fMLes%n*xErlotUQ1XOr$5Kq+yhAcA`^a4dy;jhfTKKN_RgOBM0 z{>mY_)_mZ{Jtb^8hU9F_!*P%Wip-oUE;zsMo+VI-=lQ?PA#}z3uVYBD2hOWRISsTX`>s_ zO>+V8Gyf7+OeS(>9Hf@n18b}7sKLs+;b^;sqR85-N;^I7Rz#ogeP}?eh5FMJ+C-6G0;m{|OXv-+vE(4s9;XJISTTz2b%qCpO-%bu#3l5lR@1xgYAJ@j z1hs!RU%(B9HpL$5^qeG+SQF5>cU+1}AfZfS%P{sFh)|NN-;exB*$YPt0#zb|P(vU+ zbbdFzNDEIXFy;VUmpxh+DC8787^3UDXCyNL!ps9hmkQ#(%mm+(ACkpzjs)v9=nDam zR9ZunSXq2UQaKXMET3{ zizAJY5O?7-W6CpQt481DT*}7cny7@xB^Z04B!Rz#0D5RfSfbofR>CINLMgE`w(2q< zx&sUoT=&HJKk#e@=ObCRA1Wy2*WUtpgZds?v~cii(8t|>NuQefs76la_533E#VuBb zQK}5|0H}kdoLQ6@j(7z7uUnRD}&# zTk|C!1b9;^@yVSlFz%@Z;u`3(aoVpTE}`gN7r@yY;_8J5qf3;nK95`At)c+qUpE2# zg(jGXGO9bpT6x{1GN>Vf--eUWW^cfNEd&s#HP*Olo7fo2tBydJj zk-5cS8lQeBTE!sl1tDswT{}y)zjuumx1m_UaIbOW$FKCZygA7{@Pl+{j}O{bwg_U- zd#$R_Hj3bJ+S>vs6e;q8w?Lyn6}2;pH4PJl@=o`jzJR z!bKaGx^ewg$YwO2d=OyFU7`yl0Q$%bq75{5=uPw8)dEgDAHKcndr!a-e_x`5QY){2 z?^@7gx>b}~B&Y1M-lsn6SZ1_q_OV{h?tzb>qHtu+=Ns==WgPx0I|lL8s>%OdBJBR{ z?}slU!V^HWy#2L+IXWkJJ5c~n`F;FG)Cw}?;K6h8HIMNC*8V!C#P309Ho%uLFi{4$ zUNIqA2^kXYd~f8?TiH3G1&$IalU6238ZW#r+@B5~kl%<3K>*zVg}I<2#~?ypLcrI~ zw)9O`!%w8O%RPXYJ_FJT0f{uo{GLF- z;{XTV(w_{`rNZ*K$7B4B*AoAv5Xd974?W!|e)_B$sges|gHaIUsHx$WpRd;a_H6g+_^zHq^;eTc)6M$r`Sr;iBnSk$yMqGBNJ2ql zfnY)KK$#o_+Y~h^0RsZn;DSK-z$Xr-%=Q*mCf0^}dN$U~4{y(3Fgci+=Bvzvq;sOX zY8u@^9KM3UB%_jGjT_8#&QLX~nC@efdgDc~48PHLeG_d4U){U;bj#6*dvGbk1+4h$ z?0Q>0T%FlSRqwjIc&fXi;3V=u!;YJA$NhHR&EGUHcV(1m@E4uNB>!mdZSD0<)h`C- zaw02rd!_8 zW$;zy^6}n3SB)riJOXEAtA$4zkxZbw+x8DC_9;;bZv<4kIK6Tgcd&#F=wck&N{;wZ z8K8T1^Kn`4I<~ETA(oWpS=F_`Mj#`dW5@X^{00#=ZQ}8duiVY$3Hz+Eo?&zJqc^R$ zo%(2urHMbmh$j}&jY?~?Cn z3;Y8D@T7Pf#E_k1y*dq)tAI3Yk{OYyAz6q7?$@~O>X4Y@h$c0e{V=pKE}S{;0E|()4J`sXSDM3{u z6l_GD#uM~Jo&FvxBXFLTGq)kM;^Bi!EchaWQui*H8!_Y)%Dx8lfpEsEgtm}sh0yg2 zlF1X;a(GW%5%?%ubsu{#s9Gg{AvEUnR)IA8vV#M9xqh1f7Qz68&cqAW<4SfCW`S7e z0PWFYB(+g^{j*I)ETT(#SY+xA32mo5KRAvCh-X5yp%8hr_Gsr@XCu*>WTP>dML#42 zpK3H#K+PRVXUi+NV`2JMUn4gWzqLtn4yb9g8BXMHuGT0me1DM0)*%i1UlgHkdAm=}Buo9qenN6ciZQa61%C*Iyanw7XU(dJ97BgqtYkMuhHxY#eLb4{SXwgB!{?kAnD+JsF{ZSC^%$NFXz10 z63K16OJTFNdv6ijx^q7GK#>kg>fpyu)bg2*l8#_%#hPFtu%!4Q+YQhl3}3#o?2JNH zPAJ#YK1GGygFe@0LnQ2k%`D>hmafi7nVxibMl2aYMzi)|bkgGzMYQI1L(AJ@!n*p2 zO|iNnI!K*Nlob2ReU`jS!G#x-uSqMsqpE2H6Jxk#) zWB96#nMm0RNYPb&qb?66CYMifTPvr$i3`AcB_!4VrzJ3vQixKmAM?sYfJRRUH zKU}SVn|I`1Js6d~{3LYZBjvOkcPq9dqB6rC{Fx`;y6u%9c<(*aTnvzVA4$L!yEb>) zK#eK#|D1r??h|lijD~d@3zqM`z5X54mn%rYLz8ytsOi0q!JVC*E?b|Jx1PmR##j62 zR1kTu;p&aZ>R&lpTSX)ck}e$ga}Nh(=fk5{YUqwo=vbz%2H!+Dmor~EE~P^*w$qd}rpYdD^30?O=tkSE-})K}Rl2k-*x zuX)|gH%uyo_~{w45T*=tI!c?280{bksw?^J;3kh{j}K{h8o%4rVTLgb=RrOX@~TWryt~AMCmDp!9@mRI;D==Nk^e^qD}>6Vdo7 z3#Sy2kG^x~!}pGZF#Diu=!{8vMak8d6saxcS($|ld)9vbIlYJY*z-_9CdI6N@v0%n z7_t0CM-vZy7)vig`HQw=Q(hbA_Vy8m0#-&UFUB=&9<|~q?PreSt1TV|%?(L(VH9## zR2>jrpFUA7hE0C{#AA;dRv=rT5{DR6Vo#@LgwcNN12M8FhxHyCg;``sS>!g;(9Fpg z->GJ8Ix&F-wS5bVCD!%ML;ShvaM@Ss25lbw;5U0>_-j#nc;8Uyd0Oqdtm{6^>DMRN zf+yja8+Ms9IR%OVOTwI4nxvM)TdjkC1RP9LIi|lG{v?c7*d$EHK~yO(9>`4;ml2Oj zZhgfQsne#-5Gwp^>!V?WIk%5|*6%hPvN;vvr!7^ycJrfC==}$7NtRoy2!DNsE}S^c?vm5DLGqsNl>HhRTwSpujoC=?HeaK`y zQ25jatza}TgPQAvIN@*7W|YA4G!9qQIqCMD$~D|$aT#inLqr3_B|GB(9G9&3ahaer zW1i0P`@-l~!z|=#T3D{Q#LVX?rMw1S9<3(|&H1}jy9@i10umqP!d+YRIbX3^^L}7! za%Zqw5x^TV#HZ*g4;So>eX3f6GE$U0G6#(hUSw_IdM55Sk05p)Sfsfo*8Bcf2)Z^% zxJS4gGc8UPC)7Tpc{T%^Zb?!?)f1+^w4j4Q^kW(hcFoUeJ1uNZ2H63Y55k;=ar)0y zM;$c7oF{o+ra1-U2QRCiNIjRGY+-aQHY3Q4852gExTsi>8V7OD#C}l@6U;cP@6+b$ic6_2K|%|k!^$c(DwZKO$ncs`QiZq zD&8Frs-Ma?&nW!qVfLs__3%eSg5f0c%qiKDvNK;WgJI$leY|(-T3wl9p}mU}-)0w%O6p8` z>5@u(1-5%9lJ*ww5t3Z_<_sPFc%JYHtppj>ovwx4i-g+@%V!}*8P0L9yM~cO2IZWo zCGI?>s)l=`);_0tX`Wi;_|=}{gy2L&8wAU29kj_jKfPR(NQQTP^A-Ar>B3LG@0;iE z`t0ZcF(YPsVw<_T>qER94X>;Dxp_g%&6Mr=CHlrx18g-8vzbuIfl^~eU|pCoG>-ba z!|FRBSAp($jYQVdoA;z+*z*wmqJxiu}Eq?>frfaLi$A|^98#D zd(lOf5~+=$NV$>5H}A6V8antNz3n)@zP_CRqH6)|e~zx_4`)5)z6ju~H}`Jr8mgo5 zlgIv(IyJLe=jV#@^2aJ-K@u;}eP8e1UezGb#zDhzz%KXHygavjqaR9Yq(dy;q7w(h zu~kzkQtD^EY>GSCOgh`)uWUJ7&rsXW#T4e3b|J2hWCe-ehjn zz%#0jd@<{Y7JhZLjMz4l5^I(B==I@&-`fwt_8S?TgF6x0YUN8QGiF5L*ukiDJr3e> zVbInG$-65FiBsQmP&5Jp&xLQ%N7&&4Y!lkAvCbqLd788qrr>8}k(v7;nd>3QRm#XLW0x5kE_vhbX%B+o#y-C1h0 z?qbCZbCOAhB_iz2&TK0SQBMSwxK>jLnVvf}9WP|6wRXMRtFq6m!V5?y!j%_c2c#z_ z63cT*!d%E&T{5OY5L>o@& zGxxs_GTWT$vvC-e zvceylIo@#v-k|a-rsg=?ieg(C_es*YJ|!2F!pj@;DJE!@viF#Mz^_#TGL|leW*QzZ zwkb2e0mV~s+-=Bw)uM`&**a9?K^{m|vnEIX@tt=H;+P3lIXtMeYVQ2!IaqBoS?Ab^ zXehuZHY5Eo^qG>D0vH3s9>z?dAL6G}YEqs>y-5(ZU7pgdpWpVb=k*#0%vq*VzJZ#YgMr=_c@I;%S(v1c%>kLtqL`DBE%D zS2vfe91;~yUDn|j&uFP)vIWXKXHH9}yqArQN}ppAIFPq-<|{XpjU?8iWMp_wdKB4m z84nD8D4kt}5sz?Y>QM^U8?VPI$8>IwOPjCUm8PNdNVU(!=LP`+{eT96Xnv38qm_}ljh>afo{f!>xq&tFALZvvI!5N@ z@^#XXvgmy05Oq^NekEzo)$tg}kq%YysR#($1%w63dpP3pX3@QOZ@t`gmeFL?RMgbu zRaL$(0smi+*Ji}ez}jAauYWLsr>yD|&K`OS6se=n2Ek3Vo#do21{0H|@T-Xp#|V`2 z5jI&ec$AxfRJrsw@bJh9!)M}Zh7t(k79vXcbwu?#@VzufyJ4-Dyjw9*u=`^SVxO}+ zpo-9KAS)YmT8^{4)_0vUl?uk0!qj>vO0h1ZYrU|#()%F;iwRGB5jmglyf05~qqO}- z7k@+tS8pZ*5ur}yD(5H&wQ$)zV8BO1M;CYXHuRFW?wRc+T)FHX?C!SDC|6dpP~^85<~SC(MeD;{6jn|Xk%&;iolUTU-HS~ToI~<`x@62Lhi2!jCKTTN<8J7z z)32x*@N4?9s=-(IUnEB7Vg)?*dy-2`i#gk#7Kk7dk(GbhV!K-qG7@a+y)bxAT9z2Z zUK7*NuOIf-R4CNx1~AlrnlPrA;D8I56$_*IZ%xR0Z^9kb7ONQ!bdBtw%_t=-L6_1T-&KQ7pLm|G_?XL>f_U9y21BJI~MllRS>lD+nM*F=pDR*fthOr zwdKRe%O`rOq3vM0Z+^?I`D>?sO~ayt^0#cqKV76nP^Ug(L8em6Dj;*2hY2SCFd7K{@kNKKQ1BP$$;`p=;cdU~h;v$F;VjYsSGPdYYNmm%$E3Jiyt2 zdEw%PH2&eEy9rX!c}DNoEw+N5w*)oghgGwMdq;sU6@ziB3+<>?@!Hu+wtSKK1Tqr7 z_%FZ3V-HOVYhNbPGvw5x5bHt`Kek>x>DJ0nZAL?@0~-l%ME+vyp(n4(Wa^@_kh-9oR#Av5|E4>==lG)Z;d` zgCLT5^yzArsiru)I7yw|H3<7xY4b);f@ku{mnBYVui-7U%W=hKySLZ3905t~H%!cU zLg8)syt7=K(@cAbgNZNY2$h}(2X1oftR^_Xpoz;-;Z2*XRKDV!^bATQc(;#jW2Jyu z*NI#&8{PgM=NF4Efu~i=%-nRZWXL&Y7(7KP$}_|h)G2>t1RT8<>1W*I*-v>eOK1id ze{zjJ$M#by0bhX;aw{ORKP8Cz4pfX5;$WI^Aa<&scWDfviLC|-vc6?yE{lB;qZWZo zZ50FonWdybRhLd>e)trQLD2+7qw`1^HJdu5-IP_>q5=Vnj~%yPiDc#@j>kd>J?@;< z6+{GY)hlB$qwLK5r)t|@`@>YuP2@7o%Z4n6R3H~u_p2H(52?f0^|tU{dcE(kvo$jK z6ss1d0h127RP}^dMp%}^uGO+Lw?M&~MGwaMK!>9RBt*L*h}};QgSs&rx3@edT$e}^ zWh&7gDN`_jY{Zv1_Iyt-mS%f%#O*oe*{ze5HW4?mAsnCZ*0^NDb!-3v@O77z|e7Ul-(=WbN=^v8#Vd$E=J87m1C59yC&hCAqJ{pN2B-910 zj>{`HL!)VmVc>a?Og7vvR_TuP?y7%`WWenh-}IS9$jij38U(GOGeeBuPX`|ONwptY z=F9V22)|Z!T=4(rA3n&QR!z28Y;1ViSDEi$UtiC9$ zsIM~k7ZII6Tq3!bf4C>Y8&=QA5oi`jDVTUvDgjd)EyKkp>{l5gg5mLP>S41=`mnwM zT$x`iaOa*c8rHd=Tn=LDl~pG2YLui>Pq0%6FOE;?#q^yroK?mTRIcUAUypp`=Q#06 z378B*Szym*9;J7{G)T0}H4pyW9=%0+Tld5ThsZ*1RBt4K*p#d-!BFSIQewmyMZDzY zn)N=zxlv&>j~pY3TDo2df43i*nT=si%2X;@zYy1^=mePGcv7W#O9LX?nG(ahzD

bs|f>XuMk7(2AOXl87Oma{Mjd zuLzT~F+ayv!V_~wFjjWka+0!rl~v8IXiwmA=qJnB(*Bu9pwv32=P zA%YHYCYq*=3mZ?)m!$RL)vj8PZPd{rJR)fom%&fF?X8J=rHF9nup~L_^I&5#YuAZ_ zsBa@9Jc{E9S1do*j}XlH?eqp39p8!??;4kFHK2zv?J=hy+9GvK9{dIAW(Z zH>q9A=Xp(|CgWy0jP^~BTv|29z#rAaOm~zV3#FQEtvOz=DR43<&wG0Kw3sjNuF6H#N%^?&dPrVD|J6o( z`E`wonsDqV7fZ4pf_8dUgST3=o4 z@Bd1!XOPRf!oTXEv;P@&JBUjnrIk+3LIC;jVuJ!)4n1~31bYLILj(EDaihHU;z`eUI?}>LWp6#C)0s%Qd;&{on`{RbxV`J42@# zT234O`;m&{Ac~6ZPB#bs=ERV=1iXnvMZ=u)(COh}Nm0)(IR-71S#<0$bdyZKUAc!ZVSK5>QKnZi1m zn8q5pRVp3N4Oo;+lRe5Wde1Fbh#0%!)1=ifov=Ufm)%Jc&?#-Op=l>^w?N=$eOnAt zv+va!{Hi3{fg^>A4Ba9X#%XJ!KN5 zDL2@D`e0;tyGjk`4cr$p-S`gpV+j)5y4Yrla-9?}l;8+6llxJd3A{9f6&c&~E!fs3 z1oyLcK8|z@2AB$B`V9y4KD!-H?%qdzAq&*O)tTs z1-03ZCmdH`BXfl-&zEh#7)>)7!}IL?^tGl_v8m|2?ZTPyw#b-90*T+qAl2H&l%0+K zV$RRmKO2>^HX_Z-J~5`~CAZ$+D~jQe6PM5|=L*=*cY<3(`urvpSPm5q1m^JRo_T9dS1}~1H5nMldi{UUs zt)&UnL<3QU@$V7!!NN-K|A*Ay3B)BrQ?iW(t78GCNw~*3{^^GgNM>;K&Q>hNX%{$O z>Iw?QC7;Zl?Ml^Ej`Lr{CRn>CSl9F%W%MpW1wErrqUHico$`3k<<=KxOtdN50&?P#;gd1g^tum3TUErk8f_dUWUG zK!@i(Xp}Qa8zw|@kJH>kn-5*~bEJ;I_F5Dgv+-sbETh9x6FYpj>xA6W2nfW z7Q8gL&wEE#&zLk*LtdgG^w8;9dY{yj9!upR$=H6oqhaD@q8d$*p0pY4HhsMVp-Omp zMXi?%F#Ml4zC(**<*k5MGGhO?mtO1-H@*r360Os@-qS8rmNG|nJu?Z`XeKBli{u}wy&1}%zS?ES1; z7~A%LE$180FA%PU{&wc$14PG=gP~~S%k_8{+@7lLNkjy9slGkI4$YwEI_4UOFeW``+$=iiuMw=B{6gKRd8`;>)5kdGqWXMtPFQVEB=f|}EOWf}l z&1@hYw4;&j0||r;GSXnDdsxJGb?AER-oCNY+ zt!_&DzkNg3}#!$~pkNM&CVYTB=H8KLmE{}mRPywC(Q;l(8X7Ld<9!2??k&)36 z3j*~@!U7il_s1Q>1B$hwww0c)ybUl*X<+@>KxS@&F|VJ3K&vbef9P@6{-_=gI~M*N zjUM+4tQH#(C|LpO4;0#+M^PTuSN}xeF=Lf%0R|xi_z2~{4+cc44ep`BERnW03Yg_i2R07^NdNXAFnWNowsADod(@*W z>iIAP0S)&4T3-KKcG~Q54IYiK@zdt>Y2cp3jpWY&k+XahhU>9$#AV|7(*kKif%#7q z9s5U7I3Gh{`TkTU8;EuSAh!P*tj+F^qP%aA1H~wkD@$k8S)v7 zWg&nUcfd0L)CFVfQIv;0o_~f~b{fYJ5d#E>KOFH7H}T(p6y-U~V?+9LkLlmGo+W_# zBVzw;$LXKi{JB%=Zx{`-$6+4LLVs@T_#5Vw@^P3))6kzQ*nh*w1KUO(OU;kw=0BId z{)W+Jc!2rGLfD^_{JGThw=^^3gY+K@O^+@-{R#T#;>X{hN6-En(1)dvKSBST)B79r zBinxi`Y^-yC+I(CCH{s4fuLSOf&QGM_*43ycVPc6t;qdv(*O5<>`(DOFO~lW*yjCj cM)YvuEF%d6WDF390(ja3mnBE9fSd^WKR?!%3;+NC From df311829b4f1f8c382942e890acf1db68097f802 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Tue, 17 Dec 2019 10:50:17 -0700 Subject: [PATCH 30/72] update prefix of AeroDyn channels in nodal output Otherwise, they may overlap with structural nodes --- modules/aerodyn/src/AeroDyn_AllBldNdOuts_IO.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/modules/aerodyn/src/AeroDyn_AllBldNdOuts_IO.f90 b/modules/aerodyn/src/AeroDyn_AllBldNdOuts_IO.f90 index c374f9fbf3..19cf733d81 100644 --- a/modules/aerodyn/src/AeroDyn_AllBldNdOuts_IO.f90 +++ b/modules/aerodyn/src/AeroDyn_AllBldNdOuts_IO.f90 @@ -102,7 +102,7 @@ SUBROUTINE AllBldNdOuts_InitOut( InitOut, p, InputFileData, ErrStat, ErrMsg ) INTEGER(IntKi) :: IdxBlade ! Counter to which blade we are on INTEGER(IntKi) :: IdxNode ! Counter to the blade node we ae on INTEGER(IntKi) :: IdxChan ! Counter to the channel we are outputting. - CHARACTER(16) :: ChanPrefix ! Name prefix (B#N###) + CHARACTER(16) :: ChanPrefix ! Name prefix (AB#N###) CHARACTER(6) :: TmpChar ! Temporary char array to hold the node digits (3 places only!!!!) CHARACTER(*), PARAMETER :: RoutineName = ('AllBldNdOuts_InitOut') @@ -128,7 +128,7 @@ SUBROUTINE AllBldNdOuts_InitOut( InitOut, p, InputFileData, ErrStat, ErrMsg ) ! Create the name prefix: WRITE (TmpChar,'(I3.3)') IdxNode ! 3 digit number - ChanPrefix = 'B' // TRIM(Num2LStr(IdxBlade)) // 'N' // TRIM(TmpChar) ! // '_' + ChanPrefix = 'AB' // TRIM(Num2LStr(IdxBlade)) // 'N' // TRIM(TmpChar) ! // '_' ! note that I added an "AB" to indicate "Aero B1" in case of confusion with structural nodal outputs with the same name ! Now write to the header InitOut%WriteOutputHdr(INDX) = trim(ChanPrefix) // p%BldNd_OutParam(IdxChan)%Name InitOut%WriteOutputUnt(INDX) = p%BldNd_OutParam(IdxChan)%Units From 45f9d0fd71f34c449b4d2ce1a8456859f11e4f57 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Tue, 17 Dec 2019 11:47:46 -0700 Subject: [PATCH 31/72] Fix plot labels Baseline and local were switched also fix syntax of legend label --- reg_tests/lib/errorPlotting.py | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/reg_tests/lib/errorPlotting.py b/reg_tests/lib/errorPlotting.py index 45e375efff..94315bf71a 100644 --- a/reg_tests/lib/errorPlotting.py +++ b/reg_tests/lib/errorPlotting.py @@ -56,8 +56,8 @@ def _plotError(xseries, y1series, y2series, xlabel, title1, title2): p1.title.align = 'center' p1.grid.grid_line_alpha=0.3 p1.xaxis.axis_label = 'Time (s)' - p1.line(xseries, y1series, color='green', line_width=3, legend='Baseline') - p1.line(xseries, y2series, color='red', line_width=1, legend_label='Local') + p1.line(xseries, y2series, color='green', line_width=3, legend_label='Baseline') + p1.line(xseries, y1series, color='red', line_width=1, legend_label='Local') p1.add_tools(HoverTool(tooltips=[('Time','$x'), ('Value', '$y')],mode='vline')) p2 = figure(title=title2, x_range=p1.x_range) From e15e964be9b3a735ee84837cbe4e59571ba217e2 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Wed, 18 Dec 2019 11:27:43 -0700 Subject: [PATCH 32/72] update comments --- modules/openfast-library/src/FAST_Solver.f90 | 2 +- modules/openfast-library/src/FAST_Subs.f90 | 31 ++++++++++++-------- modules/servodyn/src/BladedInterface.f90 | 24 ++++++++------- 3 files changed, 33 insertions(+), 24 deletions(-) diff --git a/modules/openfast-library/src/FAST_Solver.f90 b/modules/openfast-library/src/FAST_Solver.f90 index d01651baed..330225a6f6 100644 --- a/modules/openfast-library/src/FAST_Solver.f90 +++ b/modules/openfast-library/src/FAST_Solver.f90 @@ -3594,7 +3594,7 @@ SUBROUTINE Perturb_u_FullOpt1( p_FAST, Jac_u_indx, n, u_perturb, u_ED_perturb, u INTEGER( IntKi ) , INTENT(IN ) :: Jac_u_indx(:,:) !< Index to map Jacobian u-vector into mesh fields INTEGER( IntKi ) , INTENT(IN ) :: n !< number of array element to use REAL( ReKi ) , INTENT(INOUT) :: u_perturb(:) !< array to be perturbed - TYPE(ED_InputType), OPTIONAL , INTENT(INOUT) :: u_ED_perturb !< ED System inputs (needed only when 1 <= n <= NumEDNodes=max(NumEDNodes,NumMBDNodes)) + TYPE(ED_InputType), OPTIONAL , INTENT(INOUT) :: u_ED_perturb !< ED System inputs (needed only when 1 <= n <= NumEDNodes=NumEDNodes) TYPE(SD_InputType), OPTIONAL , INTENT(INOUT) :: u_SD_perturb !< SD System inputs (needed only when NumEDNodes +1 <= n <= NumEDNodes+NumSDNodes) [if SD is used] TYPE(HydroDyn_InputType), OPTIONAL , INTENT(INOUT) :: u_HD_perturb !< HD System inputs (needed only when NumEDNodes+NumSDNodes +1 <= n <= NumEDNodes+NumSDNodes+NumHDNodes) [if HD is used and SD is used. if SD not used, TYPE(BD_InputType), OPTIONAL , INTENT(INOUT) :: u_BD_perturb !< BD System inputs (needed only when NumEDNodes+NumSDNodes+NumHDNodes+1 <= n <= inf) [if BD is used] diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 9a5009855b..28ca73ad56 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -2790,19 +2790,19 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, m_FAST, OverrideAbortErrLev, ErrS !! !! Combinations of output files are possible by adding the values corresponding to each file. The possible combination of options are therefore !! - !! | `OutFileFmt` | Description | - !! |:------------:|:-------------------------| - !! | 1 | Text file only `.out` | - !! | 2 | Binary file only `.outb` | - !! | 3 | Text and binary files | - !! | 4 | uncompressed binary file `.outbu` | - !! | 5 | Text and uncompressed binary files | - !! | 6 | Binary and uncompressed binary files | - !! | 7 | Text, Binary, and uncompressed binary files | + !! | `OutFileFmt` | Description | + !! |:------------:|:---------------------------------------------------------------------| + !! | 1 | Text file only `.out` | + !! | 2 | Binary file only `.outb` | + !! | 3 | Text and binary files | + !! | 4 | uncompressed binary file `.outbu` | + !! | 5 | Text and uncompressed binary files | + !! | 6 => 4 | Binary (not written) and uncompressed binary files; same as 4 | + !! | 7 => 5 | Text, Binary (not written), and uncompressed binary files; same as 5 | !! ! OutFileFmt - Format for tabular (time-marching) output file(s) (1: text file [.out], 2: binary file [.outb], 3: both) (-): - CALL ReadVar( UnIn, InputFile, OutFileFmt, "OutFileFmt", "Format for tabular (time-marching) output file(s) {0: uncompressed binary and text file, 1: text file [.out], 2: compressed binary file [.outb], 3: both text and compressed binary, 4: uncompressed binary .outbu]; add for combinations) (-)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InputFile, OutFileFmt, "OutFileFmt", "Format for tabular (time-marching) output file(s) {0: uncompressed binary and text file, 1: text file [.out], 2: compressed binary file [.outb], 3: both text and compressed binary, 4: uncompressed binary .outb]; add for combinations) (-)", ErrStat2, ErrMsg2, UnEc) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if ( ErrStat >= AbortErrLev ) then call cleanup() @@ -2820,10 +2820,15 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, m_FAST, OverrideAbortErrLev, ErrS OutFileFmt = OutFileFmt / 2 ! integer division if (mod(OutFileFmt,2) == 1) then ! This is a feature for the regression testing system. It writes binary output stored as uncompressed double floating point data instead of compressed int16 data. - p%WrBinOutFile = .true. - p%WrBinMod = FileFmtID_NoCompressWithoutTime ! A format specifier for the binary output file format (3=don't include time channel and do not pack data) + ! If the compressed binary version was requested, that will not be generated + if (p%WrBinOutFile) then + call SetErrStat(ErrID_Warn,'Binary compressed file will not be generated because the uncompressed version was also requested.', ErrStat, ErrMsg, RoutineName) + else + p%WrBinOutFile = .true. + end if + p%WrBinMod = FileFmtID_NoCompressWithoutTime ! A format specifier for the binary output file format (3=don't include time channel and do not pack data) else - p%WrBinMod = FileFmtID_ChanLen_In ! A format specifier for the binary output file format (1=include time channel as packed 32-bit binary; 2=don't include time channel;3=don't include time channel and do not pack data) + p%WrBinMod = FileFmtID_ChanLen_In ! A format specifier for the binary output file format (4=don't include time channel; do include channel width; do pack data) end if OutFileFmt = OutFileFmt / 2 ! integer division diff --git a/modules/servodyn/src/BladedInterface.f90 b/modules/servodyn/src/BladedInterface.f90 index ab7f173d59..f12cf15edd 100644 --- a/modules/servodyn/src/BladedInterface.f90 +++ b/modules/servodyn/src/BladedInterface.f90 @@ -421,20 +421,24 @@ SUBROUTINE BladedInterface_Init(u, p, m, y, InputFileData, InitInp, ErrStat, Err !-------------------------------------- p%NumOuts_DLL = 0 -!!! CALL GetBladedLoggingChannels(u,p,m, ErrStat2, ErrMsg2) ! this calls the DLL, but we don't have the correct inputs for a time step, so we'll close the DLL and start it again -!!! CALL CheckError(ErrStat2,ErrMsg2) -!!! IF ( ErrStat >= AbortErrLev ) RETURN -!!! -!!! ! close and reload library here... -!!! -!!! CALL BladedInterface_End(u, p, m, ErrStat2, ErrMsg2) -!!! CALL CheckError(ErrStat2,ErrMsg2) -!!! IF ( ErrStat >= AbortErrLev ) RETURN +#ifdef LOAD_DLL_TWICE_FOR_LOGGING_CHANNELS + CALL GetBladedLoggingChannels(u,p,m, ErrStat2, ErrMsg2) ! this calls the DLL, but we don't have the correct inputs for a time step, so we'll close the DLL and start it again + CALL CheckError(ErrStat2,ErrMsg2) + IF ( ErrStat >= AbortErrLev ) RETURN + + ! close and reload library here... + ! (if the DLL could be guaranteed to not do anything with the + ! inputs on the initial step, we could avoid this this part) + + CALL BladedInterface_End(u, p, m, ErrStat2, ErrMsg2) + CALL CheckError(ErrStat2,ErrMsg2) + IF ( ErrStat >= AbortErrLev ) RETURN CALL LoadDynamicLib ( p%DLL_Trgt, ErrStat2, ErrMsg2 ) CALL CheckError(ErrStat2,ErrMsg2) IF ( ErrStat >= AbortErrLev ) RETURN - +#endif + !-------------------------------------- #endif From 2b1f7fd7717f7f7b80c9e0af55049afff66d98f9 Mon Sep 17 00:00:00 2001 From: Emmanuel Branlard Date: Wed, 15 Jan 2020 12:48:12 -0700 Subject: [PATCH 33/72] Update of VS solution --- vs-build/FASTlib/FASTlib.vfproj | 1 + 1 file changed, 1 insertion(+) diff --git a/vs-build/FASTlib/FASTlib.vfproj b/vs-build/FASTlib/FASTlib.vfproj index 32a1d83009..81027f59fa 100644 --- a/vs-build/FASTlib/FASTlib.vfproj +++ b/vs-build/FASTlib/FASTlib.vfproj @@ -466,6 +466,7 @@ + From 3b50028b9cd71228f0b3d9f493e91e369ca430e8 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Thu, 16 Jan 2020 10:01:40 -0700 Subject: [PATCH 34/72] docs: updated api_change.rst --- docs/source/user/api_change.rst | 33 ++++++++++++++++++++++++++++++++- 1 file changed, 32 insertions(+), 1 deletion(-) diff --git a/docs/source/user/api_change.rst b/docs/source/user/api_change.rst index 5b7e747929..ed98d9cffe 100644 --- a/docs/source/user/api_change.rst +++ b/docs/source/user/api_change.rst @@ -10,11 +10,42 @@ The changes are tabulated according to the module input file, line number, and f The line number corresponds to the resulting line number after all changes are implemented. Thus, be sure to implement each in order so that subsequent line numbers are correct. -OpenFAST v2.0.0 to OpenFAST v2.1.0 +OpenFAST v2.2.0 to OpenFAST vTBD +---------------------------------- + +============== ==== ================== ============================================================================================================================================================================= + Added in OpenFAST vTBD +-------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- + Module Line Flag Name Example Value +============== ==== ================== ============================================================================================================================================================================= +AeroDyn 37 AFTabMod 1 AFTabMod - Interpolation method for multiple airfoil tables {1=1D interp on AoA (first table only); 2=2D interp on AoA and Re; 3=2D interp on AoA and UserProp} (-) +HydroDyn 53 ExctnMod 0 ExctnMod - Wave Excitation model {0: None, 1: DFT, 2: state-space} (-) +OpenFAST 44 CalcSteady true CalcSteady - Calculate a steady-state periodic operating point before linearization? [unused if Linearize=False] (flag) +OpenFAST 45 TrimCase 3 TrimCase - Controller parameter to be trimmed {1:yaw; 2:torque; 3:pitch} [used only if CalcSteady=True] (-) +OpenFAST 46 TrimTol 0.0001 TrimTol - Tolerance for the rotational speed convergence [used only if CalcSteady=True] (-) +OpenFAST 47 TrimGain 0.001 TrimGain - Proportional gain for the rotational speed error (>0) [used only if CalcSteady=True] (rad/(rad/s) for yaw or pitch; Nm/(rad/s) for torque) +OpenFAST 48 Twr_Kdmp 0 Twr_Kdmp - Damping factor for the tower [used only if CalcSteady=True] (N/(m/s)) +OpenFAST 49 Bld_Kdmp 0 Bld_Kdmp - Damping factor for the blades [used only if CalcSteady=True] (N/(m/s)) +============== ==== ================== ============================================================================================================================================================================= + + +OpenFAST v2.1.0 to OpenFAST v2.2.0 ---------------------------------- No changes required. + +OpenFAST v2.0.0 to OpenFAST v2.1.0 +---------------------------------- + +============== ==== ================== ===================================================================================================================================================================== + Added in OpenFAST v2.1.0 +------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------ + Module Line Flag Name Example Value +============== ==== ================== ===================================================================================================================================================================== +BeamDyn driver 21 GlbRotBladeT0 True GlbRotBladeT0 - Reference orientation for BeamDyn calculations is aligned with initial blade root? +============== ==== ================== ===================================================================================================================================================================== + OpenFAST v1.0.0 to OpenFAST v2.0.0 ---------------------------------- From 7e7393b75e5324b4060991e6341b1c393566b17e Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Thu, 16 Jan 2020 10:31:39 -0700 Subject: [PATCH 35/72] Error handling: write info message https://github.com/OpenFAST/openfast/issues/382 --- modules/openfast-library/src/FAST_Subs.f90 | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 28ca73ad56..284ddcc303 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -1218,7 +1218,12 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, IF (ErrStat >= AbortErrLev) THEN CALL Cleanup() RETURN - END IF + 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: From 57efb707eeb526fd2fd45831ee592658205b09dc Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Thu, 23 Jan 2020 09:24:00 -0700 Subject: [PATCH 36/72] Linear: update code for testing OLD_AD_LINEAR --- modules/openfast-library/src/FAST_Lin.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/modules/openfast-library/src/FAST_Lin.f90 b/modules/openfast-library/src/FAST_Lin.f90 index ffc24228ca..72b02d4f45 100644 --- a/modules/openfast-library/src/FAST_Lin.f90 +++ b/modules/openfast-library/src/FAST_Lin.f90 @@ -829,7 +829,7 @@ SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, if ( p_FAST%CompAero == Module_AD ) then ! get the jacobians #ifdef OLD_AD_LINEAR - call AD_JacobianPInput( t_global, AD%Input(1), AD%p, AD%x(STATE_CURR), AD%xd(STATE_CURR), AD%z(STATE_CURR), & + call AD_JacobianPInput_orig( 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, dZdu=dZdu ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) From e1cd5f8707895f1e2625ba6f215a63e0099fa986 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Thu, 23 Jan 2020 13:54:08 -0700 Subject: [PATCH 37/72] docs: fixed some spelling errors Sorry, Jeff Minnema. I think your name has been spelled wrong in there for quite a while! --- README.rst | 4 +-- .../aerodyn/examples/ad_primary_example.inp | 2 +- docs/source/user/api_change.rst | 26 +++++++++---------- .../beamdyn/examples/bd_primary_nrel_5mw.inp | 4 +-- modules/aerodyn/src/AeroDyn_IO.f90 | 6 ++--- modules/aerodyn/src/AeroDyn_Registry.txt | 2 +- modules/aerodyn/src/AeroDyn_Types.f90 | 2 +- modules/aerodyn/src/UnsteadyAero.f90 | 14 +++++----- 8 files changed, 30 insertions(+), 30 deletions(-) diff --git a/README.rst b/README.rst index 3900f682d2..bfd37dbcf8 100644 --- a/README.rst +++ b/README.rst @@ -29,7 +29,7 @@ FAST v8 - OpenFAST v0.1.0 The transition from FAST v8 to OpenFAST v0.1.0 represents the effort to better support an open-source developer community around FAST-based aero-hydro-servo- elastic engineering models of wind-turbines and wind-plants. OpenFAST is the -next generation of FAST analysis tools. More inforation is available in the +next generation of FAST analysis tools. More information is available in the `transition notes `_. FAST v8 is a computer-aided engineering tool for simulating the coupled dynamic @@ -122,7 +122,7 @@ nightly. The results are publicly available through the Help ---- -Please use `github issues `_ to: +Please use `GitHub Issues `_ to: * ask usage questions * report bugs diff --git a/docs/source/user/aerodyn/examples/ad_primary_example.inp b/docs/source/user/aerodyn/examples/ad_primary_example.inp index 8c0f03cc0c..d3ca180f54 100644 --- a/docs/source/user/aerodyn/examples/ad_primary_example.inp +++ b/docs/source/user/aerodyn/examples/ad_primary_example.inp @@ -31,7 +31,7 @@ True TIDrag - Include the drag term in the tangential-induc 2 DBEMT_Mod - Type of dynamic BEMT (DBEMT) model {1=constant tau1, 2=time-dependent tau1} (-) [used only when WakeMod=2] 4 tau1_const - Time constant for DBEMT (s) [used only when WakeMod=2 and DBEMT_Mod=1] ====== Beddoes-Leishman Unsteady Airfoil Aerodynamics Options ===================================== [used only when AFAeroMod=2] - 1 UAMod - Unsteady Aero Model Switch (switch) {1=Baseline model (Original), 2=Gonzalez's variant (changes in Cn,Cc,Cm), 3=Minemma/Pierce variant (changes in Cc and Cm)} [used only when AFAeroMod=2] + 1 UAMod - Unsteady Aero Model Switch (switch) {1=Baseline model (Original), 2=Gonzalez's variant (changes in Cn,Cc,Cm), 3=Minnema/Pierce variant (changes in Cc and Cm)} [used only when AFAeroMod=2] FALSE FLookup - Flag to indicate whether a lookup for f' will be calculated (TRUE) or whether best-fit exponential equations will be used (FALSE); if FALSE S1-S4 must be provided in airfoil input files (flag) [used only when AFAeroMod=2] ====== Airfoil Information ========================================================================= 1 AFTabMod - Interpolation method for multiple airfoil tables {1=1D interpolation on AoA (first table only); 2=2D interpolation on AoA and Re; 3=2D interpolation on AoA and UserProp} (-) diff --git a/docs/source/user/api_change.rst b/docs/source/user/api_change.rst index ed98d9cffe..6802f3f8b1 100644 --- a/docs/source/user/api_change.rst +++ b/docs/source/user/api_change.rst @@ -63,17 +63,17 @@ BeamDyn 5 analysis_type analysis_type - 1: Static analysis; 2: Dynamic a ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- Module Line Flag Name Example Value ========= ==== ================== ===================================================================================================================================================================== -AeroDyn 22 SkewModFactor "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] +AeroDyn 22 SkewModFactor "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] AeroDyn 30 Section header ====== Dynamic Blade-Element/Momentum Theory Options ============================================== [used only when WakeMod=2] -AeroDyn 31 DBEMT_Mod 2 DBEMT_Mod - Type of dynamic BEMT (DBEMT) model {1=constant tau1, 2=time-dependent tau1} (-) [used only when WakeMod=2] -AeroDyn 32 tau1_const 4 tau1_const - Time constant for DBEMT (s) [used only when WakeMod=2 and DBEMT_Mod=1] -BeamDyn 5 QuasiStaticInit True QuasiStaticInit - Use quasistatic pre-conditioning with centripetal accelerations in initialization (flag) [dynamic solve only] -BeamDyn 11 load_retries DEFAULT load_retries - Number of factored load retries before quitting the aimulation +AeroDyn 31 DBEMT_Mod 2 DBEMT_Mod - Type of dynamic BEMT (DBEMT) model {1=constant tau1, 2=time-dependent tau1} (-) [used only when WakeMod=2] +AeroDyn 32 tau1_const 4 tau1_const - Time constant for DBEMT (s) [used only when WakeMod=2 and DBEMT_Mod=1] +BeamDyn 5 QuasiStaticInit True QuasiStaticInit - Use quasi-static pre-conditioning with centripetal accelerations in initialization (flag) [dynamic solve only] +BeamDyn 11 load_retries DEFAULT load_retries - Number of factored load retries before quitting the simulation BeamDyn 14 tngt_stf_fd DEFAULT tngt_stf_fd - Flag to use finite differenced tangent stiffness matrix (-) BeamDyn 15 tngt_stf_comp DEFAULT tngt_stf_comp - Flag to compare analytical finite differenced tangent stiffness matrix (-) BeamDyn 16 tngt_stf_pert DEFAULT tngt_stf_pert - perturbation size for finite differencing (-) BeamDyn 17 tngt_stf_difftol DEFAULT tngt_stf_difftol - Maximum allowable relative difference between analytical and fd tangent stiffness (-) -BeamDyn 18 RotStates True RotStates - Orient states in the rotating frame during linearization? (flag) [used only when linearizing] +BeamDyn 18 RotStates True RotStates - Orient states in the rotating frame during linearization? (flag) [used only when linearizing] ========= ==== ================== ===================================================================================================================================================================== FAST v8.16 to OpenFAST v1.0.0 @@ -90,14 +90,14 @@ OpenFAST 18 CompSub 0 CompSub - Compute sub-structural dynamics (swi ========== ==== =============== ==================================================================================================== -========= ==== =============== ==================================================================================================== +========= ==== =============== =================================================================================================================== Added in OpenFAST v1.0. ------------------------------------------------------------------------------------------------------------------------------------ +-------------------------------------------------------------------------------------------------------------------------------------------------- Module Line Flag Name Example Value -========= ==== =============== ==================================================================================================== -OpenFAST 18 CompSub 0 CompSub - Compute sub-structural dynamics (switch) {0=None; 1=SubDyn; 2=External Platform MCKF} -AeroDyn 12 CavityCheck False CavitCheck - Perform cavitation check? (flag) +========= ==== =============== =================================================================================================================== +OpenFAST 18 CompSub 0 CompSub - Compute sub-structural dynamics (switch) {0=None; 1=SubDyn; 2=External Platform MCKF} +AeroDyn 12 CavityCheck False CavitCheck - Perform cavitation check? (flag) AeroDyn 17 Patm 9999.9 Patm - Atmospheric pressure (Pa) [used only when CavitCheck=True] -AeroDyn 18 Pvap 9999.9 Pvap - Vapour pressure of fluid (Pa) [used only when CavitCheck=True] +AeroDyn 18 Pvap 9999.9 Pvap - Vapor pressure of fluid (Pa) [used only when CavitCheck=True] AeroDyn 19 FluidDepth 9999.9 FluidDepth - Water depth above mid-hub height (m) [used only when CavitCheck=True] -========= ==== =============== ==================================================================================================== +========= ==== =============== =================================================================================================================== diff --git a/docs/source/user/beamdyn/examples/bd_primary_nrel_5mw.inp b/docs/source/user/beamdyn/examples/bd_primary_nrel_5mw.inp index 704cede55c..340eac2bb6 100644 --- a/docs/source/user/beamdyn/examples/bd_primary_nrel_5mw.inp +++ b/docs/source/user/beamdyn/examples/bd_primary_nrel_5mw.inp @@ -2,13 +2,13 @@ NREL 5MW blade primary input file ---------------------- SIMULATION CONTROL -------------------------------------- TRUE Echo - Echo input data to ".ech"? (flag) -False QuasiStaticInit - Use quasistatic pre-conditioning with centripetal accelerations in initialization? (flag) [dynamic solve only] +False QuasiStaticInit - Use quasi-static pre-conditioning with centripetal accelerations in initialization? (flag) [dynamic solve only] 0 rhoinf - Numerical damping parameter for generalized-alpha integrator 2 quadrature - Quadrature method: 1=Gaussian; 2=Trapezoidal (switch) "DEFAULT" refine - Refinement factor for trapezoidal quadrature (-) [DEFAULT = 1; used only when quadrature=2] "DEFAULT" n_fact - Factorization frequency for the Jacobian in N-R iteration(-) [DEFAULT = 5] "DEFAULT" DTBeam - Time step size (s) -"DEFAULT" load_retries - Number of factored load retries before quitting the aimulation [DEFAULT = 20] +"DEFAULT" load_retries - Number of factored load retries before quitting the simulation [DEFAULT = 20] "DEFAULT" NRMax - Max number of iterations in Newton-Raphson algorithm (-) [DEFAULT = 10] "DEFAULT" stop_tol - Tolerance for stopping criterion (-) [DEFAULT = 1E-5] FALSE tngt_stf_fd - Use finite differenced tangent stiffness matrix? (flag) diff --git a/modules/aerodyn/src/AeroDyn_IO.f90 b/modules/aerodyn/src/AeroDyn_IO.f90 index fa1ce31d89..d6be842a8c 100644 --- a/modules/aerodyn/src/AeroDyn_IO.f90 +++ b/modules/aerodyn/src/AeroDyn_IO.f90 @@ -2163,8 +2163,8 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, ADBlFile, OutFileRoot, UnE CALL ReadCom( UnIn, InputFile, 'Section Header: Beddoes-Leishman Unsteady Airfoil Aerodynamics Options', ErrStat2, ErrMsg2, UnEc ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! UAMod - Unsteady Aero Model Switch (switch) {1=Baseline model (Original), 2=Gonzalez's variant (changes in Cn,Cc,Cm), 3=Minemma/Pierce variant (changes in Cc and Cm)} [used only when AFAreoMod=2] (-): - CALL ReadVar( UnIn, InputFile, InputFileData%UAMod, "UAMod", "Unsteady Aero Model Switch (switch) {1=Baseline model (Original), 2=Gonzalez's variant (changes in Cn,Cc,Cm), 3=Minemma/Pierce variant (changes in Cc and Cm)} [used only when AFAreoMod=2] (-)", ErrStat2, ErrMsg2, UnEc) + ! UAMod - Unsteady Aero Model Switch (switch) {1=Baseline model (Original), 2=Gonzalez's variant (changes in Cn,Cc,Cm), 3=Minnema/Pierce variant (changes in Cc and Cm)} [used only when AFAreoMod=2] (-): + CALL ReadVar( UnIn, InputFile, InputFileData%UAMod, "UAMod", "Unsteady Aero Model Switch (switch) {1=Baseline model (Original), 2=Gonzalez's variant (changes in Cn,Cc,Cm), 3=Minnema/Pierce variant (changes in Cc and Cm)} [used only when AFAreoMod=2] (-)", ErrStat2, ErrMsg2, UnEc) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! FLookup - Flag to indicate whether a lookup for f' will be calculated (TRUE) or whether best-fit exponential equations will be used (FALSE); if FALSE S1-S4 must be provided in airfoil input files [used only when AFAreoMod=2] (flag): @@ -2771,7 +2771,7 @@ SUBROUTINE AD_PrintSum( InputFileData, p, u, y, ErrStat, ErrMsg ) case (2) Msg = "Gonzalez's variant (changes in Cn, Cc, and Cm)" case (3) - Msg = 'Minemma/Pierce variant (changes in Cc and Cm)' + Msg = 'Minnema/Pierce variant (changes in Cc and Cm)' !case (4) ! Msg = 'DYSTOOL' case default diff --git a/modules/aerodyn/src/AeroDyn_Registry.txt b/modules/aerodyn/src/AeroDyn_Registry.txt index 8258c7a2a2..eef99eb9c4 100644 --- a/modules/aerodyn/src/AeroDyn_Registry.txt +++ b/modules/aerodyn/src/AeroDyn_Registry.txt @@ -83,7 +83,7 @@ typedef ^ AD_InputFile LOGICAL AIDrag - - - "Include the drag term in the axial- typedef ^ AD_InputFile LOGICAL TIDrag - - - "Include the drag term in the tangential-induction calculation? [unused when WakeMod=0 or TanInd=FALSE]" flag typedef ^ AD_InputFile ReKi IndToler - - - "Convergence tolerance for BEM induction factors [unused when WakeMod=0]" - typedef ^ AD_InputFile ReKi MaxIter - - - "Maximum number of iteration steps [unused when WakeMod=0]" - -typedef ^ AD_InputFile IntKi UAMod - - - "Unsteady Aero Model Switch (switch) {1=Baseline model (Original), 2=Gonzalez's variant (changes in Cn,Cc,Cm), 3=Minemma/Pierce variant (changes in Cc and Cm)} [used only when AFAeroMod=2]" - +typedef ^ AD_InputFile IntKi UAMod - - - "Unsteady Aero Model Switch (switch) {1=Baseline model (Original), 2=Gonzalez's variant (changes in Cn,Cc,Cm), 3=Minnema/Pierce variant (changes in Cc and Cm)} [used only when AFAeroMod=2]" - typedef ^ AD_InputFile LOGICAL FLookup - - - "Flag to indicate whether a lookup for f' will be calculated (TRUE) or whether best-fit exponential equations will be used (FALSE); if FALSE S1-S4 must be provided in airfoil input files [used only when AFAeroMod=2]" flag typedef ^ AD_InputFile ReKi InCol_Alfa - - - "The column in the airfoil tables that contains the angle of attack" - typedef ^ AD_InputFile ReKi InCol_Cl - - - "The column in the airfoil tables that contains the lift coefficient" - diff --git a/modules/aerodyn/src/AeroDyn_Types.f90 b/modules/aerodyn/src/AeroDyn_Types.f90 index 17b398ce86..1c921c6754 100644 --- a/modules/aerodyn/src/AeroDyn_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Types.f90 @@ -111,7 +111,7 @@ MODULE AeroDyn_Types LOGICAL :: TIDrag !< Include the drag term in the tangential-induction calculation? [unused when WakeMod=0 or TanInd=FALSE] [flag] REAL(ReKi) :: IndToler !< Convergence tolerance for BEM induction factors [unused when WakeMod=0] [-] REAL(ReKi) :: MaxIter !< Maximum number of iteration steps [unused when WakeMod=0] [-] - INTEGER(IntKi) :: UAMod !< Unsteady Aero Model Switch (switch) {1=Baseline model (Original), 2=Gonzalez's variant (changes in Cn,Cc,Cm), 3=Minemma/Pierce variant (changes in Cc and Cm)} [used only when AFAeroMod=2] [-] + INTEGER(IntKi) :: UAMod !< Unsteady Aero Model Switch (switch) {1=Baseline model (Original), 2=Gonzalez's variant (changes in Cn,Cc,Cm), 3=Minnema/Pierce variant (changes in Cc and Cm)} [used only when AFAeroMod=2] [-] LOGICAL :: FLookup !< Flag to indicate whether a lookup for f' will be calculated (TRUE) or whether best-fit exponential equations will be used (FALSE); if FALSE S1-S4 must be provided in airfoil input files [used only when AFAeroMod=2] [flag] REAL(ReKi) :: InCol_Alfa !< The column in the airfoil tables that contains the angle of attack [-] REAL(ReKi) :: InCol_Cl !< The column in the airfoil tables that contains the lift coefficient [-] diff --git a/modules/aerodyn/src/UnsteadyAero.f90 b/modules/aerodyn/src/UnsteadyAero.f90 index ceeb86e3b6..44754c8121 100644 --- a/modules/aerodyn/src/UnsteadyAero.f90 +++ b/modules/aerodyn/src/UnsteadyAero.f90 @@ -42,7 +42,7 @@ module UnsteadyAero integer(intki), parameter :: UA_Baseline = 1 ! UAMod = 1 [Baseline model (Original)] integer(intki), parameter :: UA_Gonzalez = 2 ! UAMod = 2 [Gonzalez's variant (changes in Cn,Cc,Cm)] - integer(intki), parameter :: UA_MinemmaPierce = 3 ! UAMod = 3 [Minemma/Pierce variant (changes in Cc and Cm)] + integer(intki), parameter :: UA_MinnemaPierce = 3 ! UAMod = 3 [Minnema/Pierce variant (changes in Cc and Cm)] real(ReKi), parameter :: Gonzalez_factor = 0.2_ReKi ! this factor, proposed by Gonzalez (for "all" models) is used to modify Cc to account for negative values seen at f=0 (see Eqn 1.40) @@ -522,7 +522,7 @@ subroutine ComputeKelvinChain( i, j, u, p, xd, OtherState, misc, AFInfo, KC, BL_ Kprimeprime_q = Get_ExpEqn( real(p%dt,ReKi), k_mq**2*T_I , xd%Kprimeprime_q_minus1(i,j) , KC%Kq_f , Kq_f_minus1 ) ! Eqn 1.29 [3] ! Compute Cm_q_nc - if ( p%UAMod == UA_MinemmaPierce ) then + if ( p%UAMod == UA_MinnemaPierce ) then KC%Cm_q_nc = -1.0_ReKi * KC%Cn_q_nc / 4.0_ReKi - (KC%k_alpha**2) * T_I * (KC%Kq_f - Kprimeprime_q) / (3.0_ReKi*M) ! Eqn 1.31 else KC%Cm_q_nc = -7.0_ReKi * (k_mq**2) * T_I * (KC%Kq_f - Kprimeprime_q) / (12.0_ReKi*M) ! Eqn 1.29 [1] @@ -643,7 +643,7 @@ subroutine ComputeKelvinChain( i, j, u, p, xd, OtherState, misc, AFInfo, KC, BL_ end if - if ( p%UAMod == UA_MinemmaPierce ) then + if ( p%UAMod == UA_MinnemaPierce ) then if (OtherState%FirstPass(i,j)) then KC%Dalphaf = 0.0_ReKi else @@ -1059,8 +1059,8 @@ subroutine UA_ValidateInput(InitInp, ErrStat, ErrMsg) ErrStat = ErrID_None ErrMsg = "" - if (InitInp%UAMod < UA_Gonzalez .or. InitInp%UAMod > UA_MinemmaPierce ) call SetErrStat( ErrID_Fatal, & - "In this version, UAMod must be 2 (Gonzalez's variant) or 3 (Minemma/Pierce variant).", ErrStat, ErrMsg, RoutineName ) ! NOTE: for later- 1 (baseline/original) + if (InitInp%UAMod < UA_Gonzalez .or. InitInp%UAMod > UA_MinnemaPierce ) call SetErrStat( ErrID_Fatal, & + "In this version, UAMod must be 2 (Gonzalez's variant) or 3 (Minnema/Pierce variant).", ErrStat, ErrMsg, RoutineName ) ! NOTE: for later- 1 (baseline/original) if (.not. InitInp%FLookUp ) call SetErrStat( ErrID_Fatal, 'FLookUp must be TRUE for this version.', ErrStat, ErrMsg, RoutineName ) @@ -1625,7 +1625,7 @@ subroutine UA_CalcOutput( u, p, xd, OtherState, AFInfo, y, misc, ErrStat, ErrMsg end if - if ( p%UAMod == UA_MinemmaPierce ) then + if ( p%UAMod == UA_MinnemaPierce ) then #ifdef TEST_THEORY y%Cc = Cc_FS + KC%Cn_v*tan(KC%alpha_e)*(1-xd%tau_v(misc%iBladeNode, misc%iBlade)/(BL_p%T_VL)) ! Eqn 1.55 with Eqn. 1.40 #else @@ -1711,7 +1711,7 @@ subroutine UA_CalcOutput( u, p, xd, OtherState, AFInfo, y, misc, ErrStat, ErrMsg x_cp_hat = BL_p%k0 + BL_p%k1*(1.0_ReKi-KC%fprimeprime) + BL_p%k2*sin(pi*KC%fprimeprime**BL_p%k3) ! Eqn 1.42 Cm_FS = BL_p%Cm0 - KC%Cn_alpha_q_circ*(x_cp_hat - 0.25_ReKi) + Cm_common ! Eqn 1.41 - elseif ( p%UAMod == UA_MinemmaPierce ) then + elseif ( p%UAMod == UA_MinnemaPierce ) then ! Look up Cm using alpha_prime_f alpha_prime_f = KC%alpha_f - KC%Dalphaf ! Eqn 1.43a From a53a1e707264a3efdc9772eb9a68050c0393fed5 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Tue, 28 Jan 2020 10:58:33 -0700 Subject: [PATCH 38/72] AD: removed some unused code --- modules/aerodyn/src/BEMT.f90 | 55 ------------------------------------ 1 file changed, 55 deletions(-) diff --git a/modules/aerodyn/src/BEMT.f90 b/modules/aerodyn/src/BEMT.f90 index eb5f8b9681..44ac61f8c0 100644 --- a/modules/aerodyn/src/BEMT.f90 +++ b/modules/aerodyn/src/BEMT.f90 @@ -431,21 +431,6 @@ subroutine BEMT_AllocOutput( y, p, errStat, errMsg ) end subroutine BEMT_AllocOutput - -subroutine BEMT_MapOutputs(p, OtherState, y, errStat, errMsg) - - type(BEMT_ParameterType), intent(in ) :: p ! Parameters - type(BEMT_OtherStateType), intent(in ) :: OtherState ! other states - type(BEMT_OutputType), intent(inout) :: y ! system outputs - integer(IntKi), intent( out) :: errStat ! Error status of the operation - character(*), intent( out) :: errMsg ! Error message if ErrStat /= ErrID_None - - ErrStat = ErrID_None - ErrMsg = "" - -end subroutine BEMT_MapOutputs - - !---------------------------------------------------------------------------------------------------------------------------------- subroutine BEMT_Init( InitInp, u, p, x, xd, z, OtherState, AFInfo, y, misc, Interval, InitOut, ErrStat, ErrMsg ) ! This routine is called at the start of the simulation to perform initialization steps. @@ -1198,12 +1183,6 @@ end subroutine calculate_Inductions_from_DBEMT !---------------------------------------------------------------------------------------------------------------------------------- subroutine BEMT_CalcOutput( t, u, p, x, xd, z, OtherState, AFInfo, y, m, errStat, errMsg ) ! 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. -! NOTE: the descriptions of the output channels are not given here. Please see the included OutListParameters.xlsx sheet for -! for a complete description of each output parameter. -! NOTE: no matter how many channels are selected for output, all of the outputs are calculated -! All of the calculated output channels are placed into the OtherState%AllOuts(:), while the channels selected for outputs are -! placed in the y%WriteOutput(:) array. !.................................................................................................................................. @@ -1241,7 +1220,6 @@ subroutine BEMT_CalcOutput( t, u, p, x, xd, z, OtherState, AFInfo, y, m, errStat integer(IntKi) :: k #endif - logical, parameter :: UpdateValues = .TRUE. ! determines if the OtherState values need to be updated logical :: IsValidSolution !< this is set to false if k<=1 in propeller brake region or k<-1 in momentum region, indicating an invalid solution ! Initialize some output values errStat = ErrID_None @@ -1305,16 +1283,6 @@ subroutine BEMT_CalcOutput( t, u, p, x, xd, z, OtherState, AFInfo, y, m, errStat end if end if - ! Array OtherState%AllOuts() is initialized to 0.0 in initialization, so we are not going to reinitialize it here. - - - !............................................................................................................................... - ! Calculate all of the total forces and moments using all of the partial forces and moments calculated in RtHS(). Also, - ! calculate all of the total angular and linear accelerations using all of the partial accelerations calculated in RtHS(). - ! To do this, first initialize the variables using the portions not associated with the accelerations. Then add the portions - ! associated with the accelerations one by one: - !............................................................................................................................... - do j = 1,p%numBlades ! Loop through all blades ! Locate the maximum rlocal value for this time step and this blade. This is passed to the solve as Rtip @@ -1424,29 +1392,6 @@ subroutine BEMT_CalcOutput( t, u, p, x, xd, z, OtherState, AFInfo, y, m, errStat ! end if #endif - !............................................................................................................................... - ! Place the selected output channels into the WriteOutput(:) array with the proper sign: - !............................................................................................................................... - - call BEMT_MapOutputs(p, OtherState, y, errStat2, errMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (errStat >= AbortErrLev) return - - !DO I = 1,p%NumOuts ! Loop through all selected output channels - ! - ! y%WriteOutput(I) = p%OutParam(I)%SignM * OtherState%AllOuts( p%OutParam(I)%Indx ) - ! - !ENDDO ! I - All selected output channels - - - !............................................................................................................................... - ! Outputs required for AeroDyn - !............................................................................................................................... - - !........... - ! Blade elements: - !........... - return From 5651d13677efbeed8c435e9a713556e20e6897e4 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Tue, 4 Feb 2020 12:52:42 -0700 Subject: [PATCH 39/72] Registry: fix issue with multi-dimension arrays in extrap/interp routine previously worked for only 1-dimensional arrays --- .../openfast-registry/src/gen_module_files.c | 19 ++++++++++++++++--- 1 file changed, 16 insertions(+), 3 deletions(-) diff --git a/modules/openfast-registry/src/gen_module_files.c b/modules/openfast-registry/src/gen_module_files.c index d2002c235b..7e44d315f6 100644 --- a/modules/openfast-registry/src/gen_module_files.c +++ b/modules/openfast-registry/src/gen_module_files.c @@ -1160,7 +1160,7 @@ void gen_extint_order(FILE *fp, const node_t *ModName, char * typnm, char * uy, node_t *q, *r1; int i, j; int mesh = 0; - char derefrecurse[NAMELEN], indent[NAMELEN]; + char derefrecurse[NAMELEN], indent[NAMELEN], tmp[NAMELEN]; if (recurselevel > MAXRECURSE) { fprintf(stderr, "REGISTRY ERROR: too many levels of array subtypes\n"); exit(9); @@ -1178,11 +1178,24 @@ void gen_extint_order(FILE *fp, const node_t *ModName, char * typnm, char * uy, for (r1 = q->fields; r1; r1 = r1->next) { sprintf(derefrecurse, "%s%%%s", deref, r->name); - for (j = r->ndims; j > 0; j--) { + for (j = r->ndims; j > 0; j--) { fprintf(fp, " DO i%d%d = LBOUND(%s_out%s,%d),UBOUND(%s_out%s,%d)\n", recurselevel, j, uy, derefrecurse, j, uy, derefrecurse, j); - sprintf(derefrecurse, "%s%%%s(i%d%d)", deref, r->name, recurselevel, j); } + + + if (r->ndims > 0) { + strcat(derefrecurse, "("); + for (j = 1; j <= r->ndims; j++) { + sprintf(tmp, "i%d%d", recurselevel, j); + strcat(derefrecurse, tmp); + if (j < r->ndims) { + strcat(derefrecurse, ","); + } + } + strcat(derefrecurse, ")"); + } + gen_extint_order(fp, ModName, typnm, uy, order, r1, derefrecurse, recurselevel + 1); for (j = r->ndims; j > 0; j--) { fprintf(fp, " ENDDO\n"); From 5a275638d0faa108b7781b11a2385b4670e6b2fa Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Tue, 18 Feb 2020 13:15:36 -0700 Subject: [PATCH 40/72] Fix driver builds --- modules/aerodyn/src/AeroDyn_Driver_Types.f90 | 281 ++++++++----------- modules/beamdyn/CMakeLists.txt | 2 +- modules/hydrodyn/src/HydroDyn_DriverCode.f90 | 3 +- vs-build/AeroDyn/AeroDyn_Driver.vfproj | 1 + vs-build/BeamDyn/BeamDyn-w-registry.sln | 23 +- vs-build/BeamDyn/BeamDyn.vfproj | 1 + vs-build/HydroDyn/HydroDynDriver.vfproj | 4 +- 7 files changed, 139 insertions(+), 176 deletions(-) diff --git a/modules/aerodyn/src/AeroDyn_Driver_Types.f90 b/modules/aerodyn/src/AeroDyn_Driver_Types.f90 index b6d95ded58..a8ea597818 100644 --- a/modules/aerodyn/src/AeroDyn_Driver_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Driver_Types.f90 @@ -194,20 +194,20 @@ SUBROUTINE AD_Dvr_PackDvr_Case( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WndSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ShearExp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RotSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Pitch - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Yaw - Re_Xferred = Re_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%dT - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%Tmax - Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WndSpeed + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ShearExp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RotSpeed + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Pitch + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Yaw + Re_Xferred = Re_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%dT + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%Tmax + Db_Xferred = Db_Xferred + 1 END SUBROUTINE AD_Dvr_PackDvr_Case SUBROUTINE AD_Dvr_UnPackDvr_Case( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -223,12 +223,6 @@ SUBROUTINE AD_Dvr_UnPackDvr_Case( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -243,20 +237,20 @@ SUBROUTINE AD_Dvr_UnPackDvr_Case( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%WndSpeed = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%ShearExp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RotSpeed = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Pitch = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Yaw = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%dT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%Tmax = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%WndSpeed = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%ShearExp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RotSpeed = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Pitch = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Yaw = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%dT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%Tmax = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 END SUBROUTINE AD_Dvr_UnPackDvr_Case SUBROUTINE AD_Dvr_CopyDvr_OutputFile( SrcDvr_OutputFileData, DstDvr_OutputFileData, CtrlCode, ErrStat, ErrMsg ) @@ -449,24 +443,24 @@ SUBROUTINE AD_Dvr_PackDvr_OutputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%unOutFile - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%delim) - IntKiBuf(Int_Xferred) = ICHAR(InData%delim(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%outFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%outFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%Root) - IntKiBuf(Int_Xferred) = ICHAR(InData%Root(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%runTitle) - IntKiBuf(Int_Xferred) = ICHAR(InData%runTitle(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + IntKiBuf(Int_Xferred) = InData%unOutFile + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%delim) + IntKiBuf(Int_Xferred) = ICHAR(InData%delim(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%outFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%outFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%Root) + IntKiBuf(Int_Xferred) = ICHAR(InData%Root(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%runTitle) + IntKiBuf(Int_Xferred) = ICHAR(InData%runTitle(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( .NOT. ALLOCATED(InData%WriteOutputHdr) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -477,12 +471,12 @@ SUBROUTINE AD_Dvr_PackDvr_OutputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) + DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) DO I = 1, LEN(InData%WriteOutputHdr) IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdr(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -494,12 +488,12 @@ SUBROUTINE AD_Dvr_PackDvr_OutputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) + DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) DO I = 1, LEN(InData%WriteOutputUnt) IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUnt(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF END SUBROUTINE AD_Dvr_PackDvr_OutputFile @@ -516,12 +510,6 @@ SUBROUTINE AD_Dvr_UnPackDvr_OutputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -576,24 +564,24 @@ SUBROUTINE AD_Dvr_UnPackDvr_OutputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%unOutFile = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%delim) - OutData%delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%outFmt) - OutData%outFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Root) - OutData%Root(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%runTitle) - OutData%runTitle(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + OutData%unOutFile = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%delim) + OutData%delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%outFmt) + OutData%outFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%Root) + OutData%Root(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%runTitle) + OutData%runTitle(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputHdr not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -607,19 +595,12 @@ SUBROUTINE AD_Dvr_UnPackDvr_OutputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) DO I = 1, LEN(OutData%WriteOutputHdr) OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated Int_Xferred = Int_Xferred + 1 @@ -634,19 +615,12 @@ SUBROUTINE AD_Dvr_UnPackDvr_OutputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) DO I = 1, LEN(OutData%WriteOutputUnt) OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF END SUBROUTINE AD_Dvr_UnPackDvr_OutputFile @@ -1143,8 +1117,10 @@ SUBROUTINE AD_Dvr_PackAeroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%InputTime))-1 ) = PACK(InData%InputTime,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%InputTime) + DO i1 = LBOUND(InData%InputTime,1), UBOUND(InData%InputTime,1) + DbKiBuf(Db_Xferred) = InData%InputTime(i1) + Db_Xferred = Db_Xferred + 1 + END DO END SUBROUTINE AD_Dvr_PackAeroDyn_Data SUBROUTINE AD_Dvr_UnPackAeroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1160,12 +1136,6 @@ SUBROUTINE AD_Dvr_UnPackAeroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1506,15 +1476,10 @@ SUBROUTINE AD_Dvr_UnPackAeroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) i1_l = LBOUND(OutData%InputTime,1) i1_u = UBOUND(OutData%InputTime,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%InputTime = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%InputTime))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%InputTime) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%InputTime,1), UBOUND(OutData%InputTime,1) + OutData%InputTime(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO END SUBROUTINE AD_Dvr_UnPackAeroDyn_Data SUBROUTINE AD_Dvr_CopyDvr_SimData( SrcDvr_SimDataData, DstDvr_SimDataData, CtrlCode, ErrStat, ErrMsg ) @@ -1690,24 +1655,24 @@ SUBROUTINE AD_Dvr_PackDvr_SimData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%AD_InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%AD_InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%numBlades - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%hubRad - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%hubHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%overhang - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ShftTilt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Precone - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumCases - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%AD_InputFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%AD_InputFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%numBlades + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%hubRad + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%hubHt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%overhang + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ShftTilt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Precone + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumCases + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%Cases) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1792,12 +1757,6 @@ SUBROUTINE AD_Dvr_UnPackDvr_SimData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1812,24 +1771,24 @@ SUBROUTINE AD_Dvr_UnPackDvr_SimData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%AD_InputFile) - OutData%AD_InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%numBlades = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%hubRad = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%hubHt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%overhang = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%ShftTilt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Precone = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NumCases = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%AD_InputFile) + OutData%AD_InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%numBlades = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%hubRad = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%hubHt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%overhang = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%ShftTilt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Precone = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NumCases = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cases not allocated Int_Xferred = Int_Xferred + 1 ELSE diff --git a/modules/beamdyn/CMakeLists.txt b/modules/beamdyn/CMakeLists.txt index 0481d770f5..dae656b088 100644 --- a/modules/beamdyn/CMakeLists.txt +++ b/modules/beamdyn/CMakeLists.txt @@ -21,7 +21,7 @@ endif() set(BD_SOURCES src/BeamDyn.f90 src/BeamDyn_IO.f90 - src/BeamDyn_BldNdOuts_IO + src/BeamDyn_BldNdOuts_IO.f90 src/BeamDyn_Subs.f90 src/BeamDyn_Types.f90 ) diff --git a/modules/hydrodyn/src/HydroDyn_DriverCode.f90 b/modules/hydrodyn/src/HydroDyn_DriverCode.f90 index bcb8b6e5a7..7a4361b618 100644 --- a/modules/hydrodyn/src/HydroDyn_DriverCode.f90 +++ b/modules/hydrodyn/src/HydroDyn_DriverCode.f90 @@ -112,7 +112,6 @@ PROGRAM HydroDynDriver real(ReKi) :: PrevClockTime ! Clock time at start of simulation in seconds real(ReKi) :: UsrTime1 ! User CPU time for simulation initialization real(ReKi) :: UsrTime2 ! User CPU time for simulation (without intialization) - real(ReKi) :: UsrTimeDiff ! Difference in CPU time from start to finish of program execution real(DbKi) :: TiLstPrn ! The simulation time of the last print real(DbKi) :: t_global ! Current simulation time (for global/FAST simulation) real(DbKi) :: SttsTime ! Amount of time between screen status messages (sec) @@ -540,7 +539,7 @@ subroutine HD_DvrCleanup() end if ! Print *, time - call RunTimes( StrtTime, REAL(UsrTime1,ReKi), SimStrtTime, REAL(UsrTime2,ReKi), time, UsrTimeDiff ) + call RunTimes( StrtTime, REAL(UsrTime1,ReKi), SimStrtTime, REAL(UsrTime2,ReKi), time ) call NormStop() end subroutine HD_DvrCleanup diff --git a/vs-build/AeroDyn/AeroDyn_Driver.vfproj b/vs-build/AeroDyn/AeroDyn_Driver.vfproj index 88f796b098..df3e8d2c01 100644 --- a/vs-build/AeroDyn/AeroDyn_Driver.vfproj +++ b/vs-build/AeroDyn/AeroDyn_Driver.vfproj @@ -117,6 +117,7 @@ + diff --git a/vs-build/BeamDyn/BeamDyn-w-registry.sln b/vs-build/BeamDyn/BeamDyn-w-registry.sln index a881f9d525..5c99185653 100644 --- a/vs-build/BeamDyn/BeamDyn-w-registry.sln +++ b/vs-build/BeamDyn/BeamDyn-w-registry.sln @@ -1,7 +1,7 @@  Microsoft Visual Studio Solution File, Format Version 12.00 -# Visual Studio 2013 -VisualStudioVersion = 12.0.40629.0 +# Visual Studio 15 +VisualStudioVersion = 15.0.28307.902 MinimumVisualStudioVersion = 10.0.40219.1 Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "BeamDyn", "BeamDyn.vfproj", "{815C302F-A93D-4C22-9329-7112345113C0}" ProjectSection(ProjectDependencies) = postProject @@ -38,18 +38,18 @@ Global {815C302F-A93D-4C22-9329-7112345113C0}.Release|Win32.Build.0 = Release|Win32 {815C302F-A93D-4C22-9329-7112345113C0}.Release|x64.ActiveCfg = Release|x64 {815C302F-A93D-4C22-9329-7112345113C0}.Release|x64.Build.0 = Release|x64 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug_Double|Win32.ActiveCfg = Debug-Double Precision|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug_Double|Win32.Build.0 = Debug-Double Precision|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug_Double|x64.ActiveCfg = Debug-Double Precision|x64 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug_Double|x64.Build.0 = Debug-Double Precision|x64 + {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug_Double|Win32.ActiveCfg = Debug|Win32 + {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug_Double|Win32.Build.0 = Debug|Win32 + {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug_Double|x64.ActiveCfg = Debug|x64 + {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug_Double|x64.Build.0 = Debug|x64 {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug|Win32.ActiveCfg = Debug|Win32 {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug|Win32.Build.0 = Debug|Win32 {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug|x64.ActiveCfg = Debug|x64 {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug|x64.Build.0 = Debug|x64 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release_Double|Win32.ActiveCfg = Release-Double Precision|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release_Double|Win32.Build.0 = Release-Double Precision|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release_Double|x64.ActiveCfg = Release-Double Precision|x64 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release_Double|x64.Build.0 = Release-Double Precision|x64 + {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release_Double|Win32.ActiveCfg = Release|Win32 + {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release_Double|Win32.Build.0 = Release|Win32 + {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release_Double|x64.ActiveCfg = Release|x64 + {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release_Double|x64.Build.0 = Release|x64 {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release|Win32.ActiveCfg = Release|Win32 {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release|Win32.Build.0 = Release|Win32 {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release|x64.ActiveCfg = Release|x64 @@ -58,4 +58,7 @@ Global GlobalSection(SolutionProperties) = preSolution HideSolutionNode = FALSE EndGlobalSection + GlobalSection(ExtensibilityGlobals) = postSolution + SolutionGuid = {37F40376-E0A4-4BB3-A987-A3CF5A440217} + EndGlobalSection EndGlobal diff --git a/vs-build/BeamDyn/BeamDyn.vfproj b/vs-build/BeamDyn/BeamDyn.vfproj index 53d190698d..852d40158e 100644 --- a/vs-build/BeamDyn/BeamDyn.vfproj +++ b/vs-build/BeamDyn/BeamDyn.vfproj @@ -113,6 +113,7 @@ + diff --git a/vs-build/HydroDyn/HydroDynDriver.vfproj b/vs-build/HydroDyn/HydroDynDriver.vfproj index 3b09fce433..4e712e3c88 100644 --- a/vs-build/HydroDyn/HydroDynDriver.vfproj +++ b/vs-build/HydroDyn/HydroDynDriver.vfproj @@ -14,9 +14,9 @@ - + - + From 8262753cf6de2dc357e594ccde366ad2900c9d57 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Mon, 9 Mar 2020 09:36:28 -0600 Subject: [PATCH 41/72] HD inputs from ED set before option 1 solve in fixed-bottom cases. Make sure HydroDyn inputs are set from ElastoDyn outputs in fixed-bottom simulations prior to starting the solve option 1 code. I don't expect this to have much effect on the results, but this more closely follows the implementation plan. Also fixed some typos in comments @jjonkman and @ghaymanNREL may want to incorporate this in other branches they are working on. --- .../openfast-library/src/FAST_Registry.txt | 2 +- modules/openfast-library/src/FAST_Solver.f90 | 30 +++++++++++++++---- 2 files changed, 25 insertions(+), 7 deletions(-) diff --git a/modules/openfast-library/src/FAST_Registry.txt b/modules/openfast-library/src/FAST_Registry.txt index ee121790c7..8ff39812ab 100644 --- a/modules/openfast-library/src/FAST_Registry.txt +++ b/modules/openfast-library/src/FAST_Registry.txt @@ -598,7 +598,7 @@ typedef ^ FAST_ModuleMapType MeshMapType SD_P_2_IceF_P - - - "Map SubDyn y2Mesh typedef ^ FAST_ModuleMapType MeshMapType IceD_P_2_SD_P {:} - - "Map IceDyn point mesh to SubDyn y2Mesh point mesh" typedef ^ FAST_ModuleMapType MeshMapType SD_P_2_IceD_P {:} - - "Map SubDyn y2Mesh point mesh to IceDyn point mesh" # Stored Jacobians: -typedef ^ FAST_ModuleMapType ReKi Jacobian_Opt1 {:}{:} - - "Stored Jacobian in ED_HD_InputOutputSolve or ED_SD_HD_BD_InputOutputSolve" +typedef ^ FAST_ModuleMapType ReKi Jacobian_Opt1 {:}{:} - - "Stored Jacobian in ED_HD_InputOutputSolve or FullOpt1_InputOutputSolve" typedef ^ FAST_ModuleMapType Integer Jacobian_pivot {:} - - "Pivot array used for LU decomposition of Jacobian_Opt1" typedef ^ FAST_ModuleMapType Integer Jac_u_indx {:}{:} - - "matrix to help fill/pack the u vector in computing the jacobian" # Temporary copies of input meshes (stored here so we don't have to keep allocating/destroying them) diff --git a/modules/openfast-library/src/FAST_Solver.f90 b/modules/openfast-library/src/FAST_Solver.f90 index 330225a6f6..5d71b3e4ec 100644 --- a/modules/openfast-library/src/FAST_Solver.f90 +++ b/modules/openfast-library/src/FAST_Solver.f90 @@ -1045,19 +1045,25 @@ SUBROUTINE Transfer_ED_to_HD_SD_BD_Mooring( p_FAST, y_ED, u_HD, u_SD, u_ExtPtfm, CALL Transfer_Point_to_Point( y_ED%PlatformPtMesh, u_SD%TPMesh, MeshMapData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg,RoutineName//':u_SD%TPMesh' ) + IF ( p_FAST%CompHydro == Module_HD ) call TransferFixedBottomToHD() + ELSEIF ( p_FAST%CompSub == Module_ExtPtfm ) THEN ! Map ED (motion) outputs to ExtPtfm inputs: CALL Transfer_Point_to_Point( y_ED%PlatformPtMesh, u_ExtPtfm%PtfmMesh, MeshMapData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg,RoutineName//':u_ExtPtfm%PtfmMesh' ) + IF ( p_FAST%CompHydro == Module_HD ) call TransferFixedBottomToHD() ELSEIF ( p_FAST%CompHydro == Module_HD ) THEN ! Map ED outputs to HD inputs: CALL Transfer_PlatformMotion_to_HD( y_ED%PlatformPtMesh, u_HD, MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg,RoutineName ) - END IF + END IF + + + IF ( p_FAST%CompElast == Module_BD .and. BD_Solve_Option1) THEN ! map ED root and hub motion outputs to BeamDyn: @@ -1089,7 +1095,19 @@ SUBROUTINE Transfer_ED_to_HD_SD_BD_Mooring( p_FAST, y_ED, u_HD, u_SD, u_ExtPtfm, CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg,RoutineName//'u_Orca%PtfmMesh' ) END IF - +contains + subroutine TransferFixedBottomToHD() + IF ( u_HD%Mesh%Committed ) THEN + + ! These are the motions for the lumped point loads associated the WAMIT body and include: hydrostatics, radiation memory effect, + ! wave kinematics, additional preload, additional stiffness, additional linear damping, additional quadratic damping, + ! hydrodynamic added mass + + CALL Transfer_Point_to_Point( y_ED%PlatformPtMesh, u_HD%Mesh, MeshMapData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg, RoutineName//' (u_HD%Mesh)' ) + + END IF !WAMIT + end subroutine END SUBROUTINE Transfer_ED_to_HD_SD_BD_Mooring !---------------------------------------------------------------------------------------------------------------------------------- !> This routine sets the inputs required for MAP. @@ -1283,11 +1301,11 @@ END SUBROUTINE Transfer_ED_to_BD_tmp SUBROUTINE Transfer_HD_to_SD( u_mapped, u_SD_LMesh, u_mapped_positions, y_HD, u_HD_M_LumpedMesh, u_HD_M_DistribMesh, MeshMapData, ErrStat, ErrMsg ) !.................................................................................................................................. TYPE(MeshType), INTENT(INOUT) :: u_mapped !< temporary copy of SD mesh (an argument to avoid another temporary mesh copy) - TYPE(MeshType), INTENT(INOUT) :: u_SD_LMesh !< SD Inputs on LMesh at t (separate so we can call from ED_SD_HD_InputOutput solve with temp meshes) + TYPE(MeshType), INTENT(INOUT) :: u_SD_LMesh !< SD Inputs on LMesh at t (separate so we can call from FullOpt1_InputOutputSolve with temp meshes) TYPE(MeshType), INTENT(IN ) :: u_mapped_positions !< Mesh sibling of u_mapped, with displaced positions TYPE(HydroDyn_OutputType), INTENT(IN ) :: y_HD !< HydroDyn outputs - TYPE(MeshType), INTENT(IN ) :: u_HD_M_LumpedMesh !< HydroDyn input mesh (separate so we can call from ED_SD_HD_InputOutput solve with temp meshes) - TYPE(MeshType), INTENT(IN ) :: u_HD_M_DistribMesh !< HydroDyn input mesh (separate so we can call from ED_SD_HD_InputOutput solve with temp meshes) + TYPE(MeshType), INTENT(IN ) :: u_HD_M_LumpedMesh !< HydroDyn input mesh (separate so we can call from FullOpt1_InputOutputSolve with temp meshes) + TYPE(MeshType), INTENT(IN ) :: u_HD_M_DistribMesh !< HydroDyn input mesh (separate so we can call from FullOpt1_InputOutputSolve with temp meshes) TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status @@ -4322,7 +4340,7 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M !............................................................................................................................ ! Initialize the Jacobian structures: !............................................................................................................................ - !IF ( p_FAST%TurbineType == Type_Offshore_Fixed ) THEN ! p_FAST%CompSub == Module_SD .AND. p_FAST%CompHydro == Module_HD + !IF ( p_FAST%TurbineType == Type_Offshore_Fixed ) THEN IF ( p_FAST%CompSub /= Module_None .OR. (p_FAST%CompElast == Module_BD .and. BD_Solve_Option1) .or. p_FAST%CompMooring == Module_Orca) THEN !.OR. p_FAST%CompHydro == Module_HD ) THEN CALL Init_FullOpt1_Jacobian( p_FAST, MeshMapData, ED%Input(1)%PlatformPtMesh, SD%Input(1)%TPMesh, SD%Input(1)%LMesh, & HD%Input(1)%Morison%LumpedMesh, HD%Input(1)%Morison%DistribMesh, HD%Input(1)%Mesh, & From b432f334e2d3b239a574af805c0082ce506ac28d Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Wed, 25 Mar 2020 09:57:50 -0600 Subject: [PATCH 42/72] update comment --- glue-codes/simulink/src/create_FAST_SFunc.m | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/glue-codes/simulink/src/create_FAST_SFunc.m b/glue-codes/simulink/src/create_FAST_SFunc.m index 4c52505fba..f97fb2b41e 100644 --- a/glue-codes/simulink/src/create_FAST_SFunc.m +++ b/glue-codes/simulink/src/create_FAST_SFunc.m @@ -1,7 +1,7 @@ %% INSTRUCTIONS % Before running this script, you must have compiled OpenFAST for Simulink to create a DLL (i.e., a shared library like .so, .dylib, .lib, etc.). % - If cmake was used, make sure the install directory is specified properly in the `installDir` variable below, -% and set `built_with_visualStudio` to false (necessary on Windows only). +% and if using Windows, set `built_with_visualStudio` to false. % - If the Visual Studio Solution file contained in the vs-build directory was used to create the DLL on Windows, % make sure `built_with_visualStudio` is set to true. % - The name of the library that was generated must match the `libname` variable below From 58d4a8cc76f62941c83e4bd915943328534730c9 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Fri, 17 Apr 2020 16:52:58 -0600 Subject: [PATCH 43/72] minor update to batch file in vs-build added some quotation marks in case of spaces in path names added "call" to command line --- vs-build/FASTlib/FASTlib.vfproj | 39 ++++++++++++--------------------- vs-build/RunRegistry.bat | 6 ++++- 2 files changed, 19 insertions(+), 26 deletions(-) diff --git a/vs-build/FASTlib/FASTlib.vfproj b/vs-build/FASTlib/FASTlib.vfproj index 81027f59fa..4c1b507418 100644 --- a/vs-build/FASTlib/FASTlib.vfproj +++ b/vs-build/FASTlib/FASTlib.vfproj @@ -11,7 +11,7 @@ - + @@ -20,7 +20,7 @@ - + @@ -29,7 +29,7 @@ - + @@ -38,7 +38,7 @@ - + @@ -47,7 +47,7 @@ - + @@ -56,7 +56,7 @@ - + @@ -65,7 +65,7 @@ - + @@ -74,7 +74,7 @@ - + @@ -83,7 +83,7 @@ - + @@ -92,7 +92,7 @@ - + @@ -101,7 +101,7 @@ - + @@ -110,24 +110,13 @@ - + - - - - - - - - - - - - - + + diff --git a/vs-build/RunRegistry.bat b/vs-build/RunRegistry.bat index 6c7db0f6ea..3719c14711 100644 --- a/vs-build/RunRegistry.bat +++ b/vs-build/RunRegistry.bat @@ -129,7 +129,7 @@ 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 %CURR_LOC% -O %Output_Loc% -noextrap +%REGISTRY% "%CURR_LOC%\AeroDyn_Driver_Registry.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -O "%Output_Loc%" -noextrap GOTO checkError :AFI @@ -258,6 +258,10 @@ SET Output_Loc=%CURR_LOC% %REGISTRY% "%CURR_LOC%\%ModuleName%_Registry.txt" -I "%NWTC_Lib_Loc%" -O "%Output_Loc%" GOTO checkError +:Version +DEL "%Root_Loc%\VersionInfo.obj" "%Root_Loc%\versioninfo.mod" +GOTO end + :checkError ECHO. IF %ERRORLEVEL% NEQ 0 ( From 07ff3b5786d20a0f80deff9e7bb91c3f2c1c17f0 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Fri, 17 Apr 2020 18:10:10 -0600 Subject: [PATCH 44/72] add backup xlsx file type to gitignore --- .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index da5ea6ff03..2db6788dfe 100644 --- a/.gitignore +++ b/.gitignore @@ -44,6 +44,7 @@ vs-build/ # backup files *.asv +~$*.xlsx # LaTeX compiling files *.aux From 63de719a1b3a0df4749f8c3279c1296fdf14d7f2 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Fri, 17 Apr 2020 20:16:29 -0600 Subject: [PATCH 45/72] Minor updates - remove unused code - update text formatting - add version header file to vs-build - fix some error handling in OpenFOAM.f90 --- docs/OtherSupporting/OutListParameters.xlsx | Bin 219433 -> 219294 bytes docs/source/user/api_change.rst | 2 +- .../aerodyn/src/AeroDyn_AllBldNdOuts_IO.f90 | 13 ------- modules/hydrodyn/src/Waves.f90 | 4 +- modules/openfoam/src/OpenFOAM.f90 | 35 +++++++++++------- modules/servodyn/src/ServoDyn.f90 | 4 -- modules/subdyn/src/SubDyn.f90 | 1 - vs-build/FASTlib/FASTlib.vfproj | 3 +- 8 files changed, 26 insertions(+), 36 deletions(-) diff --git a/docs/OtherSupporting/OutListParameters.xlsx b/docs/OtherSupporting/OutListParameters.xlsx index 21b05e29ca77db5fb35b3fd1e30b3bf76f9c131f..f041af38ce5dabbf72b12fdb18dd3fac52a13750 100644 GIT binary patch delta 129687 zcmZ5{WmFtX)Gh7=cXxLWt^tAvcXxLP(70=G*Wm8%F2UVBxVt^>z2EoNdhbuIncAoJ z*=JYJs_N>Vl3K*98pLWAXjnY@!Iw=45RkF>uh3LLJhG(nR}6Do$rIIvb=u6>SSgt+ zjvAgJ&{B(!7k+3M%A@mE+hW=3w@&XY!HeaLuGNFo8p^z!3`ChZ2bqBCz@h~HFXNLB zHS=6iB8Evjk!-BY*-{3bZI5qFH;7pBPJglyn7hOMS`r*FmR;lMrJ^Ig=%GN-!81D2 z8&DGhXND9oauF0HtdrJ@4q&`P38}pBaqdxwo$6D8kseA1fg_nH!mRWpuZB`;13j8q z?StCU13y}7QM0PL`!h_H1=J*D$>j4!$acXd*?c?1b&Tk?n0$e~?mm8Z|KCYv8I=B5 zUL?HwD;tpOy)pQBx$)@Mt32+R6q}gFvh#$%f@0WKlpE)X(*>h0!)F@D*EBfleXNX_qy?myLq<&r)I1JKT=CnXZj1kL9zd0VI$U`;`{p~9(9>^T#iQYck$vu_P8JL zZqHj|fB9KA+cY#f{)4U&b5VVT%;?O>JFW z2Xw9~-n@*Sal`%SbTyH)r#28iwKYOzSCW7C&6>YuN%pktY;O>KJz6Dw&FUjr|Mhn( zf5+dUVDxUA<5=XEOWxC+`$GqoWObG7VB}m<;Lm3K)1O|}YpY0hAsu(W z5><5Zu{hJY8xsj;4daQjG4F}GhPZNVR9qa_$X|9+7)~F`YX#Td9{bL$6n!dOHB_}? zx78U=b#$^1W&w-D^IB0Q+3+8(fy0f|NK%M;V?`D&v~|X_+RjVzExQo2qQ8jFIQ!b! zM-;7_Jklz{Z=YfbPB^7f&*E_()!JT_GwTSH;+;bZUZ1^Mr6T%ZmG}-`+I{SPtt^ma z0-j$nO|F|m4tzAXXQ81y&lZ?LS%%gqn4c%P$}9b+}iuEcQkdhl;5c2^9Qm+s>KSW$h}o*&31>yCY+fOYnYhltie#gySYpA-q!D19cl^Q}if6FKC9 z-Cm-IjI6qAwc2*4+!Y7I6NM9M%mo=@j2fe2I}l^!d`=vMX@%cj(&0w)9J@TPV}!+T zBM0y;&z=Wn8?DlRX;Qd2x@lonVIrVRdCb%FfF@6nkR*k|FW*vtt%onJ?TW+Wd7@8Y z%-xP9!_>HThbhWjUw&DzX2LdO&H#jZMEO+b60NZH?DvOfsn4QaJ;@adk6$Tr zlUzZw4!$PC*s6FQ(PqEYm-Qb8Fk7rQygo9*4jC>*q;$>;w;YtCl-HiKaUs@&B|It= zBrF=Hw82@i@D1Zae-$=SvoZjZ6FQ*a|ol@oWyd2C7yt*B7?q@6XQ6p-x<@4(3V#z7365rRKqk%sL@LC?$$iVFkv z8v_`r!v_OlGKMlvxt!Wo9fDUp+E<8>Rsdo+9cwJXXTy9=ypSFX%TWREAP!ZF=!cMsT*!m*uZkI+E=R z%w1srYiKfHGOMqQh+UMw$K1DpCxdO-;isr*zl?{C0XaBdLb8G4z}I%nP1R@oPmh! z3HlcoI2qdFMa6oO3MVM&Bt^NNhR@i%*vwuqJj zTYbXD#JoZI!`;9z&E-H^%MW(*V|4mFRv~pgEBZV+k^yLpe(Q<{Q#mTO%Fr-qEs6w^S9EI<%l>6`keD=8)8tzEao2e=opXl6KTqD)e}<5!xyTQGD@AiZFV`Y?XoEO0RHDib-3?^nO9%G8EtS zb4h=UpawTEkD_U3QdKKVm+ZmPD?8JA^fGf9!Zjx&ds#6V9378;M(gsX(61`QRqUbk zbbmK?OZdiaZXyPYF)vNn6F6O-8S{4rq3eLq1cNY7C3rN#c9~YB6iFw|AUGetZFm7fPxaTOK@N}|BYhi94nk68E4CSG=ot2Qy<#1KQc$S3?U3k6$TCG zmq?V0#ax(h+uPbXMwY(a%VB}nXiQ>5h>pV=OE62WbyGt6WVPN#Mi9wkO|b#nxPrutpE-QWawzw?Y5%$Fim~vKYANUB^mQBS)){C+W2B}|2^7YKH`1yJi z`30Kk*JLz;Ntu9$^EwJfrzqi}!8pp-)Q*%dVa)hgZ?z`RN_FEsO1hyg~aGySuzHQ^-trtzzHy!fu zC*Zwh-AfPxK$;>Eym0Nx-6F)L?H*h`c42#bI>AGr<9@KWU+Z`?xp9AO_V9s<0C8v# zuwo5hs_-yxi?yo`4xafp_|{NbuI*p=Is z?*#O9$$NJJPH20{Z(9a8&CkzXugyQ-7w@+po!K&UWz!37i{ee)QQvJI-X_z}lBvYN z)iQ5%1YfnSzgVRp`aYFfR*&4BAlp7dbQ`}(khQGL%Miqy8u_0(_cf{s;uTtUes4}!@5M9>k!{hCwYzD`UaiCyD5Nv z@olpkFj>qT)V548(NO#yqYG=FJ>ff(Ld&51JB^k><##ac`iMZy7w;KQ9hpf}iA$|a zfLX}yqetP%6lTL)LR0O>!t-lEU_2^t5c4i_Vv3`yehL5GXFGcJ5nY>jJ)|?GP4L@i zPMNar4`xQ3d+=2doldHjqf#SK(zNrtj)PEuv_&PZ9z6>F6bWE?O7SK2d5IKV94O1jU=$ccNW??DKc%2RXv{JV zaW3B%^2lXZVs>{fzRN_*+a$7`c_pDwnL@pn>!2n1Ex|Vxxk%;K96LWu6pt;fZL};c zHL;b;ReJ0s?aq45Z3k7JiYFW#!m$;1o7p)alM6A2FoNB98HsXu7zruqbY!=b=Ge8v zHSyK3FF@6R>pW5tcTOW=<7mKf+*aY&!e#7S$yIhx2)Ry$A^bkUk+O5I3JHTGI7OT$ z=|pKSujLi z3~1b6k?d2K_g$(IbMeSu640EI5faHpFMhFem?y{v@+$NG2;!cK4K4uuerdTuQfs0) z)ni)yQrjh?T_6{i1-Hzj!N{ix8wjODFF5hs==r8hFJZZpiy0A@lU_1$bRAD2*=#Q9=Ro)3| z?q~$L$VxhlNIMGmA;T}A4z=M08I^~455C-rAxc3F4MxMx5C-S)h^WsYWkvy0ofJBd z&ndt$l@8gcxWvN4ekC2dm;RnjuA1l{#5HHlUqNved1j*@*>pO~!T%ollM8}iA2TpK zEjad`GMG8yA`;CjWEhkLDT2C*Sa~j?de{?9G)3Hb5H?Q~*z=7wYge!pE-to!vG~kf zhy91U$37Gv`8qVl5ncqZ!Js3IWIT_v8Z=)}b80-&E34QsZOfrN=5ZS9&i#|ZH+D!gK?`|> z8}URI!2q+U1nrXtlq4qPv${F%sCGf)e-!VqyZF!ksp=Z~)&iNESGcBCy&;Co$@B8vR7-Z9xZv>bcmvVF~m{Cf2R9i3!PkluW|lYxfAaHR6g;Wr8bF^q)6(I=-m0; zjKUWfo+5_|oc6h-f9pZuk;OIepJmVe^nE>pQ!c>tQNfD$>pv4LDi<%2vc-2pE)>V_Vc=$N-83$7(fZmpp0Vfu}D+c=vIVm)I#~R z6SpYt0kfciyEk^W0L8Obcp<%TYw|5Ue!;^|)s12)ouZO{Ad%PL@P~U4V+v2d$;K44 zBqS9jwHlOvcH-1r{l5QHf&F3GSerMH*Fj^7)kKWETAo=`OkmAR$Ia%ju$MMTVrjYZ zZr>YEF1C`+-H(6FYA0F?G8^^-EdftL@y9GNs%4%Kc}JM&_%`DW=N=#TT5eL7CM^`TZAKMP0CdiYg*btv4NF}`+G!X3W=bU zDDi84%2m#k<*TTl{#Z#)!5bo=nVcR^`l%vP~G5iKwwUZ#bF)H&rngAWno;fh@n?k!@QaR!%^7S!a{OJ zg$d?NDuY{jQR3;Yl&fp^D-_9S+3*_EIP(3_vmT?nV526^NzumN31b(0eYJg< zJvG_szRH_BXNBM7Svn^nTQ7soXd(q>{Pp6!GDw_&!6Y~^tGJnPa-(SWz*I}x8O^M| zp=lTSMoK5rrite@WZyFhY%wV?T(-cbKaKrCSXL|_fI`h3uvz4{2tH*iK&~Tw><`gx zRclVU&cG`TLSC-dbT$2jECr!PjOx+6oh+1LD(+sy@J$ilxKK>Lx6jCo5)x&eu`Df6 za^E2o3razU3hTTi=F%FSiZ47*Gdthalv)f&APmQ`a~WmvCvA)<(9R42FGjS&BSx54 zm>?SBM^&-(?Hgqt;A1OnOWnA$JWdj!y<9 zto-MU44=6S6T$!(F#QAmOB^&JJ1#v}9=4wqdq-E)Cq2t^ebAo)_<$OrTZCXybm4$P zl7jpdLVcN$U33%lFuwC*ELS7Hzc=s*dDPJ?zfUE;mNwFfYA9;F`!S3^6r>V<>!`+q z7fW2Pe=XFPUXF5BW)RF3GJb*uogTC`{T%E2w;r<1;wc~SR)#+$olJK#RXPn$QS^sO z{6^rCG+>+27&sgNRSJpxWbj~OMhRQfQu?~C!eRLA^3KffrHcuFa5&@D+^7w|BZK)-vh1=}-^CF?IYu09zJXo+l<8rgv zXW6j+OVpk=4>k`Ly7TDs|4WF1!A)2X4S2~+CGUr56J|@^r#>&%I5jP-#ZzF_IdQS;FTo3+VCVNKfX)I*tX#zilw~C|l!UZ2mRM4faCbO%jJ~Ev z#(&Nc3OaEOo)MBFmCW^B6Db%5$FCm&FJ&bI6eoI85f6%YS{tpAISQhS&n&PqQb)l{ zO#{V7z|A-zMu`MoToEHsXu`{auu7-uu=iQ=D--CoBHcT}ATvtyBjSkfGIPlnDT0-A zBuvrgS~(abEL|lN+w?rsKI=i#KD@MgINh%oJNM4NVru_2T7~5I2;Lt zl3*0a;k1-Cx+-mA^z2vCN%9{DIVrbRo=IV60OymkY(ZH(X+x2%wN3b+bj4U;iJ$gj z_bA?@E3BfiaNlJ&9Dj8|`8LqwX~qdMD*wvp-4?8p{92&to(p${;sWV#R=GMqX+lQ( zXHirKhBfb1ogPG`5ymP4h2>Kez)GgJ!wFuT#)dj{n%fTzNt+UjXFTb71s8no*l@$UZG}ASZykD9~QKuaCr4^22qKsO-0a zQn(9C;m_hbB6&sa~>Y=zZ zzJtIC_$>GF=;n&rdZi{KG_52*!yhflMU}Dh(GER|3NU&%1h$|@!@cl*QxKKZIBs|N z0U=RFfn76!WVxPSkOjdB8H(+i%y`r78H#F#$uY$+OzjCwg6{A^da}G$nYwmhyt?cu zpc7*_E{U#B3<2)2h*f{byznIE9@(RCXC#2R;Ye-Bb%aHg6qIt39SV;2>MHl03YBve zto(jci{cX*Dk=K)Be(q5F576mO{lgv%#Hk0T}mG|uhp}dm-%}b z2JPMSvWEwx^Znuco3cs4SE6J;c5w8%?=4?kAlXs;h|QCA89^z5=zIxe@0bKYs6EEP z=|+54W5TyX!vZa;HhnL(=Zr-&hoIYOnffE^I08|bi_IOw!mQ?MTcPM#S*C{>^}sG>`qI zan*z-O2d=hd|C2W_<@@8~MSpo)hj{ER+xd%o;qe{V;d<;d| zuMm9aE@VNeie$L=mdnFTTe3e^ZnU-ah8(LLX!@?k1)TvN%XSDa3Nu=g!Kf3*K|13j)N0q`wgXw(Nl02vqu5!X$ z^Y%vVLV#94{Grw;>)Z8ksK6iY~eRyh#j=U$S5etHXijR?r6xPZ;GIh6~7P8Skp>R^nM)FW}8)0ve z!9FtKGLXga*Hk|PckRn0RBfR97R;B}ql8Kf9bIuaX^-E3z3i>S|jK@!jKK1R#-0V~8pdWhH4UC4UM<7K9 zb4-SjNuSFh#A5`cvCyZM39+wK}>Xz2ZeEho6^!_%!;Quey1!PR*;-QP0hz4ew0^`*bs? z6f$O%NE8KJn1sq_8q;DgPEQ5frHu+RvyC)fIzGAj)5EQNx$OxBS#i`rvB}scqp;(M zERu_=DB?BOyBsL-n<@^hhy$$c#4LbhR{}LqeAg^WjAVM4-HHrmRSU^dft`K!s$sk* zP5re$mKco1*$bJJZ4h-H3y-v}T$UKg!z3RXayIFyga+zpI`ex@%^LE9MNqG&L%u3A zId+SSjhM$UHJ+$`->>QZJJ(H8N2sGk`_Qv;1@&4^UMW^`96ZgqJ4H~}dJ>@8VB}-S zUQA|Iu}CLegG{OTk9$F;hTG(A8hwko2&(x+RP!TxxKP!FvYv05e2>D6!xN68<{J+9 z4OCX)UY@X2PR)UwLz%cjKI%-lN{$5rTs<6n?kya202Q^o zWrZE$DXlDudSc#F{}WY|f+6HWzsZfcaJ|*4sPfS2c^>7TSRD+L1a9t&TcpGnfCZ%a zy0IqW{XJ(tcZWpE4N<6QIc9P~9&XiYA4>jq93zQs6zN=va67Z&@BL#}&=u_=2-q!f z!Tn?b{csCd7o1a*5=u7b`Lcvi^z9g&7B4=>3+qph7k{@S$K`ObZzz9f&Wohkap zo_Jj0bp|Xy~#eLHR)YCq}Ez+F8?fXe#x@9>VrV94nK<%b$3@Na(g* zdxB}o*^P$Z*LgmUU2lkzbH%|iAbZ#D34)S8*g>fQ33TtOxes6W7=vz3{Q(UVBi=L7 z-=)WkbUoY>R*~>~Mk;q*4}U^znje0dsIJi0czc=t8RyS1plr(C7z?;bTa;BKNUltI ztc)kBv(&=RPCh5Z@v{<=qmPMLp(QDPa8GLho*hOlxQ+fNneCTlk(pRI=`qIeH zz*jW_+HeJb2cPRXo7Li*^+1^)O0K5|(!k4~X08oxhms$lcO0K1!F@18Db13w&`h$3Fn_qGKP&^~-{ z|LlIOwXNEKveB#XxO8f@J{VqM|IxlUSH+mh7JpxG_Hi@j7f_kUdg_^+ibg`0^%-UZ zG;ri@CR6t=CZr!{-7zO9lHEv7-hC)Hig(@`TpOPly?N@9=C`X1SI?7e`NGWVj`*TY z&!74>OPjKJ-r_ zg9xvUIJVZL2C<@|w`Hj=f-St-IsR|wxQ{xiDA=Nt+5sBN-8Y2rA~P+OWm=ohH!WH{ zow|>hGbd;gA7pDlbentUj$jv5iio{XdfLB-{~XEfgx;SPYU$c|YTBR!&>c;YvuQ+N zP;P~ha3OZRazPcApexj;>X9_-ax{qQbG=0fJoh}$hOlsvf-hO4nJvxnbKMz+6dmbx z9yd%t3Sn_apraHY5I7#`UI$xmB&tHXSI@RXemraVCo^&%t|Yn#ABqIzShf=LVWE@1 z8b=@aTQH)$3W;V9j>YN&q~I96(gCpubA23;ehAu1GESnbIpag05Gk3+pDAMUUCoM8 z%>{G_)~N)Wl!IX7?l8=ImveujpQ4+TFB>U( zWh$#mpS;ci8b6SKDE~vdhwD*~06SR6GK9HEOb)J<;h&NR7^dO{=oGrp66ifRE;WYG>1HugEnU^)9fpT)jD5uT=$5vt0^El`~bhIM^ zG!;|<(TG2@ok=jOI_Bsz{%?PBQc&57bw8nUB^~=3!Z-@daRThgR2-%# zPrbA^7-{41pP|qHguWCE0`!i8)uY})l$zBKh@}8gM9l*Zx)af^CVpv6H|+yPnt9I# zS8*riYfhV~f{dyo!xzh%(Kp|*w=WGI&j*fzpQyIZz_@3mm4iZr$~m<5In~k&RL}wB z&un1_4%4_7Kb3Pj_DYsl@=jLjg8$p=_|wtrvwvCyXrJ8o5ow=15a^6?VED3-@*hY4 zi_AHdz#s3vpjZF8U;o4Xwd{q?p6IYs_|B64>a(V`A&rqn?rLyM_5Dtf-NY>U_Q^e; z9kh$O7J18Y(g*OeH8t}*$j|s(50X!}vOnEA521dz)2-YmtR^K%@BW)~3Fs?i+UQ^Z zX?>9c$d+hlMGrItj!ykg@Y$)^4~E~YFezeRxU3_Fy<$-3mMO8obzv)5^>Rmkpg7)+ z<~(a&2@j-wL#Y_21!rO+iuSn}6Ll=q{og)jPI5 zfc|0R?nzoLe8c@>?^;8BycjbHAE^rBa=_6H6}wQ1)O|O-N8|kmkUBZsS>g`yD*98N zTht&hcTZKjI4_lDJZ5xJR2nq<_oj^h)#TfkkYDc*a29GRXHP+V#>ug~pm>log1;Nz zlB;<^xq&oeS3*_Iiu-$MG%8_&9r`J*sQb;P$dMr0S#UC0r1g=JlCQ4wG($J?c2Cou zDB`Ijv%RK9i;ev>iL0medP~524UTxDit30(I{v;C{i&PcN_LXq2Ro2B@WTT+uhw^4 znekLqCDSbWMBxyuE|HR^pQVKO<2p8T3|=eiK6fmB=je$~+QbJceCRYq<$|NcX8-8)pAW$tW7dgee51;6CuRNnabOC)!3|qWDcl$oSo1Y+m994xp1R1V`FJ4O9 zNBhwc`&t*4I+m}GO3QdC?fUT&(A-0cG8<-vuUJQs8A9+wFIv`tW4-f^xkwW(}1t6d95m_$H8?ov<6R! z0^WW{J!%z3$81o>} zWBBX5^yfN*defL~D~QTEb3` zcFw=T0s5I$pZ6lGpZ6j=Hd8AwaKK6q;sh+k?La~Uo{j~+dhf~C-qKu`z#W3-=x`&0 zzQaoRZnEGRpQ)S`_T%}OEBKQ(EKM4)EAMck^CL4z-KD9o4=sV_Z0sB7R} znWTk?h(qHi2sn3Gx!q#@HsE*97Rab9;-u6tVq4*P+h4_mq8>gW^}rBZfPNvT5#|E3 zL$$S#7}?L$OtjA>6ol@CNyIM%Q2W&mR0Es+@85v zPOxwB909X|hXo%|WQ0VGbBiLz89F)v!Cvy>g->H)NGXH-R02YZl;84E+R)bzI=BMl z@05*k2QnW0EUuk)pwUenIdN;gPutugDH^AZW;FXBA$Nz-DJ1l42jhb;o#8W!#UBZE zhw-M!L4aC1K!>w(XI??fY&+XqIP+j2Oeq6!ZEn8nxxx(uOx@@DLW)CdP~_1?7iG7y zy*$eidhv$YnbIfJu6Gz{#!7#AsolzJf0?;l71)*#nm{IhOYZt&k3zTgrH7zTW>rc< z=Uu_gaItKC|Ks1SI2_M&WULJo2*@>layC0SZjvx43=osgiSG07t~}cp78zC6v;l9} z`L}ARr?+V+oA4L~E+^2?I-uVsR>;Qsg5C+)KU@0aZc`f{_CdJmln8&)Tq z2vv=av9h6tw?m@U^x?)8#tK&pMKx!euIYt$`+s)iOfEOS`4v_)x)mC%UZz}z5_jvD z{gMC+-m;i_|19tI1Pf@v^lwG{ob2mY!Y149m3UuG($pID)j5*w=U%+Crknp{No%_J z7vzes_`RNy2sVOirRs>N6;31W2CTndKxGAbH*=k5cuN8w%Wh3=_>w_C8+2vn=T;@1QU70mwo0a zOQMH%cVqJG0G~54RsA)L=GlhfiYf98@!~lAQi6sKh@h9I$sb2F5mxX0Nvxi;xYP^C zh)|FX&m5bk37jGu6L}l8xjk{Pxa$soo^fu zJm1fx?hakDsm!`=Cw*8m_#MW>@dKAXAsxxuzfxN~?!)OQn;qS?(e|83 zwcKYjpRYjs)aZ+Y*fkC%R8$#5wqHU_!hVG3>>@iM2wyUX$3zCi1pGB8`I`-Yv8Hv1 zv%`IYlI@)AE(%Hra7mp>kVS!0;-A5&in<0ab<9LZ8rk$UPlNdEk*;%s^<&Z6zF~8b zD+Q2}B9ozzuvDU5q3x=#GRt8)gyGW&AZYhxzK^i>F^Uwg-u(YdBVk zd$ySF>!6Q@jDCp+Dni*^V-40q5^h2UlP;8OF#{2+w`mOq4Cbc#=1?OO8-t-w)WGgB z#==GtTZ8FPE<^Asog-p%@r4x_!9iIuygiCQLPx#Nnc&EPHwjq-hW^ zhg|QKSv^wK+>eEwwSc;ofG|7;PpZDVn{%6djTC{S{A!MqtGt9;h$Lr_V?Lpa-I=@) z`5nvqYlk>1Z_)7@t;xnHYqb{_1tO)1gc!bHekAWa z#oCKkW#B1g6<0!uQpB1#zpPE0g1xC?M7^b)4Un9mMHTj@Y)S1e!nuqwNP>LN5d>rs*+71rgqa44jC1ehMI|NG-1!bb*_}Y zk>L8o1b-{?QK3@K&6tLrs+FV0H1dCLkd;1*0b+kPj=BRSM}fiefA?}ncTT>t)R&{J z#2Br`Jdmu#ycOJA`H1utz3%1G?nTO-7C3Rw`z`gAff~iXTuC7uFTNJsp7`{B2Hfh% z=^+d;<<<|}oLTN39Wp(Gj?ckHhQI}|H6|w$>uCuX4Z40cfc<@)5|Kvzw#Cbkl|Uf} z#88O|DxO~ETOWC!M#^0qB7M#6--F(*m3tHlouGW!{Q=UTH};dyOPWdxnI=<##6f~eXpD6?pRSok@%bta@%&R=W=+l!@BQ7R-$Ia+(_GPN`>8;0hM9U=uEZzlO1rtWP4XU6`T&JuM zjb{>TNtYM)Ref4LrARK&i}-z2;A;#@+_&~-LS0oSwvRowc7v;zfB{5pWJ;2xwMsIQw60C*p01QulKba zwXHr{&d-+{v)Wr8PPv`N9x9%aPFw;cZy+kNDF#Gj64u5P+(+M-nMl1Rd?E9^1g2uDm z9b}1Jm2F_yK38u;XB;+sGIr;PtyfqCtE4)806BAR21F%CSW~r5A35@g`j@f;-xD(A zTH>T_8DI;8B zB#?}IJ0PVN$5C9?&M^yPU(NYu=s)n)q%Yv|sR&`kc3t2Z{qC|;^;9Nnr1eJ@Y0Ei; zgSc6q0vSH_ccmUa_P?hdKKBRXprpwG$86Z%B$=J zAWewjiNxuD4_8DyR9MF3YECh}=Un2iB>kbzDVB&a9P741v@GU_IZ}k69nPcdIYcfV z{As2?(3Zg92Y3ANC5&r>7o2Y6_baTjLYEt|@6`s5`V}K(BGvaCfBGTE%hV7hqKiyF zj0-?%0GhUVlUK{ULCmb$wGn~dqo|WgB zY)Oi^OJXtT{LX^>Rj7G%CmRPbJXQLi1E|z|A&tMa#^Y~Oi2Y@}HDXcFT?%Rl6=>y) zt++;|T4kBH@5%QOkkL^oq$%dg@b=NYH-Aa%x7BXZv=-#WQY+HtGOzFNl0Ov!rOc~y z@eSa@C5k)BB9N_$ax?CYohrwx@h5n~B#L>;{9}?|OHl0V=>xK~`C;I~P)}%VMaBmM!TM+!J0sp+I+%XtFgOxv7 zmnHG1^^~yfVI{R>5vcySFhb^BIwBp2T_-6iTVJosp!{n!t)|a8qX30{mUk8!mxL%> z#zOFiq_w-Hq-wl;mxx7noHk6mP+NU>5o}mixn$ZgwH} zu)NpYl`({E{qf8p1Sa^*>30wt1W9wljYxZyr;}8sl@w!9`K`pQe$hJCuVGnhVElV+ z7*F>aPbZn62;V_(VT)i-P`nB*VQ0~C<7bCOLCn`*q_onJxKcl=!$)2YA)zeKG<9&7 zbFVadW2v>2%b}Ik<^6Pz29R!?9O+CKAN%Fugm*eA&tjq#zu#rhdnxYG&W!Vdwx)rsr}KGd@2h{1ytgHOUk@Jd?bL`_+I`x zi7NR;bHel|h#qz@P`Ny(7-1fVE-8H+yzQ3lO?n)vQPb%{dk=D7zh2kef}I*yM#_4h zJo#~!eF6AfudWwOUI_TOUpYVC-`Y_&sA-cfc(eVKJdmg34A;r5oH6dZ7bYtnf=loSmP5dmHg z_viCNOYc|XK#qH%{!iVmA;lss-&-3Hc zZj4@M)aYcX+1p`uc4l^m$ICa0w+FXGoCCA$bDy7X0BBbd?uS!S@P3Tu?xNu=P`mW} ztp<46e!g9=y7+YM_M@Uo@9l_vvZ_<#{q{|-GquU!!}R059&o}Pbl|C|TJ-q(_EE%? z{c*`ydHL3LJW|v~q{sI*d%3Q6I9t!}eShuI67)XV*0w1~^u8(I>GitbwfXkAKj|j; z;l(7Foh{JPCG~NCwJUhu@IeSX9lgs70`Y?Ht!o7zyR-2`=RRIHCzE>bheMkmtLtrD zAGZ{y{iq8URc~&BuP5{ChfNN%;;D8+`<*kZF@hlhkJ+CNwPo`=%(g$7Jxy+IzFqDY zy$HUYH8b_q2EUK2>Ini*kMExzaU~1teHbISKE+>UBLR+&u6S~X77>DvO>MxWo^Dqg z*Nu4`_MQ^?`;C(EhwHN3to=u_+d>Kx$BrOTW4>3 zt#=#KSo?Vx%QB<*jv$kG(zd-6VbgWF?xtf~yXVdR#MoiB!23ISp@nwHWLJ9&@E37Y zeE;ReI2@X4lgc4r?ITri{UaGs5tJAhn0i;F6q{}MixGZcHLa&muN|RVRx~)JH*#n3 zkw0FCT_*^|_uXlBQh%#jj20ril4+t8WGpb_@bU34PJPcV?uxGE9<)#59t7@IN z+a)iSUI3Hr2hK@Li}&|ntB8NZb$o60MZO)l=MIcP)R?evtak6OP|!WA@8D~^2t_bo$evC_J0_A z?|7`+@P8OZk&NuJ60%ZUDI=q@;tCfk70NED5E|k`NJdtK5GA_^Nmk0p3>8VpO4(Y- zevb2VU8?*0{r#Tj`S0$0ouBhO#`~D(aov``?Adcdz=H@kar%#25j92(m?kIT8;iTVT!hW#TeT)_Z%%(VQBf*(8oc0+t)2s?{4NkFg?~;D=wF_ysbB4pPd}R zPCG@9RA^Q7BzKjB=-0Cctw%rCT+kn5j8yW+ zz7;g&ynHth5n*@wmfcVQKg+hxd#zK=3ppL{`kYITH1M9!Ut@gb#5FO~J6H$7^YvZ+ z=#AW8XAO#%Hb}^w?~WE^h!%B!1-l0fS8XwU+F@k>$>l%?p~SDdeQen2K*t4cuLhIp zhZi;L?{-)>|CV#VV){11?p%IaYpKHRNag&xyYu6B8nzemM@K6AH@NUL+;!ET4a!*- zZ`f7R@e^$~oNhcj9jvU&hq3tS?shlqAQ(>bo=b&Or7kA5<{dmY{UFco!B}kP7&XV9 z?c(mDfA-A69&6^vz}%hrUp=>EW7F)eamp9sl#{L{aNW#xJZ;+?S%3FFXY_dS8spxG z_sX|om5n6a1CIe4Na7uYI~|0SytMS{6o&%W@dAuA9c(*I%or0Nc|X`{%bb2vO59x& zzl}7_%kS(O;=^G2w%E=ke`}O7n@uy?@mywS4#&I=bxUmr4)%&i zDQj$-u|X8&J{aTa8arUqtln{9ZSY^h?euK)New25B8*QLBtUTgVm!@W@XP`9(i@Ry zw<90l64bEET@4W6-nH(L0yZ6BF@+*7<&3e|)7^ynth?D4l_Qn6;v^eQ^Lh%k zDlkcK>(<}B6^HhSyT76wqK6ALbxdI)tSHzNp`x)gVn&@xO?Og2`|G6w8uO@+jAKjnl(F0nhw_AVs;`@^a zLCUxYQ>6Dkc{uU#lRaP#ox-4$jSz{Wwu?*HS~F|wt7!bMy*>4Yiy z{JUk+y{oDBpEKUh^A{4H{d39ViQEJ&@)tUG`prCN#HO@oND}UDmwE_%=TeKg7y_TYKes&sJ(zl!zg~iZarN5uZ`u?owNHE58RwHJGUal zgqQd?E3Ra~jjs7Wfa&Df^AD+!%9Il*T6n9lyO3~+`O(mcP_BY!kxg&!=F=Hq5?2gO znR~=JRQ87l>5ogdg}v>2VELTww0sIpdVTfjI5pudX_0%+`8&#|?1P02m)P5x?Xu1~ z3ZLER{f#7UWSYk7q@B*V(kX5e-YL$jm$4)B$NLO5CT&eCoy(uy*1?`Iw5JC4xD&;1 zb%pdf>i8K(1sM%1ZaZ`yQ%W&)F1cPQ&OtmRt(WriiE-I@WM17kFH@Sa{GlTGsEK!m zQ%{Y?sGXI+q#3KxzSPz)(DzSNa&=Xgy+eAU;;eL|lG>}~orLac-_udSBl`sfSG^n; zqATCZHg`z+$O+j@HXpA=HQNOCo%iF7ZbtolqN6!=k424R@z9smCj`SWXFa*Y6&cpX z0!-A#4PV^Y{a3Nv8&&ap*KunD>s;8{B!;w!BPXc2jiq&?jpRjki*wv#4x-9*92r_q zYZ>OqkoIJ&$d+ICSk*Z6#)Io^*d3XhZoOrl`-VPr(;Sp#cud!4EX!d1?X#BVwb4@> z8L|YOro@vYBU=0qsOeoB#q2jS9=`X zJ5Gg1_ZG)p6NV>Z{u>NsXIl?^{=%tX1Z(860^sZttxScVRoYkHqa2re+22GVN14*@yO4WJr57-3nv3Z|fv5xCeGAX6{(OK~Fr{ zH+2VcVrGFUI=Gv@pBMC*XEzQSzrNAg%TMBbjq%!b0J{%oKFelOvCe%} zA#sY{lVUWBp*5_IDGrt}@bxvS7u&pz(JY?(bdoE-1nv?0yJc#zytAKXtWM`J^-eQdJEVg{NAi5UO z&WN)gKdgId+bO@LH1=?A(akc9fM zw)j~K9+Jmgc@BM88z7Ssyg{Ops*1LFE|PTn!<|(GMs?d5-$pfA=Rjp0>12j2n`Kg; zgltf(r20(jtixl|Ok~&FS8gP>01vX&}>c zNba-R`a_>=Tg79r!7X%6+?cJ_Q^9Q{op&YpQ#^EX*A*$@6P@1u9b(eRD3Z{ z)GADYQQbM_V<;;v>G`OsKpyW{YyfYgh2Wk2SGltmKajYZKm`+7o7cFcI~UC%c&(A( z)B`>3<)gc=Nc4|3i=Kb7Zd9$hKkGCC)z}V}4vP(WtLl2|n5!!?5=ccCJk&47Fy##L zzcPO3A8(m>%k@r!n9v^L*2O!%smz!{wfWZQRE63~wMhSAFP*F0@3MohSuPD2>}UD~ z1b3+(&~&}WpB}R;+8XAgY+NLNR{!p;;B1v?<)Wg*RVs|?S7Y?@+S~oECRr|RBJF3I zGZ>Uj1v)>hk(jP6yzkuW?_JCM?f@WcQLUPP*4&tBX$Q-qg<`47^TtK#1#A_E`{y{4 z0#%jT>KmlBEW$oKwAHs?Pw0FRWLZTLe6_0orvw!}|uyz)`r8elG&`!kMNM$b2JLbNuW{+~~X`K!Pjntw5XKtt8Ac)WvzwYr`s5 z5zWmyVT`sEuA{hbNXYOrSt)m=A-ed7Ki7MU&zA|;YV8W!L!#x~IB)ma(i_9!`w(5G1Rir4ObeP>#0 z>WPSP?6QDH^?lWP>(-b7B0|^9oOY_dxZ$i`woFZIy0gL)%U?|@+ID5|Zgm#bR8FtX`FJYsE|-8Jja?DNTE!8&E38>t1I_>at1IB?lr z3)H|Ok80giXi|@Ah@qnGvVrj4PXwP4$Qb_ac{HG)lfLTITOIoH{)lKAgI~ z*2R$qCs9qc{Z(Dj!8AOk9{t1*dKg*EaGlr-QkaqD?UG4zTs{!1#00g&jQVev{4YV< z7>5vKIDsHn_S#x;n@A;s4EZXs5_vWVcg`zEq)StHz*PsqC}rezFwG%(*U@xdJImEx zRT$3skjjdDS*bQazK|J2*jo*N#xJ5#6Z#(#g|J56a&>Dv88-jr`I90Ci1VaoRQY`I z|4j?kkn;c{F!0ue?a>3oV5%_rnw}5862ic_O?@k-;O}2OY~J@P=l2Z)>rbs$PriB> zFP3!j3_efzf5m`_yemPXCiX_J@qNb!mhMv}Wbstz1Th|cTyH}Z!IHfMsV@j9uw~zp z^voTMr!m^)IZzjq865vsvEG#|$3iO!fGVEx=w;`!Y@SOrtctyH=+#ur^UOmh_T1b$ zAI+t&s_HSjP#FEyWLI5_(WXNe-YrkvGcom24b*4|o#%Zlw?(G-k1H&EJbJN;B zrQJwoNlW^XIIt1cBmik%YP^1m)y>*PJW-XTDism+ST%laI>-lpu0LVLq(vGWk74-i zZT&eiNMm7FU3k&>1ef1siXuuQ*K28 zC}pG|_*JBA{WY^~*}WZu8(8Jp zzRE{R=%Fw-dp$?SKN(U<5@G>tCF(qxSgy1P5|E$8oO$Yj)AkR}_-9U2BFQXT_w>FK zj36t+_2hK5yiA`J*2I&?zSuBn$!rJ_nv<*&w^(cyf0WGR&})ZUlRqvmglNW{jam@hWiyw$+n2{q&C2j_uuR8eU_;(} zS~CkL;Xf|g3cZ+CNQ)%-_cL34%n!-L3WFhq%_w{R`ze)mB={E189dyu3Y^rwDGoN5 z&-(g&#<8g{ZCbp3KA-iF?`nYPwvSh1ew`mOrr!qI=ZL5IT%Vnco@YmTkgfM9mQ;Bj zaRKV3F#luN)HKwAioYyRJo=rAJR;e&Uj|EH7nNqZV*`F`8=NB!d$bDi(6%x_Pv3k9x^Xi`6^0OPKCh}KsBFv$A!Twgr7D>gtJ*>RD6rz?Bi(8xQ*dbz9B zTJ6qY_61Ky(~nI}BR8gxU99#WGt~1YIE6G%79g}R`KyE1?_WJ z9c6Yy+2*g+YcsJWWM2Y&PGI}a+7M3>;qFNzufxBu=b(FkOpgfgzXu@}ga9LPq=`oL zs}6GL^L(-m8=;Sln6xkwr0e760(HHY8Cn>YhqHf+Ii4emCx3Cv$vIr+k@$9AtWZ(` z3=vOrfV{G~Un=$EIy_J7J)bCZarJ8wE-zDI;ARZv z$z3_mAsZ8FsuINWjC!&5Iyw9+$ZTol5$bL5s{`cOd{&ZeJed@w(vJ7v3oQne-l}$! zKZ2$cgCqM+DA%1qIpoCePr4R~XZcaCDEA7S)xU@xM9Dbb7$IkhD<8lSj)`PTfSkJ2 zm7D?rFnFQ{h(rx(z0Ulvs7E4zfDG42 zy}=TPa%}!(8Kdw#77E_Kuzk&`8$TT*km!iDv5pk-ox#WAc`Y)_|0ei%pdyf0y|Yz#zw$`_?P?{2LK4$o;>?fQjrS!0T*B1%OS5oCk-HBxiQU5b!2#@rw{ zDeA7268KG!a=Egz2oH@|VUZ93>?~<^R?U(R0?D9EGlptCD+Faku2lB(S*d!QaZ?YJ z%)f})U}vd(b!L7p-USkPpuy!5_Sp237OGb8>J678PN@}wyC#4D5UB?)2dcM(ST9Sw zgVQvHlOI5j8_sm2I{7d%9VS|j{;WJ9Q;&}JTl?l9Pb_e>0W$Mb;9wlK9)ZuOF}41y zA1M{e(mOL;`{TEky|8lV4j@FJfby@57fBG+DAeB=@t0}aeGr@tUcJW$06@2{m=7)= z!1VC94UqQ1dj zdODd5ZsT-Lb3$wkxr7{#MHK)Fk(QJ#?j9>>r!4SjK>nay8se!$p(I#{M*-?8r5U5i zWZQls4oYXx>zA2foU~xb=P(xG7vfH$yJik%E8z9^-&&S@?4Mfp4kCo?G+d^@qd~L5 z&XVpA{uBvLzjNIS-jOd~DT$q?Q1=DxQ%ASeLW;0BbTbt+LIKH|~JNEP5nVSg#k^aAo+;~rpv)ZjP4 zL67S+t@tX#DO*i%iRZ4?cE*{i_H~ni$?GSQaHy{^ytk^7W655SpRcrd4#p12`eZ2mJ9Ps2fQQ)^kS~ zSvw)Uf270})#a=Hl*=aaa$i%vAlHH-1_}qcLt#$;lH-zykpqn@JD7PzYz)+=4+3TI znl*-cJ?l)y*c7FeL1ycp!uwxQqn-o;-AduT*{;HaqMZ18MR4WhZVcqGa7{8Qye;Vt znR-CdkNsr|@3@oCfpCRl2>QxYljHsV8HLE$|7qHyO;x8O$#DeQdAOn};-Rw&jHibX zhMU0*xy}!ShSL8D;21fwylG1#KnYI96LcG>L#|Oma4?Nm)$C4fl8CF1l)>@`8H@lG*X4F zrGygb6_FJO5cwA&WMAQvW;|Px6Z8*DlqlUy{0vaQRVhfe{ba+QFEP*oQ{hudINtp8 zR&czbW(R={Sp|-E4DSuS**t(p(G`5*-k$E;@;7b6AbYq7XwZ$ci48 z{x!KhDL4vI>*qh*Li-ArM!VijK5Cm07!=sZ{*?>$vuJoQ1t{Bpby8F_iZ`JsK_0|$ zBWpX^;|9&QmW4v>wWZSbr3f;Ji3jjQ;e+CrDYrQ%;_7ip?4JSrKoCRHrbO4VaJ_7@ zL&E!M7^O`K4&iU-X<;{6`knL0GsDwN5(lMwW~;V;%x)#ZKy$rJWrd(BMu}yL4@G@? zujC||6xT>)LO8D18AsNvWAy#{mVkzLQQJ}Y<8dg8?J zWbk`|nevGo~q5|Fpm18+OQE%;3oo*mgS zAm^!3EKkAb$53JrGNIheFf!D*6;YQi;-B)T|7#O@X5pB#NgxV9W2m7dJMt}IE=x3p zvgzEjaLAdJqGCz9hzClO7$-Q2q$5H*_du-u7d5H+_cNI}c% z|GWeI{#i?DKf;^ExlHsNOd?Ch)|g2*m+F9}Y7XS{tI}?yI3|9>=|hg6Mv4}p`sN9o zmPbb3%8<~bV($|9CIGPE)G>%@3H3G@e$Z`8)$Mp;fD1=D*=sjS;?xkqydm~=7UG$v zs1!UYj=HTBNuaFLD@70z-g9gh@GZ!1-3Gs<6a_W2Yb#A@z%zZyDJyKFAWXIOg}9}- z=|DRY1csX-POxHpOSyRh=waPAQ3@)=lQn;iTtSDI@{!r-|C$Q*gM~O}@4+gl!n|>* zH>A^q4J~^xl%n{Fx)?li&k_Q7Z(CA-BBLA!MhN;$@BrAa7=Q_ijNb+9UYL6S$eD*| z?S)|&8DY_+7jeiB;>nmlTS|NLJ9Jb8`6zh}DL;w?qQ3$+|B=aGbbOYT@J}%bG)3VD zbx<;D}(FE3{|}yioGcmIiQR6m6upK|c47ltrZc&XO%II%_*(0TqD| zUjB;?)N{IRDgMKaxCU41LKnPCk?-a<>KI*xdj$M3)JvFxXass3^XGA?W5_c2%+H(V z{08%;MP35$x>TX|TnfNmZIQvS&s;B=sXjBXg1@ADDPdO%4?J>~4_`G7^=82b2 zlXJ1N$eWK9e;@tk_TcT|^gC`(!s~Z?(q1O;PV1|^FdBPvX?~&O{PsjuclXnm+|9Dg zw+bK{XD;m0%3b^G5tE0DXTZC=ISYol+{n?Bq-fj^>WPSq#=>9a@K#%H4#cXZt7xIJ0T>e`;4`W{teO;` zg%h94Qf;YPT3NPm`>$>^*n`Y&tkZ?tjKhz^Q)`F`)mf-_&4ygGsu1D@zH&1D~4&Jn)$W`aNbZ0jSXF zvFbX>r?{8-B~%(p`KElpZ4_x;a}aF6LL5FrZ5pL09PoypU%QP;KVE~^Xn0UW-!QKW z)TOvc$Q6Qxq^hMK`_tm?2+|V#80^nEu)~!dKUZocN=hfM)y-WuW&gpm>jXTN#-BuQ=PnWc7L1_hl z?@RL$IpVqTX<*1(4{j{SzxlhxO*2K-UPP+;`BS{i#KV$3Ujb*JUoaG8sIEjpHRM4n z_?s;r&6?7UH6KBGpx0TZf=dEiJfs<@D#mM3iio2gv(H=jq%Nt5@W^9icMcf>8hcqu zJn-;}9vCSWiED=A5?k&z5psN4p&0c{kfnn&z^5~ATb>X`9(cve(40rWK<4?>sDme} z0j!bYPw?CznuPsv^e$Bua-NT91>cl~Wa7^+D7b?6$7!KCAoL2VMF{o2DJEtE?ROw_ zLgRZy#5jGx7D5hwIqsRZp`jTR>lEpRnurf^ng2J?`KDk1tjE{z^nk#I>k>U)k*|h4 zX$1kafPi2{hZ?i8@U>l6zPMAYX(2vcsq5PS zL9jRSF?$w-C8Ur~<{lLIVr2Xt``nM%!?Qj-+|eW8;fYp#LaYf=51!fl4IUaMfnZLO zxZ_hIuqGZopsbI71g`_Lk=HDpczY-sNwnspmEA}V_&6G%B%_3FB?6Yq>7|Zovfj4D zxBVqNOt}9=@I!cA0z>ShNU!k7iT@iy@Q?=yh`g`xC^@}=VEP&*PS71-7~()F03M`q z3wucBbb8JiGYR}xZxoURR+2BN-71e_>OH`RqtJUn{S32|@k!=-d!a$B#-n&_~ME-Ouzj#9C2>ZA`tbzysGAz^?GDjT# zi3?;nEs4QAj+DlNkpFWwTuX0b=}RP!Qf*kgkcdO(s)4_CaCj-4oK zb^mib^bK}`5Dw$Cf;UJZu%X6tipd}KVok&kW_1w6!Pq_J6`cXE-bNLMAM~>2ApQO^ zeOY3~sYybnkFL_s3qh_JpNGJOH-CVP905F0T1&-c9k~)~v#tLE6UjW16a?=CkJ)qA z>03!mB16TTM*(sl136*OJiCS}D?wYeD_@?*iT_(1{NihcTk+SS-oXX$oez@I6oS$?Xnk zoRo#1LH!?iT{?(&j>tnjFuP`FskGz6_Hupblt`x2SXtT`pUXM_&LrTyHi!;h%Fr|k zxca6lx7%gUrJJf4GPz+K%y8&IlssD;>H(v+Bi>EN7cewSa?j)!xlQ!2D)s|v9is-= z|KenYa6}MlT7hQ@A>=|!mkpmC!OKV(QCLD$ONNE1`2yu>17NyqW` zj3?crTfmwwcuX`_9e%;uJ(`YQJejxSlS&}W`t+OfY@HvUhoVS{ zJRDKfwUaIN$c$sF@y&25J#v(Cj392MjDw`g;fr zhVC99RNV9@K%vmBh$cZ32_8+L<0$kv{zs+Mb6eZLz#i=UCi%S;^%y39tY2RE7al7a9zznD@LWg`u8z%GY#5KPxtu_od72zWWTc~ zECYf|#C1?=%IOdSYvr2ezun-S+thDV#k?(2=_6Jpbbi0>Zwwu4ne!JeB+8DkNaAmQ zt>q;N^AmBVIAVY7p**>Pns>f-678?r){VCsF?hHuuj7bKD4x^6p=93{cR?T!8lBbD zBk?f*prk%Er~)1Ujw{n2&$b3iR5kiW)Rwtdrexh3IJ^MAg#~clzUMM!gJ%S&&xakl!Lo>)kx5}gjGGNR`_G=wfs3JC z9`Lpt9{_L5Mhq+OlUth9$M)65j4%Y?4RHj3s;B&9HppDKCuU^n#|L~^bGC-vdPi!~ zj|9`)#P|!8qrP}Bv;;biOdG&^(ucSHS=%9K!2BQd2%*Xbk;u_2tPHf_)vY)}$X zUQszFzdEDY14mI91Bd@;wfNbqco5zZE@|kX8eg_}?gM&8Kt9uHkF@9PHoOl)_VnNk zzVCtuV>C&5b?cFZTAl7Rco5)sC=bR?bJ^Wr>K;GuSt1#WTS9g+iU7~%44{`i$^zW9Hi3N&H0y1fa1L<`EAgj6R! z;P<{=Hz^hbho42S85kOuz@G*jM`SZ$w(Q7Nm@Q)~b)G8u1amTu_Ry>IV5btEmgm?; z9#GQD{@vvav%_#pSwRk|PWV-c8slh=^0itE@?1*eC?fO@kT&1=t@0oO zYt5z4iF{>y+%U3#-K)xqqXVDVhU`I|#ij~IOTdQI%u}P&ST^Ioa*$`+`y+f*hk#51 zkwxRKPSE+J<;@ts!A{5kvn2u^)ed;$ZUXiBQKwtzn<-^D3U8^vN0&9py+!;D4}%>$ zoM8uf-!QmGz8qs`4u&YXuiSd(Dd9$Pj~4+euC-C zYfX@fAL|UxL~m?1t@paWj69mX3nAjNdm{h+IoRAZMS@o;j>aEdF>e*^&k{1x&=Niz zu)X)j#Mjek0C-d^0(;X{vm}-u!tm4+jlJMz#cw1}uuv-Mcc(?ONNC3Pyb_-HPt$~G zn|d76dURH^EweBIq8#ew3#n96m+Si>qt%B@ElF3++?w`-ce-*8oevRr zMtHlrEb=u{R!5$#VB~BXJ|6KMJD6}LP1PfyT=4FN(07xg0%sBrZ#&-)4gN2eA{Q5+ z?cZbmO5_w5VR>&yhsc2(-a1!Ft1hZ_eu;F}ymxM@lh(y@m4!OI&k@X!(=J#C?xwEuz$MOE=x$SZlhOKRuveZhdC&qnK9^X7MPan26-tYnan1%7; z;=42}uXAkq*#QkI9)UZ(m4h?Ol~Tw{pBiA7nf8XB=F@f^a!b>T3a)W6t_c>Op#*h3 zG_a^})w zET^X#a*FGBUeIZf#&2p8^EzUTTDXk5q{6zlY1@NhId8*2$*Y`V=iQsoKop`U6tDU@ z_;Nqc>ymaWG<2P}fg;&q;E37!1T;Pa!ob>kYVaQa1kY{D+Q}14sLyj}K9aDcdhp#Y6DGSR9h&3002@L(`7Ks^wEQ&@zndQAL$C zqlyR2ik43^>dHW2Et~0=0@LB&&on<~-!BdG*tEYGHlmIfPm~2F?p9&wu+m3RO3p)F zqNv87vGaJjluh|45tZL>D)Fc=<*%8 zG>*8b9$xH4zk#wi^LS|c7bWa^3dkXs9?JS&b|fn0N<&6$)`LiHKWnv(i`v2#@7=lQ zaeCnSs=KQ3F}sq5_|t~x17AHD@a~axvMiK}^@H!C@#$~8uY$z-v~WSJ6$;H8DbEa; zJUvGn@Gp0v3KqSd%X#87!DqoVy{l0njZ=vMnHkotN2l5+7m|M5JmG#lh1(eo0U#0K zZv=KGft$;fIG|j9A^t-0>OlKl3-Rlw@t>I6At#6K2bm9i7@cY>dLJpN_*c;6_SXMd z6C%mSFcSueznXeavTHlh10&8W5`^S(o$lW11rBq-{?KF+^eNarRHo0($Gl}-chQeb z3+gaUPk>7quZhhR6IIW=2d8E<8kAO8L$Dg(fxpC!DDvg z#@%E=+f3;G=ilhJXjJlhn?XRz1Sc@>(>f-B<8QHpON;SOJwt_1zh7cb14dV*swE!# zlcw6cwo3Vxk!9&Q|Es-WeQKf%7;d_Wa@s_rIvGs-@J!?L70ep!Q^+4ii>+I)%-)|? zPL-gvl7KA^wmYe#n@7`e1C=ZtVY=%;>}#yLQp7RsPQ(tOf*9I)xQ1ktg%Oc@!|BCm z7CsWBs>9IF5UBLRj1)7^H508(0{OHz6j+A;Y1HRk@OTj?mX;S{4}BejS;GT4 zC-RYj-s0JXdK`!E8xme57BNG&b5!gfy=7v^G?{On0DIXgRbAX*euAQJ9EfQ8pF%bT zLDO@`05Q`ozoX#73d4uUQeKPIi@DqOtMC6+{u30z@u89lx0G{su(n#SZ)_F>%IC#~ zdQhgC;3oJku@%sY^R!hM8eo4RlDryR54Ta3;WG*w{l=c5=(z@eegLD>GYKqy``I(K z5Yaqpi_0ScJSxNS_@_{^JVZqiPF3pxqSHtFSwBnH0Qj{Rf(>b_O!etAe9*M3(2o6S zh;yrv;IttPdzAmxpz%as0W!1bB6x29FTd|e$fIP<+|Yf8!|cB2-bnrOf_5#F!21V( zT(|-%*<2o)0S%wj^PYxnF?V=e(GpkM4C?qozX|ZZ1^i5re3>2kAx}cAV@ZS-Zsb>* z;fFjJbh7#!jsICOQf&XKSQLW0&R=)&_g0ixw+gt%v#)c)KSEpFL_+`B;*#AwuES4u zddldf7m^$6)^M_?Krg+K_+TiaWVRboOQ%P#3o$+fqqt}=U^IleatQ8{(s2J`RyPom za_JQbScnQ%%vzctk5J09)rjNMocM2pW*%)HAo5a$r4L+=AZ>%%HcKwHAw8Jj1U(J( zTa;5oASix9Ubd+!tRZbXkL%&ZMdSlZun4VJvAD;BrEW0J(a(x#6B;MUADKjay#D8$ zUIjnPf{VSj#;;=Kp~gfLocJ_jaJ@X+8YgnBe2V>?~_h6TK<3yvf5L3X14FGz)aNkH{;StS^9mLj~o3O+ZQ*de{by2E$P2 zKO{pM@b3!kYWj`j9N9^f2^vW&bEy=rdTPj{Zg}$wSfCQbND0~$iQOeclX&dc7U zvV+3;UluSByWGLOgE`-DvG?FZvEPQ->?+JxzR7F9czDs3xEJ!%kYEBH&|x-dXKJg! zAmEg;l8Jr**0y;-RswKP6>HK1E(vA_O%z;v=Jek0S4FKf2D|=K&{a94*R4p|$Bzk>e0v}NM8i`7w(OP*nNH1_*+OntH6Uo<5g^4Zr zkx>Bya_B4k2fsMIuAecSU;r+tmqIX46zGmhJJRT=Rss3vN_;$k5)|-ptw1nb0RW;U z*LlQE6d=1dKHv~)mCoS(M2;yfJ~;I&BtPh;CGY|`8sDM1>Lf9o&^J_wPQg&HM>kLlyJvClhQ?+o1Z+ubtvmz1 zF+RXYo-GS?T#*q$V8$(kp;;6MP40-o1;i-!52p`{L%==%{Vq|(eD~nQCu~ z6D;tfS5a-K)`%oa%wz5xU>18$KN(a+A1fv%_mg8_w+ zhjXJB#SNg^p>Rf)bA3i=K| z3_-*{c|f+a4#BsdD1}@Px%rw`219J{Z+Uoc_`W1o=pXTS2mJmSRq$lL^V)+9`G;4U z;H^lOVTDb3wL^Ml|LQmqCNg7rtSl$p!2g_hP8X96tmLDWWko+l7fd&H&`mtc-sSRw*7kFgl9H|W zj+YwMH|L2xtEUaKjUInqypOLqWz4xNBXgsip2siQr!yR!BQ4ve^=6N9Zp*8u?Rr~c z%Bkt|IY7}RXwgWtGSi;jQlKn&T)7%9%F{M@-YV6xKe7Y200vxzU!VSG4|-?a_6*-)DcSs%DND=H*MRGBUpW%*^wsT*I+b z3{qbwze`+>vGGbs&ux=B(YuJKPkmej6};_pAN|hrpupWj|AI z#d=xGBMuXHa}XbIBsuRLxjM46)U~f@q$Ka?ZEC4{TANrFDFc72pt2)ww{2M955Mll zFsXgHY9L_(Pqxv+%qD$}dKW~A6EXh(()2)?TRQd@FJt})MO z`#D!LIz<=VE?2FdZH0aOTf(I|H=7~8^t_y(#{tEoviHrT_Lcl@J^L(0>Vnoi}cCG^3Lb@+jghSoG|9`j{(G6~larn(`w2k79J%LC#t3!P|a; zRD+Jk+3+mfuYbosU^BWHnmca86Zwzf?d(_|?g7^*cFmnt2PE$Kn)aGYg#w&jE z&9qyGREe7Gm2=_^pNeZfR9Lrasg25B{F3|`!@nMvc@Ef44{lB@FK6p23XNDUk{&He zkt$i>ovBgU>-t;xWMcH|ymdR02RQ|~=7p+)hiMg^gBpVyqUSsB%+S2XuPbVEJ-RNA zv@BN2+|ZP_PCohT?L1;FkIjBp`KKR#+RSio{}z1rczs@jenL<4*>#DqvtAa%rUz(R zhTt-`YnmNHrZ@d$u^!xT0$&NS-vqmO54MeOjKK?U~pf+G+cF zd0XMTa?j7d$2ZA%$&K`27j?_AS^nI^%kF$@Uh}2Tc=j~^ULNh)r&_HL19XT8yj0}e zdlCS5wf2K_f}~TK`=MQ3<-(RVLcGEH-63X*CjGnp3HCL=Xx_ehZt6)|_Ef&cq!nGu zcf#|c{QirPW;*rJ*~w}(Zn@))p6ly=^Vvk-|KUv28~WxDUuVh%EW#6$_qh~lR$m`| z_dOLX`9yg7$ZxqEX~v*SZJiV{{`SCu_KqVqm1e~L%ToL50OzGVN#=4wA75t$50iGC z8s3`D*!q3QQuR)vecyR!^=T8|Xp)=UqYu(4cY1`IhWKrKI5C>nYH+l132$YYM_nz8 zfX%AISbiA6paydjZ!>M^`Bg73Ah3A$f+Ocux{(&?Tos3&6H)82=q(>>q!>X9ui~gj z4kh17u;=-n?4XwUn&zzs<-SvS(`ulkz0%_?#G zR^R941h0^B!_3*Tenu+8rk46~2MZY44R?uQ zZNBB+icfVjzBt+*+C`MB@N1;$0~r(L(vNhxf^ra&a%ux>=5?D%rSW zYe$98;d}XNNri-Bm$lWqSl=JbX#w;KDQkj(jW9hME9y==cH4f+=*r?x>&&`iH(mC$ z4QZ#G-SV(!PsN**f;;)5$iaVy=M4>G+)+}G>!W6yNZ1`$8wCxjO^m4>ko67ep1WstbN^F z^N7)Ud13kDq@V3?+Dvvj*`lovzpYvQ zhs+oE{>`&?}tZuc8f}bY0V8_AWn{h^K6*^TAod@N5Z#|}{g<1s8m20CiKty$!UBU{^vP`ILxMzL%3kd4cq|p5; zq0}^``wu!pcQ1v?HWpr**ScAA`HJDFXeG zWir(5zT=psPu#)rbsrwsMSI>b`u)n~{n=6-wIkb1+%nB-MU_i_?T>%ETU71#w;|XF z4xZU*E5qPYh0($*BaW(6Z!E0f&4lB`O=3;Iv(lOMhbI5w0Q6^wsu=HQrbG=5DU7&A6v ztXVwM{M7g+cIAhs|wi8e9 z?AVYw;~3q;UIA`wY~qidh-#S>pqA82h z$ov+k`QHVIqmKC*oE6%l*TPGqCiW^m3EHutCzR{&0{A+&+3OcaPcz_3_@pyKhW)e- zPSN6`Mk>x0!pk<_aN_DM*k!UFaD-kIq}LP@{PfY=0ZH(6tlOi1F5@>-H1D7PuE(t% zX1{t1d`6b@?!gsh;J1Z>c4jj;vq2R<05xDFI1)jBfPwQkC^iIJ|4h>W5vl|47!Hf! zmItcaHvGfK|M=)Xut3VPD*4d+CGA+uKa|Wkmg7=hTH?@x9RuJy|6YUN0&YUTz;R6k zP6!b!3C_SMhpg&Orr#2)cBJr2QN}crh46k1b3-ED2=UbP#|&E8?l$;jEx->&k00a( zn>7)5QZzkKwjYN?hqo|pX1m)y0fr%NjHyN7#3$Mx%`BrwG9e?lsNka#!Uz^j-U5(# zCo~Dl2S=~?3OU)AuT$_Xi{06Osh4W|w6#=yY)N5bVu%bF2St&kaI$%dRj|t`E(>9Z zH2BfM*{R3aH1|!7+|{|bW0VgEpnWFw6JM~4_i3DgBC5uXDYPQ zKUF@$aAq!+AP9zn%*Jcndn|;zJxjl1>^;b~bo4NaVz{XX!=l?L1dz*>@iCa;~7b`zv*uPHmZ=uVDWT`OJd@ znT2!n-#=|G!-F2$maOY9y1jEo75j44|5wC4u97>F2d~h#xewL2|MPFGO|oQH!Tu|C z^Q}QFNFLV@SaKe9zBt83j zW&Of<&hp|+`QntS>Jhi){NE0l11OzAsD#^k1n9u-@G5}sy;9ldXx*wF0qz55BbMp6 zh+_hZ#gL!^A{;UyBRctg|Bi^cYe{(hf&vmafKRKpWaON-m8{=>qO?YCjcG zF2x-K!JrfX{H~#Dewf+80?}aKk+#Z{*ltD(VK9)^d{7HA4*QpRNE#zs_iZ#Y%fcP~ zJ%LG&efzKNUiDIYB>Lp#a9A9e?CD`dfQ2w}>*fgGk))+ll+jwdB|qT&WA z75puxX=rz#^&Fus>C=AIPxHRlg`2@xP((;%USEC@ynv@SA_Q1f5aTgxxo74Z{s935 zyvwA~L5eGcq6EYiE`MoK0!7tmH^H;2pH`f}ik?u+MCZ&JdAPaX*p_*O&&m_tAI}u9 znG2!ZSrI(^&eM}%9uRE7T0sLVg)oHChF7UCbE9NT^G6E`whY(RaB-o?21d_);GSsh z%2&Vf`_=fZAzS~O4}sL#+cgrqZ8P_lfps%Tu<6Miymw_1j03|V<0iNpJ0|QK&ff3O zPj^sm#S7uNmXOMDWeY+Kv(F+84_vQLo16tvoRZS?9RrRuB;UP(@;Ax6;3RI24_fSZ zLIsgj`9^~~0OuBrSp3@EU}@kj<<4Xc84B!)2H5y6{UEinG|y5N%^#xN2i^#@Wv6n4 zN`LCLO*^)B%VoCU2PO&jg|YSqlNkb&p!PUDIH@AzVZe#eKlKt8Ql@!;lw){pj zJquAMNGbEkxQ}$f=%;8$7je3%9GSmgX0m-u+18*N-6)XU8T9h|%%suyk8QnQ#jA?* z#qxE3MHFw+`NWu1iOopA(S1I~G|Kx{_xch)TYWpq*o^ZRFS+&{2I6gs03^dA1CtGv zC)18;Z;uTyH!N%bL>%uTmDvlpbgEoHq46^JPCQo3w1nwiiDCz4rAH&ozGqs3+Y3vRLwpNE~XSV-P~w}1P*EGsCnGMM8$ z<~Pz1i2azYx64l=?ekD(V1DI`)ZIORl=(n}DG{+Y$KgFH0FRT2a6S1Hzo|{Q6UxKm=>PyaZ`rpDJ zHq6I>+x(`FSQRX&MDNIi>Gxr)*T7e{H+SXN~3hRJF^W0$SP2o>w{aSr2N}kBg15P zl=nlprdKQ>0&KJc5kGG`!eTr}iVpe**n2s0t6Csmt#l8UWbN(455Zae$rfstIcLX~ zX>`>LQ5wj@$|U+8aRlo_Zw6l-!biVw&O!kJ$$BN14S@c>*+pMSIMRblXwFIl>wXx3d*Z;PLIM{2^q^0^}bLrwkHlrHLZ z?dzZ)Byc0clugGFtvh{N7tFskWvgL}FB2+QQ9f*FbLQB>>abN=VU@?N1cZZDyri0x z52pIGDYS`HqGSdxm$s^tj?pbRqo!sDYVceZ|&dUwJv7+f$G;RBxUj(dbqO5W6yBh zE)>D+{{-K>bwaKk7q^Z8$~+}g0sd$7>i3UCQE0Kn91^$^uGoFK#<&a<_8TY+9_q~2 z2?<58;OE}g`1L&hT{gs&bcp3L^P-&9&G zdQtX?cR&HQ8jMiRs!TMkKZTjj`rK^T_61=t4eD!iInDOu6w#rR>65>7R@2d`EP|Pr z^uYuBH`N_Btz)9a_p#3qq~9T_F=Cn{{?p|XEgs6Ik|BZTH4+}&aVcr>98whMo0=DY zJv%b=VT5-@X3zJUH1wO*8Bfg$K3Q|JvG%hfa=9g9JO>{%K`V;+0PcAv$vV?C_ksH1P!QIPxc_xQ=M8 zt7`n38eP25u-LRu_ZzqR((m>U#HT~(0dv%c94pt`b-Qj;RKvJ|n$uz$7Lc*Cm0f)h2@HfF?JYk?3LPN)--ODtzSxCh|rTjh{A9U9a zhB=gFj>rkp1D!nYwOWtoX_WPb#lSWgip>pQlXT|JS_@=ypvaEU&`6QVjLGopxhIEh zo4e}n3LXtVVCiM9pzp^sD6i8!lYH(gP>e%U(b}r>GpT5uR|5B;v!-#)#k58|E#0OH zg5f#13)ChKu~Xg~<>Dr7LnxrmDR86N*VAfpU!k$5J!S~76Y1;^%eQ$|0`?zGVnGiQ zKa(Pj#2*66q(X67Am3#)G*X)MWn}y@(TV9~Q7QNbp0Wv1-km;7+bX*a_8)Q{@ZyBr zxob^UC~de0Q5cOOyr)&{FBkG6_s0TgKxH@mGa_K>e#@*zJF(}GYJGgqV<|v}wL};p zV0lMJAim+VdnVSA1)z(19+6JnccC!b1`o;^iuk!|M?Ckk6ro^;^SBkB5ZjZhT;1ZB z+(@U1<1mH_S1h@q*i>;RzBL{zEntj%=Gs4595qdN*BPIg!tb0?;eLfYI(iq)i>htG z_Id{5Vd3(2pZsi)5=H_1}y&szKQFg8RDyz*=rrJyP+I?Jw2M5{d z)*FV`CB}MhTT^t`p}TADj#cSu@PF-H^{(EJZ%xdN3>_W8+{m%r2!@G`8lGm~$u_@X z;g~;Oc1nw^su1w2$+^fV%uNciOO$cKC0t>!69Z;O8)=S|q*yy-o1M2S8VfhYM0?4$ zS>`}}atP6(eMwjB=t`I0e3jdubhxZ?KC?z-&X0_}t{4$=h|qCO-0_bB z;3QE_{D!xKK%*mK4~%8F+b^cHbudBLU+jVxT@Yif_R+u#C7|exqcAb`nVD~8rmUy9 zMjKNaqE+t-eL2(Wy=qSu z5`U&3F;OM}9=z1&VMu_Z-nIbtZBTnffLxg7qKHHWNiLtQ|W2yhZ(nc$`B*ZxfJLi}bV2Vp=)Z{$IGuD|6s=>8B;yxxWHLAOKR8^y4SYj zf=z53A;auNBA}Jnd2(6hVoV=l7l}wY=#hDr!opBjc$2_0b`juS_Y^ZPUGJF~D2TXA zd8Q5Xs7VM2Qn!>T3`|Bshv7qOio&5F{f1Ys3uaG#Au4%@KxKEO_q9g7kpi)hUE4j7 zPdX4o;~TxByf2WpbZ}*XiZDP8o4P$9WOKoSS<0I{>3A3Ecm#iJG{`8jB{^)XPnH7I zU|wPbDS}R;_)hone4v9moij406neMTr~EVk|}MO;VSG8vt=g?;3A(UK@xornp4lf+foM?#&E%8?a2H0d{>mJVb^hdie#rHrL&4Td?PgqD$M+8*X{NsR`4+ z46+Dp^8uK!R1?l-S5i!WbYdP*bJt0cp%;t>V>glSjT~yp@?P&XN6k0AA0K~&sjB2Y z1>xoJ(FL!H+Q-)jR6k?(%^t!Pb|_d)jwwQN_XE<~K83eoPQvN|?zV2QbRTME!4xJ2 zS|2jtyau-j$ig*YZsFd)!6?>|wkBADjRFgnYkts zq0selO*Fx{(j*=M0_M$|+tEg7F@n`3*#-`NOF7b36*v$O zo$roFr0RJ($ayAn)N&G9@H>Gyles(IoU`^!-Nk-dG2ZeMd6O_VLtb|?P8?NqCVtD> z0>qfeX9Psne2hSJC`E8`HG}SS$uMz`LJfr>O1D;T^IDb1@Z2WhDSaiOL9HyM8`=71 z8CN4P>9loB)B0x#?aJIj|MbudtDklRR{`yDS(G+Ww!C8bMRGbE4$l(tY3o>Mv4XMP zOB4<{Fc-^34wsti9JKYW#Ez^_LQ*oP`UQi}Dgio%*}mBR@^B4MIi7MQE!EOed7VP! z$67{aVPES6D3Dn?A+}62V8n!>5~P&=U$ zGQgFj7(1D&gKoIWCw5mKD70N&o`O$gd-o$U$ZY2IQn=Fwy-xYtUjhB*Cy_KHBD-oO z)e1CumTW=^RFpVt>7?77bB22>{tRYbK;8#H#$mSdFk&o6Dn!ltFiihn&8CS!s4Nk= z|2F>pJpYqALASNyau3y9LZBXrFkFAR+CE$BSXARXHN&e{3FJR%qWU%*!&{)Oe(;qV3*$St-%eexs&)5 zmXe)t?Yc$bch7(XoSPxOm)X&r9?RzWuScjE?jQ|m&0yoL?FIdRhtWp>blLk@4J2SX(*H*Xf-ookb>asGdrfPoORCkW_?`q)4=4%$4AX)`u%O2PyXpF zfCdt2?lXSIbT3n%iyKnypL1QS5_S<-id|ygG(SFy&=EyqdNTB_l-FMUXY-M{(e{nG5i^{kH9htxF*t(TGe zD+Cro*-|nE%)F-5PWTDZ7`=7>g5)|KnKxw!OMwPW7lsr)IQFo1O|q#rE6A`RP@G~} zi+)>!`=;G42~38$fY-uZdBmZ1KF|7u+s+d7-Z)bA7fXQR7JO#2O_R)2l&PV7ldM+K z>|M1AE?7Bu?z!)6B#O8;c)n@H;CMzT+<#I|O_UY=<_XXX2SxnB!IkCe2E%QFA`j{vZhM~0 z(5}Z-&A>jHZr|_MiGK*~%f~fu-iFsE!JT7cq!EmqJbG)1&wH+&a>u?sXMIi9lnvVk z2nVW(aKVxdJFpkx{$)Jnn%Gy6sw=7xV7ugj#WS8)NLq%#Dapx2X5h%lm|6yu(9}Xz zP<;ZkEIb09u+1+AQL)q}?cV#?99ED8;e#nVDgLTNbx(@QHy5F$HoXlQ^Dj;5KIa5% z*bk3nQjpzcInTu zF-58Y_QE%xOAOn=5}L1{eu>p#4C0<8mVMfeXj_BVfse5aTOnoyov8Nb(GGLPY4>-e zYIz#C>!KhSM`(Oro|QBx!{mlmwQotuz~ee0n3uxcYw9lhTueEY=wjbRQ2zpy`F!DL zW4VSNYO81t)}ONrLu7^|q*0tq>lG7-*Ieev!-iPOn7I^lMLQ?yvh%y;5z`L>O_B?%&xps#EN(aQ8{9UV`ww;*VP>N~i z0>*1wSccW1r;Itz#~*U=XC69@{q{!!ecYp+nzPm2Y+|YCl#)dF>h%-_g$ZBD;Xri! z^?n3*3k=xfcep*hEMh_Y0(^Fgjm0>q85IoEg}{AtU{%NGq9muNcUfNBxvG~T_Q{u2 zep3omYnWx)H@U^_mg;mjk1mQErs%qNsrwH z{M%ODD!6y=y;&xw5LLZ#nT6ApO`nN&88)^4?bqQyri~k)_Tq371-MiRmDr>c^3*G} z(eTgO8ri~x_hwCJR9#BS9w;Vd3PTjHUC$|ot$6kzT=V)g1dBsnBh{&zZFU?XaXgh? z2-{EC_&q0~^Imff zsz`%?b=OZJlvSh9V7et198WdL~Y#$-})U3v_u;$dyk)c(D_8fQES>Mm0RyqI$002|H zx+gWw4@^de6qCkpKwxPB)8iJ_SJ5N+*4_k*!LU)@tMWRHVlU0cZ7A^>Aqy11eQ^^X z$3mwdyJ^)1Ii=M@(`cse=Lu>mjau{PVyG3vgR8FhvrCMPJR2eh!3ZVW3rJ@xNISED#t?+d$tg5&0_a`YB$^r<7mxpl%iLVx}s0PqNBA z;9fXlS8x?vG$riqjkPPbv!WNlT*+cV?R`}>EN7A1%F4RNAB?l>KiVUof3I8NozC1* zFS0aFi;bSpP5pFZOqU1DNFkAXV^dhmY18cGwbQ(5>bt40`|8VZ-Swe0DJX)4G^uvh zQC`i5fcdj>3(D7*y*b@Mr`*~J@9|9+gf$=7jhzF$04nX&!Ni|dO&GrX1@QS3)r zU)YsU5?YLEr&}iO(6EljrwqJ1tJ8U^qo`PYi`o2?dN zz92b34w0WbTgx(>zXH~IEv^{PuC7<=$t!U25ag<~=Ix=yCl5vSmdSBD=@ci-x>$Af zUe{g&4R;HR<)^C+XX;b|`=dB8c`3@M#4nN^s_-PF!j>g8Mkt$}+L?Vx|C;4a+E{-+ zJ(~7f#y%2G4~81q;+uT@{BH@hhUwmSu15^bS{9L59ZLVPm#0vuVY^PH?Y005RJ`=M zWl~Vvl;$XoTPWIj;h)3zU#OtO${W#7Zr2$S+&Ez zOCQ}G!7rD7zL8m@91!`Zs;l0D$piJ>FAJTMkqTaP`LCVJb#f!pei>4a9+;$_cEkGU zk_p6jII+}k&cbbXd8m5Wsn9ERR%F$6sPSgEXG>RlFiD=L=WS>gw_>`)%Qby&G_xPx zD8{_1n$WmDs#_k+>+V*q2rCYr4(O!91@RgF#jAcvJAU7&%yP~N^ zSKOdI<@()5cpcMd?d^dCje5ZC=cS7b%zss07U#ay#wV~S!(zHv;S=*qsNBwWxfykB z>I=yS+v)?Wztq^~)*&Y5z<+OmWi@OSu!X!*{}O&)o!0Y1P$Fy%+aIk{-?GH|`L zpuExs9V72~4OHdh?4c$}k?oFnx2rSX9Vi5H51#CSR4*D=D#?z`)d?9kCAughY0wo2 zo!!4@Z$%r6`{ioAjP*xc%SiPtNUNx8opkJ@GS;oSYs?Yi#__M zMef~MAQ|McK6J|MC9m^+pH2@cj=EFibmFbVV-YHXMBHY^x?S=~WHQ`Or=9Z>QiJTw z6=o;KUhn+d)t+v}C{P==XZ5@(z-XTDf7=5fvWoU~gWwd~7~J>GvVv+vxuB_JoBesf zjF*3!Mai&i!H?cYt19xnC}OtTwDM8?&Y^$2?3)(Zt?=W^u2_2NKLFbEH?#IS8NA;}(#1Ig-SOG3!TL+O~uIS=oShAnt0aYez!_+5ji z;8tsfex2&Zz@{xFPSpnpJh^>2WzmQ$W;RDoL|Qv~kTNJ*ZUDIE*#q{%Kuq~&$0YS# z!QYJlJJ-kN-(_g7nzO(5lKxdo$MllwPS3Y{e_C|adEA4l&i0X03Lk{VJ+Ha>Vs|5z zbxK}OgX1Ac9+f2&cfHrGH}VoMRG!mQeGJ{LQ1cRek=B+x(x0FzGguh|KC7~>LNRND z&it5>MQ4)qbuoujsP%Lp04j;kzOSm1m{R^}s9vH@Bp}er-D#5WSxYBe5%u>>ImCBq zLu!R?%Qfa`!#v=98^|d7P`RbNk#R+qnj--ez?ZyI*{DjGV^q*}ZPs*y;=ZI$sh*#z zB%V89n>){Wd={>D#nonCrE^L8q)o8F*eumUbKEq!<}osNz4VtH$cQQss?cvOQG^o z$-4*=Jg#Ot1qJ_-_Po{sNl{Af*0OJzmsA-4z^b-0^DtPYYMG31&!mCd713#%gbel# zr+z+7D8nSFZQyb+5Ge&2Ec+n`7Ln0iyp

mz5c9LViy)P!t3qnbBKp68TPcbg82Y z(uD70m}aLBLBb$~6id`CNC%D;ryyp!l9P@ zSPBB_d;b->exm!oc?UbO-vM0jGY1frzAIJyON)ahZJS`eb87l}idmUJ9MODgHsOuq zPaTe)QuXg)3Mtmq_SKoSeW`n8o!z=$mYyn*zxG~J{;An7d&(9MDSx6x!KwZ<#7s>) zr?N^R>~u=>PTFf{UUWJQHPhr$Qo4H64{4G2`{&lYI-*JDwzx0FRdPGyk5H(y zO7LH;l*)lq`$gq>nBB+0YqO?42}!A*A^*2>z%HR6mbLy++Q2PhakYar^E`N~RHRO; zgNK6gCL{99xEc|i6Fkfd$>2>t1Vqj)G^yRu(dxAm&)GTy&yjjxmu~R;4#=E`w*u#p zK93obT#LcG1n%~+heIPVw-+55l-GkO7W|W!p|kjv967!oe;{_2fiv{ymne7ng}n-5 zgIGxd+9k>W<}HHEE|$;C>aaQN>Jv~vI9>KPF^w+OW`BnVeoZWt>z zFKK<8yB#WQ+Fudpz6bqh6orch`keJu*)4V-LW;$XA6jNi9w7aNaK)Zz-7=95!%G?v z!R>VrKiH# zSi_}9ATz{a5gzi1Rm^iCJ%p$Akt0n}y<<;+@P!^-bVGA%byy$zj0$O!)Eqr}R#x|v zM8}EEu+E@tMRJ%0&K0x9OJp%0b9u1@i^{19WMQvYLswDki&nt?6fm#_EHS)CL7A^E ztc*C-_ioHVGLW??o}1A=YhrBrf37-no5-=}F(6xv_81VEPDQvS(_{E@jkqQJZ|TCW zv%{_%;K!!cS|Z!iV=VzAm;HhRo|h)IEl9cUpS<*0Xw4dfu#bA@4SeUX+^KsmzMq%85$ISprTNz4B85+b0Lxg7d=qI-n8YonZiG$ms=thure7HZQ;`G%j1|^ zoBPK=!cw4gP7zLWC;n}Z`E##%NY!5F!}cY-Scuu_u_pB)bG{530biX-cTtZGc$N2i zhjj$D#k?mZhhbW$l*Vhkx1DqP zmmYcAHam4f8k-HFWyiFhIG)=LCtvbZ)?~!i zSw9zF@NJlKRtl^c3aBv0%HtT|rmkh}gUN_Yt4 zU8xiDxYncaX>H-CXMu+|Wc_U+pve_c_~4zvTYZ-zv2+Bu%a%E(Nq@_!XEesFc*qk! ziN#YU34ujJH`t@|b@RCyvs5XNA~kw^ygt(D&eHNu-FV_Ws{X!)Ii3!O)5)wwhWh?vC z+|uz{k`i_;&32}X))s1rUZON7X{>VAyQVv6xlu4Sf3z@W41I6E^^fyP4^N(rg8U1~ zU#}xdKkD!#EFp80WI60}qrZr`=k!NKVDC#??{mSU3 zfSlKR*L)gvCUh%8@AUPZ4tGIyKTx<_k};T&0XOcRE82dkXZ4~l5p$9P?93Rv+DFI)G2y)3s7Ip{mDR!y6x zH(09%wWg@}?&bPYiW<{!YZeqmAPfL=kbxcDq~+80azIMvxuRhCft0mQ0|NUZs?Wx0 zO+Rxq1fbHu0DE7kumLIZ;1{}O@>AV~1W^#d9A5;L=a3dbHLAc&jFoFI zuGR^G{0?{R!zTMO?TPzxQOBPc@YOh5(6v|hFa^jQ#zaoJEAX@L1?9ub-HlsmkR<(z zT+*>0_O2n}$Io`v)U5-;M0Q(IAku)uZbfIRdIMkh*5dhT6t-f$?d;LC*{2Nr!T2>` zqt$;~NU#z#LUQYR+RLd&8}>1G>WdGfj8rV$(r2Ue*~?<4dN10s>YTNl`pCgS4*oRq zG^t6O3OWe;z9}>FRc7lw`676UL&y6dg{;yX(+9&Nvez-nZye?t zn5chEwtGrSYT@_yVenM=P7~f~vi(x$@ah}x8;$(t0pNORIil#&4a~B;-fppsm10er zRjnw2Ppi199TVmmG}W6;>*%hqU3lv}q#B}seAT!oFRD2MngsvJjcx2RW#;il8Jz!Fr_ zt{?A}2aUB9TA}nAv!5_l50+`H+G#$gT=hJROlN9i-5GqS*Ng3c>>`!jQ$MJ-FsFLO zFuG{X)JglYjU0S@TEk1;H9;_fFfbqzby}oy=pLqn5~JDy-1Y zlAVrNG%^vaIbcS)YPkE%Fv7)Xv5zff60rTZpCFxE^u0EJFM{Q^YZK&l(h@PgC%o__ zfE5AA3Q5T!2WDJ=h%|V1+(GRsMS)h2z{AAePZGj&I~~7ig8U_XHzNe!iVp?*6cbQ} z^3X4?SQgeRXfU7ky2S|!h=nHq@WR=xRbY&$3W<;Zw0WTuvb=~OIm^T{B6a|c2x8Ft z>-sYPlZblQ9Z@R+SU=74(m52|-id!gz7hy_u!+Q(gtqP%DCgiF8Z&QaS~2nKjs z{COY}{T6L>jHZR&+n%??#yV6p7U8?eyV}eX=Xwt6S2YfGYR6pT5a+H#!S19Qx=v__ z&ukjbuYxjk_y2qrbK7ULhf$Q#72eNxZ-?*#>tM2bH$J`{PvF8_(YuU%ToES{=cP1b zTRUv~-2h|XIUg0s)EugLTF^3S?KKZHrBv3PrQx-(6xRzBHA>%ARk5YlwtxsK{P0Qz zi4QUyxk=0~kNr56m3vFyCdEmJsOT@2hM%QJa)g}~O1TPZ7sEF(1|0z!L%NhKnTp?V zaw9P!+!6c`J(H*t0nWa^`xBL7BsN77CD0q4HpPQ&b%K^r6BMYI;)=HaFkCsS*)plP z0cp`=GOCG>&%x?k^Z+=0m5avLnyC{QvrlO6IR&t6;GwFb2jrUJ!FQa~E>jfe3-k6J>Gbu%8O zG%rWV15S(Bx!e97+?x`EJWx`tLu8tgvf-a!DFKfkGR`UTq*epQ*{+e+v#Yao>@gk$ z#Q+4wh2bcVK$|vNY(txCfr}AZ#E2a_NU21a`};Rb#TO4?x|etVem7xoal#abGOjE> zunblh@cp=?Wpj*QOA1T~u<)zJO`5yxB5MK{A1h)a9ScLQ9bOEz{72wSi;(M?TP+NV zXHrRy<&C?c@nMc7ZrebZh1RIv+ef$i`I10*8Rl))suM6RtB-h4#xtu`{xgDig7svKL|D< zqR?IP_it2IQ=2^6CC|vGTr=`av8JuQ5kh^%RF{5+37gt-N`hgBGunun#Ab% z$-@ax3sm0o;h7~3OU(;MQD5PyW%SG%>E&rnA-4Y_;VN)1YDvt1gTYnz^SxktkpPXh z42s)OmF7q9eV|AUDJJinrfECbb1-dOBrKocJq=7Qg2M8eiMW_?r+dv;7LX7D$geo zXgNeI0;H@aT}XQ|z~M&*WihO#)a=36-xPN8eiyOa1c)zCW4O&QP5mA_JR7wYVJOR? zetgL+9=f^LdA+xtWHXNq{N+&@!^fWg3=I&-p%7ItYB|_#mzvWvzglq&m-nU~1HXVa z@JXhI8Gf&T2%Ia6D3m;$&<1V8OO(H3UjlqN*omrJPB2h;CF=@kSEyhiY00dWWTHKe zrN9Kq;q1mfiLB<*HkvULwHq&oh#1sh@)VbY`I@04BButwanaB4N; z9G192|NrqDLJi?>VoeWt4a8LMnB~IvV=6qVt4!^1JT+i$bN!{UfsHX1iv-e4c4h<-GJVTE##)@%)1uEa-<*Hd@VJ%E#bl_SC56W9pwJwEc z(esYsg1|G`Ur(Nh8%~iXiYT`q2&ZZxMncfAQ6)@a;-JjDTRvimlGV(X3i%2Y++bTN7Sy{TWA*;B08Z=UL6I42#i9-0SP`l104hJYTInRi`va+d2< zvkVeS&`6<2%Wh$fFOxe0HFJ5@BoCGwDn^SZ;T1U>&68*)kc_ZXN$VAknwYrWl`&MJ z!ZanGEq{7lmFQ6*7sdz--5#E#>`3o(6v_!~UVGOa6l>|IvgPn(`<1YKi!_F=RAR9? zGpH7C{X`Z|OH=fV>bLhbi627Jst+=?lxDCPdAlHEgMw6Dj`6IKWq`IiGae`oIx9HFs zLeyhESWztvw60KfMk6xR!pAT`mFiDO8?q$pUn7EeH4M5#$TXN<8hMWcH=?6%Ue<@# z)o`B783VhofN8jM=4tfVvG?HW>|^!yGvZDc@BU)}EPkox5l_p2@T#fC^&u;?Oew1f zB8Ag}sy1q7HtzG{a1QfzO|(ab4d5j+0DGHvfIa6=MPoj*jAIfvC=Pxh#rL5Ue^$@f z8Bne{qgzh&S%#hP!kYtX?df;eXRR6}S$~{eE$WngYwlc82p1&Br@5Wkd3MkfM*qkM ztsK=}kb=8bKJo%l-JQ(C88W|J0l806?Zw9WkdiSW-K@f{@BdJ)5u zm_E2g963KOxAFGa5Qi*hE&;i(S5If9iQG{cgB0nHhnYBvUOXJ`T{=jEMknl?iehu- zn)MtM@&c7**#>{6YPa>^D!!t1`-kghNZ3N(KDHf7Agjk>ZDo^eM5RVeGAQq4YTwPn zI7c$4q&CV4X-IWRq}Yot&0L~HiRx>b`!zB|+**=81oxou(Z-GHcNV6g7J>kr>nis^ z+kkYMGA|~idLt*eu^rEWkG&~l#@!+I(o0ZcQPxGP6%SCIUeA(uC;vcM1sOS%cE(?8 zFRLVq?DYnAMYoku;v>Ef#rWgDJpPzLuS^SI#U`&_fa@wQ(}q`o@bVLK$*nwGSMTif zYN&V7v4Zs4tM2l0vbRi7Uc<|Ssv8^I8ti41yOV>EHYA}Yv={h9+bg6bw#)JabZMDu z?%fBxKd`89V^D3eO5yfDSanaz;7M1^^n+Mpqn-=`A@gnv^)Bpkag4=%Hn9tUKE0XH zTxnN(5#>J=gTU`F(OVj5m3-C@ALeY9f%}@{pZm7G3vWP)tVi}5chot~^M^zKVJaN{ zWFd`_14yfs+N+|#v=GgdDdjtuE=4cCsnl0yeIoESBUx!RUYWg&)9U*5||@K=yvCmAXpd?j*n&HmkH?x&H(&AfAoTgHrevbw`jRL9Lj$ z92ar{5748$Se?qij0_{z1%NUXz!fb0i~55lUZ2`8P_QhqC@T@`Z2i+E^G(Pk;m z0lbT1Oj>!=wf(Q9M|ZQT%lqXTD5a?u4msDnuC_Ye-)4QT>?@(c6YMnex&L28txY{a zqH``xnlURFnkLu}mGaY2kOb6b^zYhRMlwL-Kq!a={8jsv^yo9j0y{zmPqk#%B zzU05qcLuY97b!~P5=z9T_O=}(t=s`Qu#i^fwzj=k1`TaLq?P4@LFbpZSIy@#sEDO} z8CwPAMwv?W_R4apr~?l{mDtO|Ju#9HGbXV#0JNTB6}J@i9=$a!n7@(rh=7YEsWSho zn4%Ym9R;qSy5#AvH@rPA+}w{S;6UkhT5%UV*NfSJsTan)?p1y&^tKKHIU zi#epW@7{^6VVEr80S66Ohk;1b^6xSu<$Vd16zvHD78hnaS(X;fuI)@N|LcMnptCu@ z_<89(xsFw56egFD0X4ygvPcCp63QSi0lSg&4~_Rphi#*tBGmu-T&bS>WRFhBn{0pE zqV2r!41p|KB<{6#PRT@-JLA28d1nC>cuXol8=OPU{-jG;36YBSr3PvV2Bvft6x?!Q1?*5*Br|72xyEh6>Osti)zjo|8ZI zZ(#IXS7N4}Dya!MyFQINUE6csiFRI>7-tZ`7e`Z|BgqzrM(=3%LB{e3k>B-w1Y(~xLiz{>&$h|oJ*Z7P0>cb7Ns#ag-f40goMeEr3OAXrgxv3cW*i+7>$Y#7~wo+gN+ z-@@vzE#U~yPB<6@*k4g~(flPVHgoH@uy5Mw~ok%Up5Gh>$9bhYJZ)*P0z>1sK;+2WC}Pq9z_f zZ+6uBQCmd7dx;m@)BzIYF1j*^>a`l?p4jro8xp1`%1_CF*&Y|*PFQ1Ms~6pu0Tn@*}=6(UgmG{Qhu zmp)2lzu6G8y$1bow3kW(`F1pqDVkE{Hg69xg9McM@LHblhu>Zx$bP216AXV5nqpe{ znk8x<5C~BTihWnxhIp0<;M6SA@}4+`e@Khh&`MQPdDFKrsWx1Jl@GwnLrTE%iB#=T z4<#@0!-O*x28U&B_bCI7q$DjjO^VNnSSdmSQeroR+W+bnRK`dv9g&{kQ_xWvBjW#F z@2UQLJIj9}hKtYD^4!NlNbzoVPPHTE25{p}BiAq0_M=El5x5-df3VRibSHRSwo8aYsBl zxG2^bb#pq)BQxl~k&$nKs6twD7*;_|IX!ejnxdIbM14L3*)6vPAF^#B`Y*m^z&s&+ z^t5Ux!3C83(4D#A;AkIj_4KIF9&>J8Dqb=wT4p28A+b17XIow>*WI9lxN$TJl37jQrId z1+wlLGn|2vsMdzBxLop+o>SYI&jNh*yl+vGywbGCGd6eqdBmre!u_^pNm_H?Jg0P9 z<4>D65}Co-P(!oLUCY7Vid?w^AaooLlgkNr;GRAI3ls>X_8twO^d$N)^e?b0mwI0R ztL`qVAIM4{EP*R6TVT>l4sA_Tn)BH!b&LS@=u?8;RAgc9FhC512T#n3&xua@KE$KQ zW6se|L(|lu{!|H%re35+G3y{t`*{RYn>{}Q?8@q(c;s{^9?8>W!0fXmYZnX;RZ6F8py?TG5V2; zz4%yZ^-ab>kT_>Xlga11kTx>jBv^`pElVb5m>gKx5n_0#b<+Jf1)cq@p#k^-6i zrT(Fs1$X-Cu0`~4{7Qr8qM-i0<>s7*foE+rC`zcTb2z!n{q#*XZh&55b<1{*o!iZY z>L*04LG5BJhiG2k*(>P1buWAiIS^f2@5!Nuy4a6;j%9aZ4sWO?DC?h=c0yMXK1)q( zNsD*}s5HYUnm2X6{v6EN6+lHyi)89!H@rh45*FY17m$ubI2_}fHcm#`K$VKpU&`|0 zeSfM>QM?rqE7QcWb2W&=+FTb51QIo~1@R;~s-R~Q7rmr*9AAbAO~jv4@{-dG zloIXb`Y!5|xGeFwQwXWfmV!NEyHkEQW44-1*HM`O615l)kD{pdN=8*G75Msahqih7 z*ELP!)lJ>C)3&=$IoT)p_}5v{`ycjO9hqn7zOH7hLdDp~_a5()p8USuqH}M3ojhba zFo-%is60U~`RjslWNpW$e3dXBL2DmsP*SD?93U<(h$Yu=7&Sz%KT+mq(Z^7VIH$#P zctF{l4!Lhw*SF&i)($f!F;KK(S z+O*o2)8EliCy8b$FEq~!=HBDp zYl3=g6S4Gy7$;_?6Tk5Bfg%FP3D*_{7Oc)TGlvQ76ZGFZ66H;>n={Sst2}=c85)VG zbPMNNjvb=svN0Ky$&25FjzI=>{RV!;_DcVOwoArPu)EWy<@^?ZNwx6TslB!$u_0~> zv;(bB*|j(oLu$>zbktmQ9-gMr@R+fWGVm&`j~I+T{9`&HIZ_@P?W*U2$B#h|@8hKS6Q1lYA{m0;aj*RTmi?f-Ilmz0 zu>OS;-PKK7p0Vf-9Np%PrB1^GG#aR<)2gTh+O(JRsu%%JhJ0sUV8Ku?=Qn3ogI#7@ zK$m1&PU5t)xo$##;}EZ7BF$h=$$)OY+IKWYFCY2c9cYzZ#SG2Y^f{4sZ$*mu*9xx3komfO3B3=8 zYXnByLQ`z}XomejYBu?{)j~3Wh zgDQ$0MpFFBH}%o3V2E-BCm33eiA$ABmTI8DK@+a!1|GjIi&h`capk@3`x_^2*D6T9 z-v=8#5eUJxwC6&xLYk#a`-FyG7wNe&T0Ch)RAa>GjrbA>8V!9Upzt&C3q+pyDpL^o z)S1gTO;wJMu9Xg%lOp})bMcQ@zS_-kVDDcog9Dea;fDlaIpgPNAGpNHqg>Y}P8qX; z5fxRP<6o;ZW-$|#@{-fyX%6^Y0Y-I?GL<=2&1$-rvcJ~$ypnt6%ttS`YcPJhYrEod zUm2%NH7tf)nrmz8&Pj@OUgH`)Afo;8WM*%mVAnicaV%DYaYzvwu+!#Cr**eX{(98E zSiz4)V;HAYgwhq>oFIN1A=lqIQ#Tiamb!8+h>YoAnpsI-uYj;(Y%%)G@(*)jpPn_d zjyd2Hwd|v$M^U_p8>08g0|?{oyenafc++l;&c3xz9+y`P3SeJ( z9_z6<@|L$p9_O-}pNah^oj~wZ4Yj>kaNh#E3!Gb5X?aSsjGPKr8QOh|E)l8@IUCxw z`h9$8@Vff(x7?PB%tC1AhR-E_y__3jZ&ST{)&0D^7vA4dE8nrzJbl(f~)*dHBIRyT~l z9eM6uyF=^O{X-Fn&1Wo4O~!GZ@G8k5^Xw*8N6C6UAAp z5Bc06{A6cOPW%+0MAzHW8%*>L+VxA83$`tiCFm97CS|`-Nmb1MN-qo@^WO`DpPDs} zuq-tk$7~k%=rKHygopW#823D{tdg&F-K;^OsQ#)v4X0%olL;5>p%sZ7jJ1ufj1&w4n9DMe-%w_LuCZ_G-2-;;#C* zlcHuNv!vV?#oWoa-V9=S=fJy<%VXG%IP4%H9T31_;wWoVVRGRdresf21Qum6YTp`m z$BV;Dud>QA7}u5^{`GkdQ20`ljL%E9EJPPq!loX<1W3lcT)tmX;nO1{N&sJIZUQI& z;QG>Pr9W;TQ@A;=_;5|In?7n|;9Mkwc{0cF9WzP?J1y4`-n4k~7jiydyO%%DXJU^d zAo#RkAJfjW7cVet{+xftY>_Vcj{SM@3ZNKvsMCuvhHBc%d+UZ_c6}dwu2otB{ix1t z3Vkk-wDb8CGW|XFgu)@auHM<#I5}DNn9zn}+&}`m^vMrvbcy%@_P`wI)lT2kBBzM8n-XE}p2Q*AYC3Prv#qNe8`@UlsG~0G`-U8PaJ{l6{;I6K#(}R{sO7Hn z53ufZ|JksELPFfdKv{JEX|wlMj_s&`u41P=nnK1)l z>zNRiC}`Wp3dHQEU3DZH=B4voGjJakpCGQ-qQ)yXh-OWrt@YCkON?)7pJ!T;)<1oD za=lO=g0>W|74Tm7ZGOMcJB1+7k9Gue6Udr+@Y-}!ex@97q zFOC@EGLbwljO^I+r%p9S@V%yt*)(;!bBThLVX@)4C2j71;CvL1_(Hvh!rN;0PJ>i5UGyJ|U*@H^4o+DZHD`pr?(O~G+&XgPH= zv~!I(>ONA=rR|+h_?!qFCHvcWVM*;paB!B(?@($u&6zjhs5~`TbwKM*#7DhE=TdLg zpGPcD-kLMp%d|cbEWeE2lUB?r+sys1(BFGTPH}joyvqyTn9+pyn)*-8{@Q3!-DutE zyxog2s6p}Cdr1))ftKWu@QKsM;lLI1rqVlYE2cPHyym}pwV;B7()y-p>`5(Ho>o5e zpYrV2HI2{yd0ak$I-{D3b4pZJj-8YGRMX3JeAR>U9lclXz~$AC&)JU4-D}s+woc?= zB-Nd!Q9SlTF)ssxtKql+reu8&90WkEUCemn!uIL3U?9*}O73$c+Fe*+954~2aIb$2 z_=g?YcG2eSaoE#@K47p1CzO4JnJo5L*1uS0bh7a~rf3JLMN%2jYp^}({{M}iD$#}VgX z708LmmNHvz%v_8BMkfS(RUWIW9+x*B{X@D{XN5 z^ZvDos7UWO-UAC-I3b5yPK>^(RINm66DWx8_q)$=gfbDOs8({<-z9u`vF2LD(7WCM z9XyWLW8L!{=DXxjRQ!5EH-3u1u8RF%>t-{;scR2@ACmO8w?+;{3~U|^A5&F(nB;iK z8Q;lxeADfl_A)6mi9l4Y#nZ3d+OBmqh5N71BN~zC;l6LGaINqCSxGn!R2qXmci32R zWL>DcnoD!%@FwTyEzR;8@8PT8aaw&Ap6Mdl+gzXFeeWq}dIJ0|_j;u=n+>Vma@S?M&z;mMj;icJ>`t@e zvpFdCvLVY6@~t_&Z3(pTwS&b}{FL15A7;x#gtm3bkrRhNxi)b3xbBQ`v?cg<_ykj5 z6KZ}AgGq#LSz#5rd}wDy;i8So!{0iB$_={Pw5%`QPeNEp-(&cVAGqf7B+%pNcLBHb zZ>f!kJ?hOoEqrfK-!P1I)I9&6_GmHWRrGbd?Ov%Jeg2fbPtHT+})Yn?OcU+3A_3!Uhmn4586ah>` zBj`kx(6)a!9}PbmX!yyhNit*}(eamTMUYnok@hmJcoQCVy|YC>Do6Z^u`o1-Yijm^ z48PH{62KL628Y~`n2MK36S94Qhk$xv7I7NWzA@FNNR<&j!$8&QFpTKz2}&xU9_noD+Q(>7lbCgOBCj7LvEag93)zt zG9Ue=b>mXJ*6%|1OjhB(mzjb0hNqQ*JBSYFB|d$MV+?QiO%rfy?~mhB(k!>hR*)27 zgkRsaleS}o;q@Wu^`$CZ#_*G}(NA;a_T^HbfsPAMIl!F2Xr@kcK~#nU80M3upwbhc z%TO9%ODu2znFfilzj%5q7c+rW17chVtpY|xjw&%DNzb^p4BLYMS{|HRQskONjdUT| zXS)k4RVs8(`x{4|gXD%C3f^uyz|!<|dlZ@^8T44K6{xM--xxem8bn)$5aGE)L+@At za@WncUwGT55O$b3#I_V(Rte0 zQ0ll#RVhEotwZ8bGIOsRg993+d!Oj;nUo1k{f0AYY*JHj%rUpWYU_R;s&&Az^2BL* z@*1}WOVx(-yeH}FIqxNTn;(BMRD-7s=B+Vv|ID&q3x)%3sc6upqu3dy@KN-EieQFK zPcEJ>F(9x3W`nC1w4$=JtC@L|uH?7#%bBcvM+Qa_sBAW|()Ht1i5;6R4lMN6B>7&=ezBS5zkF+843`?LgLlzH4$yPLKI`D9%62 zj1ms;B6Y%zVUNM;RF)>9T~Bu`iYfq*Vy=B=6!`F-mWRMeC}tP9MeAg|$?r=`@qsBk zX1%~q!hym($B-?~PODv~41H%r|vD ztfAEv2gpO`lYyZj2y^AA*lZ?F(}XiUBCSlj#Z#P6rp1}Q1Pj${If3tsJNZq3hZup% zEfHPrSaab1(opglxjz46EvX8PX#kja_J4$J%yx?s-*!<#Wi^B`WH~jr)}2U(@|4!D z38WS>6|j3c+uPgBE0QI(U^jaY+wv!622zSaY6h67fnxdpe3>YUj6w0pt21&0v`R&q zPO*!2^421+SxPoT=S*4p8VPtPC}0?e5blwr4yjFDrgm2q?gdDD?2Aec?m=OD9GnB% z581IyxOP&hIq<0P7Mnac}+tl`XCy=$kwyTD-Cj^P~$ zJw%(N-NhuLRr6xnyaHKPE(0@qTC!a(PKV!_o(-Z5bWG5I2uu)t73C7>JMnUss+fdx zf8&z%Gj5b9{Aanu69=T4f(k*I;wM4HV+5Wh@vMP|%QXX}N#$Ow^U8JIJ66z5{$otx zCB$}({3Bq!m_R-qYsr=Yh5vD6=>Gxqqrd{3cAg{nuMA#j{{*SBMooEI#_4ocItNG2 z%`gn>323_=H)*b8dX)~N2OIxPs7eh$4gcrPNVm&IqK>!U!AUaF8!!CX1fu4A5^fJ%y<-8*<7zT#duEtC zPZs?I7TJLn?Y6ih?5->Wn(0y4h>VI9^jaW(6`!8RpexBeH-o>N6J)&*5cvK_lD`{o za^BY_Z*11nUJWgt4;~P!$YYm14aXeL?|eGL_QjYfYSUZi#k`!NmVoHbcboDMy_Ro& zubVfnFMAwV1H2_=N|Veb)wX6exh4lcz5A{Gr&sqW3$$xp^7xObu<>#!3E*&ZTp6<(OtXVsq*6=V|EkIHDtc} zqVW>PjZIGp1SZ-^lnpSou^r=tS zwBJ<N#mPu#e`|f z75M%I&l%xaa^b>{-mMFhS8~ako#gNSacl4+ddbZF=G9mC*YE8fXxHzITyp0N$#3A~ zUv=(!(+l_%-lOi7^$S=}c*x+sI5ZEb?c}2}1YBb1U^=QbEKv|>t|wB~p0vEY`WGCm zVKc=+H9+J3!kD7?>@WY|xQ#BA?RT-yrr$m&KN9^m!{o2YakWC0miKk|bo8y=7#E-?<*or(Uo3`}g^LzPDR{^n7?+*WJVPoi!B#Bf>qVU9c&FLW^SB-){h(0GMJk^7hF{U%O z3=EVjNG%U>f6kid7cT;9v?T-X#Q-A8$Qyt=obYC#dFlI6LYL1>^ZwU4V1!A)chiRO z?~XQuhav%|2w@WP>9VD8667&O>8Gd?6perT%2e5OK0;YAB$*`kDt>oU z(Zs9JY&3#OIagbOV-)|q8vbI~9F$)o0p-uu74inYG1vSDWv5d|G;k(bt#-~ICk%B5 zQsFqe`E|`)1`=Inx#$O#XrMNc$)y~uj8&j68r_Z#6@{vwn{ymY)aeRhxC!h_DB9B% zNH8N|ipNB}dpD;+{F7i=Atv1@e1nTw;Gha}NO6m7Uw~_Y5Co$RUlIoR-UCD}kKYjV z{X+?-vm*j-4=Um0GKQ5ayg(nkD~t*jF>P#&8%a_Gh8&mS&o@G`q#TIVbd^`(eJmYvR1E*pcVrckA51MnIf)IE;vjQQItOb`W7{bczeE&rP$|t?R zx2d5cPC1HEO9V8)2VHSLzA^}$04U1`KXZA8c!4jKP}m4|ni|fg5N1Lo!8{P7oiYd8 zLWu5>Y=aEkxs&jAecMmX=kNNy$53$i%tW8+K-G-EEvJ&P3_Mv#<~Wit)wN%sccmLa z(TTX99|w*WIcYqD7C)2nG@5aeBG=k)LyW+@g_;R_reXQxTX4=-CU1AoRL1-qAVEY9 zr&TJd(NY*k;ab9o*f3FrQ2Qqt!H6h1ZZGuh3^Q~zkV;~mdg{kLy1tgPzAU}|dkR}^ zczYw)G+PF4#sx{T#5+CAr5|DN>rK&8*^<*7U8XvC1n(k$dG1!-zN`7uk~@Aw#FC|y z)9lhVj7pcxR)R6L92D#0PlL?v?(G*A4DJ+}jL4w~ig5enHc8qXXo`!-B#iDKNIvE!TE>NTvkp)-8Dsa#< zUrh;}bO4NxSl%S-7{F{ekkCLlo3*uD$Xzt*TC!K$f%HooJQxG+z;T zM7;JAq^EwX=@x~J^CCDX(SZz#<6xX`#%+b>^l*Q#7-A!7!p*sb5HJ4N#7=a`$vi^6fReM&+unfe=RSC!aynybjYXk%@n)_OTOn zC2uJNWwK`0dHWPsTu44`F_5+#CjfLM;lQA1!)?(3Foh zwU}uBZ3dTp5CT#2eHQ?n_5CX-GAQ1Wxw4V~DTf4)2n?QB`~n;%L1GBH_U$9OJP4R8 zIS&n?NRREap<5F>d?42xqW6bo;641ce@;~R@Bco%0T-b`J+NjN_3pw?8h=Xx*$CXm zu{r1e7BEUv!yRN8OwI_;P6Olyen9x!hT#9F;ly7+#li>=P~8hCf^-zl`Oo~u{@{TJ zAU|FyNTLYdnM5(&jj`B00i9S#2B+M=b&8N?LJkM~%NR~bynvm=3Z zhw`WDgvB=Y8)I;k$aLABUcD{_9=&cL19Hu*U&j&a$*jHL;qVhOaADh3Y6#VO;C}I7 z^Dl&#;LdjzJ>-Y4Fkj_8`nSN&wBb9@S*ix81ey^lfrjA*e+jEa5yVY9lRw0vaP1AN zvvZ-P-TH9hEEF1p_kwB8LbU>C2t*koKTS~dP~7c>g1rBf z1p<1wvc=4W`ur^%RGx*0c!?cDp)rVqIX!@T*P+}S-V3@QdJH8F8ObroGXSa2f~IWspn6x~#q1+&5HnGq^V!EA`T4PS2D z&bq_;PZP9>aM$|37aL%m2rT?Bo`Hihsx$&+t0FNO{BB|#vANL*K=X=SD0sQ?04YG2 z!N2QondXH$9K*$hG#l;;*$Dp<84uDRalF)2*9 z5V`2lgMaj4eqY;L=V&9)L*N8F{G1jpFoEHo%Of_!D<;AEUb%z5v=M;BweCo{{%)L^2=h<#Q!6>Z`yUf?`D^Lx;D0+j|2o7Gy)=n za|bX`U^3+a0Kn=XnamnTw2ckid<4i$2|giR%bnHPDPQ)K=h!*l=~!Awc=U7r>BJ3D zh)x@L^~at#$^NrJyD_#QL~U4 z8v0GhBP@t)sqyE`!2Jz~EeZC>&qfftceBtqL2;`U2Ac1H;C|8;ECaB)P3*$u3cU}u zqTtn~QgA|opY9*!jpJ7K)HymOj~C&K}kVR)?T^TBK!@u=(e`vbe?~?7~&>n=O7Fl zYx`wt>3HlDJ7@bYoQJH0Dq|%9=fc5flF#TVbD9xwIfeV1_>WBX>V>r5fr`KPg#c1` z^+JmFwayPO`SLpaWfNloVitp(=mQ~Mfadw}dx15FDAKJwf>=cB!w$klv)d;DIyW2G zZAijfyNBZBO(F20FQJ3oHxTbu%e&>(A^7=T01DPas)ChTE0eai{~fEEYiHG=;41LV z4nqLLa6iBOuXTV2Ltlwyg*Nar&)5DwAc87=4${UI*Qo>PKYh` zHW3%Q03bodmy?bvo&^LP9;ii%=1e|)Jwnv{go}Tl!SUItsianBF4VZ}Q6su7>+~at zPXg}dqU>HmRw#sW|Ke`QID8^j*55Ko>^o~~gIp9~S-zsgARseKb_L;S5r-^ap4Hft z^dRz}CqWD#*9NHS#wQnuyORMBT2R`)3e^ktxqpu^3H|&|R6!Z4(!foBo4sY$bbkOa z1%Q$aN62SOsRcvbE(`+}2^>2xK1vQsA#&m@*r8M!XFM)wX4r|B*xHDPBP1SWI<-F@ zV|$7_fAM!9fnfuzheNd=o)Ia+@8W@xAAxI}(2=)*`^F%|IMOEjPE<6%isl8v25wBH5h_Ax6g;joV*`U=` ze;hT%XtRMH`U1k$9gjhoOV>+CfwWTWtU#DClp^-UP|+eDX%ZwJG2HG|bL$AAXlTT} zU{WqgOdu0kLc5?S_XBMjx9e*&Js7hhu-;P>+LjfC#7xxo*(<|W)Y z?i^A5Rr+mH2o9#UOTV@2LOr$QucSTMrY$~09k5s zHs_jGqnsVnJiN2PY(P2@!xVo1glGx7ZhC+&BgJscG$2%Zi|$Ox*^MMTbsiI0EJIfW60I*qtqLVV z77Z>9iM^w!@zV|Kq@d=ZJTWeEvjoE6__8d6@K;BpAER^N5~6dB+;Og zyg=Y`Od)0ev$>)AFPa&AD5#r{02d#hrVs#{pbGvyc98p;==@61u`b_8G(hm;Pf&y^ zyC~r7b_8oNmYMC|MzW(VMG=@zqUbf*_4z)&jVLbT;MtPZ>t#hfs}6OoiB8y`si%Eh zaEb?D{S|@rBiel0w&JfI;880+LY!7zNgX_a%LlSM^|cX9hu|LICSw*jWPgnT$H!0? ze#K=z@CN}eLjYmE(9D(t7!0XO=$$JNIJE>$OxNmL1gXrt1>0aL@SD(opa3U#@g zeN_rqg6M((r1j!>XWU|jT0T*P3d|_hm8&Rl{h^LfsZAc7G%l4Im#4FeT7L{3=6Zx` z0^uos zhnoL}em^EdxX#&)AZ?KCe*JIB8<3IJs+em6&o#8BH&NaQie92n8y~@*B{)HF)C)8u zVWG1iCtgT~gZvFQIVccwY=~w*DxZV6?lt%^76`p;EYz$uB;?ZMJ zN**yTKucbt`_%CwNI{Tzx&7YSB0B~G8CA(aF+_Ck03cN&#JQH>ass4tyDCBeYQNSCOM}#4z{En&;A;h>s2e{4p1nb#cu4rnXRaT@{63+h z5K!$Ux{Zy9oB<0NMsy7wS|BZ;=o6B1PL5!GK{y)$=`CWe1=Z>i%N0rAb6Kz_f`bU# z6Sp0I4wJs-{Lhc#AzPFi7p^4mGy}&uVPM$*v)&uAeu5As#PW&$o__|8y8!@i40V`B zXiz>S^ie4zIO*eO)j|lRBcvY812Up^02 z&ZvA9@sx_%6|MIF5w>?m$SF9t0Wd5LgYz>EKOwku@nTCDp~4sh(^39uE{TMpb1BNA z!s&&woCsYduE!PQ5pF!8g;?te_9cQA5eOgDK2epI(0C_)PvP3yloPHF@$L}7A0(k# z1|IGGTP6wzck&&?keSYCleIw<;s@g<7o%_^Q9mE|5~6LOO3c2%hp>f>1Hvv-8z_l< zEkW8FsN!{NIwV56f=LNxIoMl@r4lB&Y8=dMTwUM|g%cAoLGe2rr9eBGz&%!=o{}N= z4?*0xN*&QF48^DkN~TfvLkT?qn8A;?pp};0v0m&EbtusRuL(pxi=V)))xYzzJ>I(UFeIy4JTL3&MC@S<(IKu(5^9fY>IfDby=R)aIIXlMeyynD< zhyp$fsW>4FT*fk7_z?|oa?c_%W%lD~u>^1@oc{ug@Q0IGQ@*nueWr3 zbS(kL(=#0wQMe)%z##un2iZIzp)(K%&cwZlv2#=fphfYZj0k zg!(2rUGz#P8WXug1^1MJQ86;eN+#w@RKzZd}Db0E&mV*W^M96Q- z%m?!spDO{y1$~dyBk@5@zeXhuZ2uV~n0qQ@8w-Xbo%nDLCQuM6=s4cEj^SlP&>4f+ zGr>$P2bjX&$s!Wwhpjr`f{GAjQ6@i^7usE-gQ6@DMUP*9}U$Y>HSwuRt`q=wIrQd|C;OmqucL}F6NFO7v%213xxM@&q z2Sts+9)Q|a210mVG9Dqt$xBFP+dOuMpdw(GZA?XzxZFgC(h#^nQSF2KdyfLJb}#Y> zVg826XvR<>hzX1wTp>1CyM+T@3GW+arIRrJtd-eNK%|C*a#Y3<2$Fy^7xCyjx&Cy# zGyHXaz~N%yU77i5( zvS0H{T50U|sCEu0o^hDA9`2yS`uoCpQa@Z2p;z_?HouJk<8*`3J;!3lm6Mlj1j=2U zH+uR?^Q)DI_?l5sg#Y5uuukCQTS)q9eC4+^Z}T7zy5rF4$Lc!hKD^XADH1jL;#gCu zVWppzqh`|aa6dQAmgeXY9id*iY#UME8-)O8|IY_o3vRLs|N9LaW1%knJIV{8$_^zv z1@1yM3Br7B^NgZH{2f9LYX=Y>D2q;MXT=S2v8#7CV?2Qa>_5VlMR!=5K6k9WnqB04 ziRq)N}@S6BUwDNUW9{j znjNZSM~1)9Dk{R)@wt}m zLgI1Py|k7}#pvrb68)F#cle$zG?ovYalpG3Dr#@`HR6mE7@CGR5J?GLbTqAC|M`U2 zsY6JH_V)8ii*3pFd435WR?Y6=p9a3ix5kN}){9NS%l7Yq%>OmIf4zc}YUA&p`|_GZ zDjoMGQZtWE9-Y~vW~iq@$M88B(}oe=He|V*T1@dl|E7#^=$tEIUPJE_Cs}p_dpaoA z^@%q5Bi5KO(bK573*6Y#484;ZaZaGA;>=ORXAm7CBFI5m*xt+*H~@j8$JM4d%smE4N3eLX{V}9pBJJ;8RMBN+&%L(?_PVck{68~ zl;r!0X0^VzE1NL3FNT2aAn*WOqXa}Zln~AkL(w+5UfElI(5Y zny>uBvt*BUKF0ivIG1kkZ1R5=;;1n7pKNlIKqJAPa3UYEtJ|}|`;ivKOs<%SJ~VQ# zRTzu-J)%iq_E;jtH+UWR$)nc}Q??dT&UkE`!eZc%V7d9h_-@L)mc>$2Orhd_G1U5^w#5ya4XH1clR z_Vl+^HJUtJ{r7VTEwv<1?eLrrOLC?hgbh92+rnaPLwt)7&VW(4lGv`L*xS~epN!su zO)#WW7~n@i8^P(ALI8%%HkToZJx^m&v$~9fd8Mv(Ut+mu8eCP zAcWbj6G00$0!#kY98ICH7Sr6j~$fw6JV>d`=(t1S6q@ZRl4}r_?n>B~-KzI%#)5?^yEh2csq< zP+^83$Z(ZBmmLlkcibTR@1PovwL|J%lAuh#7Pk+a`?=ClX&3Ex{BBxCT5)yF%F_Kq zA3jvS0As|6bAQx>Ig8f>o%Xp8BWOpE(O^Aoo*jU)K}cvbY;4-M8{;Obo{oX|rfLw*M ze}=-lZ{mTONzHGoqpu0=7}0&5AU5$K2gC+mTv4esbIX zl+j69E1rm%4SFK;!)}mIVjC^Pt#IkViW`pR(IJ(k{36&trU6jHuo5hFAOxN3-mOTu zxos|~lQH64&BsM(-<0&)tThXPk^W_du*rXFgyN`g@g-u!bmheoOu89swx5?zxXDy5+kgF*Y;GGlOWfe;%mUi=Ng@LK(1FZvL- zV&eC-A)fzhb{U-SmTs3Sf<2iF`iIH&uT?_ed3oH3`t@E$n{Qy+L+CdzSyagQ1Ed*h z7grjJVv58p{;|j~u=HU;-I-#ZD)p4pAWJ`V8ls%DX+~hZGy0^ZAX6{*GHg6Q*IR-7 zGdGu!&SAvXPZW*Z4w<+ue`R30>g}S-!<8F{XI2LICad};K-Mo6JchYIQt2euPrJk% zR_E4J+BO1;Gs)T=HUe!mrG`@)OTLp_idfmUiGbu+3okqmE3zHdI0w)AraqpI45tHQ zm`pvC`3edYr67gs;Zzj#? zjjSb?&zxZMYwcVulMEyakgYAxkfO1Di^2>DN;6Ne^|!K}&)bJl(TYo4s=f-V+NC7_ z$J$0L(xg3WQ6El3V1YU-nl&^U537K|&$;w94L)Ypuaj$WvKbA%>~#k8`%)buFjupN zbwc|=OpfT}hB((|A35~l=c|uPxbpA{Ve!wdhyqLQsIFA=r#>#|;qXKOeU}msfAAFM zk{+cU(5Ynifuhee=noZS5;pU@^xRb|05aoi<&8LtyRV(c^)C$Ch;#a7 z0&odP98Rn@0`!@`;pti0WOE(}%UyD#-ZRT%2;w{Tk6Ysw|70+u`{6@v%@=1wZynII z*+dDSg3}1hB^x?kNusWSqXE<5B;CUaCWGNzaA3Smb3U)Pcpn-c-fZYS2@gr-^n019 ze+2U=!6?N>O$e%iV)M`IO&L6gXa??<5#?maxaIPGTn3FGiP!s@Cm{Qx=))U@k$dVSz(AY z`H)?;1iWJ>iaPmX2%WHP+1nKh8D6Kiy$krHV0Ya6ng~bRaov+h$grI^7O_c}W!fY3 zIpQKBAau?AxmK3xBOG@jxV;#h-vE+BoJj%%9H?zAp=6?H$6TM@f20N5j8hlH6($_2 z*D%-C^}|>NAGWgStTue?*l|-8SV=5wZ5H2&LL5H2bGIXQzB9N(5jvYpt1w}k zJHB7>j)X%KugGTWu$;Eisu4tt#;gF1yuGBheV8(d6^Jo$XVSE_uau^air@3(_`WVq z-DAy36*1V|kt$J1KA{=cGUf|bvf^;_(xUZM{w|L6=W_DhzFMCmF60?6q-d2`U69fb zDxnA3$C&8L>(wP^r>LLt#~&n^=%{xn&xQ`EbllveNI1|z&@#o?+U92$?|giMw^@Id zKmQ=GLp~X!0L_#d;2KM~f4 z8x%wFLEHSl>OHw$zqQZy#C?+n4uF{Sj%B$6WKh zHl?v1@$(mnGs=GBwAEJwirPQqEUrmzXY!e#W;Z=lE5{?27~* zMu*~B8qk8(%;)nA)cgKD#=rb4$Vgcz*zBtvFpHan#wmAx zI&-vn&C+LOx!G-5w|l*9zPUqsg=MXc^=HB=<;?2XYJz0T9)_mSS?RGY!Y)h7tK+RQ zuR<(X*k=63r)eCXZhL>=Tnl@!MQLKDax?4x@Z?($N|Y)vH6>N!SFve}-ydYAC3epT zv{1a@jDnv!@H5=@Xu4~j^wwRjQS-v|tW)Zu^m9_rhHlvj(!wjof}-@V9qp~kU0JCE zV$v3e_rss(lO9;xy;zBaKU0X(tCYQcX!YK;$g^|o*ZB|C#Yz{psNR%ZdX@hA?e`n&ElKh)c^>_K;)m4H zt5(|9>MEBezBQ?B`gpu+e31U~W!b#h-l(;fv+uCO2FLca-b?VMN{@TnoL}6ek)$PV zA-{bKz2P@n2JRXr_k!AMoqrg3c~k91PrPLQ!(hal&02Su*LZf|ZqfKeA&I7Ul<(NW zlrNQr{pf+$iPUi??h4DMrY71xkB;7Q>ULVebJ6`;6W`ye?jw%a*>zgL5+ikLoE62R^cN;Wl#6fUBDT{DSUeVp8-A57Uqxbdphf#a$>p-Du5O+_ z9e&j;QAf$IrSUNhGB?K)TdHmvrJw3M$ZI~o2?oqcEB4NZ>S0V;LA*|Ss+-3C)?aB< zurh+CeC2Ca+)vUI?f=Xb799N(_7eWca3Y;5Jr67N9ow1YOO={uwUV5ks1cI^Z|_{N zx|zE1!+p-GA)WA}HLbF`I{8()hsmAn-l73bM}EDyeXWD(R2g>hHp|JqnA(VsQP5a` zs<*1RMX;0pk*&NzVY7-?P zy1EWIKMnL=esfP)7to4=xr+J&`sl|7vss)nrcJ%^zcx?1j=!%&1N+cK% z_hgIvSei3DeUm>#iuD@teri|zao2NK5&BbE->x90g&!jV23g`3kyZnRiMHHK>svlK z9NQCQd+T>VC{OP@w#gfG7LRkR7R1i|_ILL4Td!JBF6uEGX&?7;2v|P##UfU^S@)9Z z#Ch++i(KJifrDvOS$V?rgD1miyN(+s^Zqcd=w~=;$`_Jvm57~IeRrZr>%;ahe4h@H zn)GqHr?Sb|CskzTRd!WT>{Wd-)>dn6_5SwZ8=F?rrbkYz8h4)ezHaL7dT0AZon2hw zOL8n@-y(PyaxG@tI(Eyx$hsW{&Rz8r$KAFs9TZRC_B2sBVW8GAurDk>e!CS6BA(<) z>h!Kr>oa5RK@ZlfFx~?O3UMDn0${Z11OiB$=OGcfM+&+tJQH z?=^Kp)|s?TfX+Te>*7UBY7fVnRaNFlp^fjy>ZBgyFTPamy9yjw%K|^tXs!mfS_I#c z+tREdIVUyKqUw-$EL-L)*_(;GDr@(S#9FAY-ZxaM@@UC(N^-^evx22Lw4MLmk``xKopOZaL%oVao-jY{ zvlHxx&-liq7L@yV4|)8kOi7e|P!L6B5!dc>!YpFUqkC{G2oDEm(zq{gQ+AU1T<%SK_kUZ1a}T^_AjiEV3hHF?`*s134gUNQC0p?HIU zm{oS8EUx<*ht|IyFi)w_dQLam{1_X-S^lbW@7R)E)*qz@1wOtVe2qXYb6fK|>@E6` zAna^q(E;6)cQ21H6?TniF;b_;)xEX(@!aSJ$l4!q22FBhLiYVhGl)W6?>eE^8o2@9 zPqw_jE*{;JE8G_1SEpL?tzen|&I9M*)81v;r#r_B;azP{;=9Ctj@WoV)KbZY-TzM9 zn`&td`x@eRPPKEAo&OtkZ&LJ(0CQog)`znbe`Xqh3#HTlD4pf!Rks>QLIRj~9p0`} zb@}$W{o0qc)W0u-sJni}=(EeeqvC;l$Br zpC7q}S@$m}VFPi!jH_-xIv!z5@3|()Jg^n}9NLn#SJGwc#jI8@Q?T{okg2thY~9Ib zNs8R9B|+F!p~JmXBGXs?P^ow6`qEoJaTybfP+xm6PVKF_yy{b-5oSGdM!()LGC4ZC zT$|oz#0&k%i_Xs14zn4lL_a=6XJ=_+2@jPd$~GIo@8*45Gv4sZHu+RW*DhWgZDG00 z)0)99!kirx_j&g#on3x;yr-KEnDf5Z8jt_g^0Z9Lxv!&Td*y|jkr~=aFS0fLr-a;S zBPI6_-d(7CX(-a4sQjRy%{bCUmAlMDHSm6KiqNNe(jq%s)!>xVohtX2RQU%%==IdEhO~55}g7(`U=4ync07Hf8t6i?h zRQo`9NA+h&xAc45 zu4Sl3Vet8;M!^go?T>}LDovDcq66+in6OJ|>#VR{0V2s+4={#KP{VX&1HJRo#rw>$>g8@<&z1$ctVr;~~c~_z!4goDz(q z&GOmysByH?I7@k%OXrwRV|1-x2EVKZmQf)Z$Ceef&3fY8F4w!_4>fCYJBOwPU0(i`MvG*BC)rtl_+YXc-B9K@hhT?$Q z*skFvS14cp){OV==_P|ZQC<3$kw;n}jI@h41~{oCZ%kIOrKs*Dn{Q0ruk=Z)ubM*p z?(#oGe@b_z4b0=UI}L25(=7S0S|hCZNkQ7SoKcp|hFMhImpaeiS2SckW0-Xg{*S5L zzivxet3h9SVry;mw}6h{<_S~9ER}{?b?{dk5%i%;E$P1y^&L!GJ+p6UhLxf2fHA`J zcwMb!fR(SyjTF67U5fE6$ZX>NWvw>3R*a z#x4D4kG5rce#bIZYgv3_0;(q3U!GcG=P^}%J>&-613R?(WYx_xozbj!-A&-aPHS3o z(MQ1fy;%l6YjZoH%jKu2|DPK4Qycx4wxqi>$W}IwpFNtvb3i?VREpw&x-cVf$e@X8 z#Sq(|39whvX6-EBMW)SgN0OmLT1G@feMHdHgaUfzGrC#IE!;ZCbo(X+V$StlDr*y; z87RuIph_*5jciFjPD5bA$sCQa>Jtx}>g*o{?n+I+Ay`Qt&meaaQbcQ7jLy)jDrDc6faf$48(Vf zWh4!T{r!Q&kwMy?4|X&`$tN!k)(in|4mz6o#|v zI0N&J_tCZDGqVRXl?OaH)MBSq8QMF|w-oL9Jp-gn>B)zsR3ca8JtyD5)Zgmt zbf$ltQ+MgAM_YG$tpcO4-^RN@KvPWJAgAJ#;#smITW$$`$~*j0-ET&e;w9pkX0CaY z%VmRX^T07$#dOYjJi6Aj&ahh9+CHVeAL-}Xex(oBDx47ZPEW<#yh3txqk~Vi(?YoS3t{+>}Fr3w50n_&)(LC&7i{QJF_(TC2G;ZgX=WwQrJMev>*Z%+FD zS$4d6yp7PEfjD72h=VVi!R{CdGT0!uL7LH1{Yes9r97TD*0f6a?jS6LLE1r~^Wmdx z;dsYJ4OO)gj9CHK(&b*pd0tD0sf&|TUg7h_CYUO(z~D@Y>jxbQv8cW_rnRBHnkO+G zx0t)M&mL=2DZ4*Y-yNbXU*{P9?%qux%dhVl?@NB0R7x)>KhAlAZ}bS9u$+Q`m{(VLM(P;*!Ts^v90N5ZSI1$E;LkLVO7~6Am<=a2-pIk=T_Jf`IQUaY{@T+> zdtK&A9lp9&;P{kS|Hs1n^o|z*;T^`Ct%R-wZnI?4dYr@P7{K~rV@bZ)sy(7~7P|7; z_)FR0U!p9|wvh}P0gFRk&8ByG%$FZVo5B+BDdir55%(EBi)Dr7(s?XAqsH2}c&0VVXH&h4;B90L|%*ze$wm+N~{P-Rnh9TZP6(#yM?`z_`75Dy{s83fKZ)SI?H`T%VKu+=l)BX}YK=zsB6U$|gOwM^*b$1E9KG_hz zJ*d>T=^>#LTqvVv7i!#c)E}{aC?4Vc+SIPPxX(W(5E%`n8eTb+j5_p^jEA1O>?Cwz z6ClpK9fUcd-4_#aTvX)jDLl<>2#U}ULkrT9?J?oC?KqiW%ps7|^CmmZ2!DJQ+nAV_ zp(lO-lw@~+y4CC0^i)0Zy<*O1B*Wp;(W*GX1Y47UlTi;Ae4{T_LgMX6(29ZT!I`?; z?$mvCIpx9H$V0@}a(v@IJ>u|0uTf%Xyiwd|$yG1Ii}Go{uB#t)u|LzTQ`q9~2UBIM zD?6~I=^od`B>`-uN7r?>M|$nV=f<`91oqknY~|y}Tc2mK_2s6XhIM+5)hX%K; z+4=Rg<-Q&3OMMLj>jErY((7|gIZzaNAT(@!Wn^gm+56@_eIEdY#Gq# zQ=y8OvLWTcMvv3p)4jcZ`mwzN)65pq>~pt^7W9*wO{C+y^w>=3&b~R6rMA*zAG?|K zP3=K-6H`I%TY-|o&yRhyNRTtXM_VPVk!>bod&lqbp{|<)`Zw2?&I>D_V5rIrQG*MCQt_rQ>;0jDH+{i5GjN4dp4wg$vb<=$vBAIEBpq!sq))b`uG{BWovYaENG>;KSD z?$X;JR$jTI*K%gJwDY6ud(XryDebO5)`3m@z8fKXe<1yc{QTh+N@g zYNC2d-WW=jU0&vwUZkr-f7L-@WE5et#^k^^7&bVg*+|^ z?`6{HGzNu~$Ah#qYZ`Lo0i?xOe>6Br+!D9)dfs(tri=DV%l@D2wVY4yBy;l{Puu(5 zj@n1_{c$u|RX9gHd5HLFj^lsA$*TNlMARsFvTfgew{oy@^EjG8skvvbX1HZ$aB8yK z%j91r?o1aSC7kTiJn{>3svU0g2=v(fi%JPQMg1epG2Xp8YIYlCc!NakgV9dX=+lQ> zGrN*!Hw`>~^DrP#W~<{u;t=`f4yWWzU&dKpi+cQV{^GZDcc&+v_9OP;=4b5zIU+RU zZMJ=h6&7OI*n7^s$L5Wat+BwzlErR@VzqZ%%@0--9qO-Ci*vZlO^1c`{Wj{oC}qre z1VUqn_d5+o^91KSlW3GJ6B}!BU|>$Ye>Or-)JZ};G{ckS>;vEZEZQDeqj;~;#K~bR8^>!!Rx#ZvZ3-{;Xx}km zo;$wma^8lrCFyY4qv6DAN9?R##(M_cr+JIMCk~RU1d)6gTd`*qHFD^gd)XW5v#FUw z&;OSBr5oD5Bp*b6Wlw`6{A-Fwrerr#xG)CC&5UGC;qcG1{% zCVh$VlBB3$-CA(%I(zf_wp5l)ab!-^iR%gcg4gw)X|M@7{CK~9FIBi4J3xA#fA8(H zF-MO*Jju$${?5=V#KcQ<=w6Nl|EV17icO>@uiNj3jC$eSA9B-FwRRe#F{=MGQF}hl z@pi(fU@f1r^*)nq-FnB83W}M-Mh`Ok)h^EeZlh3 zCB-Cmsb7v`mQANojU38*GD;q%-+1gu$Nhr(X&3#1yR0rF<7?;LId+*0zrOrqEsUtMS<1|hVmz@-Gn;fOeOv}%eZjsgb5l3c| zH+8A6tC{}VRSSCKOn5z`A=A%%*1Yl4?rT?XS%jIPXYb3GW$M+8RbN*-#oi8gyiv$= zxjy&Xk(X6Z1OF7srZ$y~3jL1K$seV&s1f@l_L^2+zNOi5`{kkE?vvLn1+J%Ew6f*R ziS)XQ&nqYIbzNK|BanbrL3=&|NT9JDCqcxJ3#mA1k5mNb zJ<{WtW$GCZyDKeMt9P~qhM)PKnL^*$Ca6P48R0VaF#2k)xvR>az@efiS3^rqwd>bC zaClLFu)(-4_nzY6vELSMz0m7ZOgbzj)z$jZt~Z_uH5}h%#&O3IvlDrBV)eTZbExgb!9NsjdObhq z_|&N#a%a}IQBuT3*bD7ne{%hMRGQ`Vh?Fk(@Z044cR?9!O#1erfiA34y&@U`d(3wq z;aK!#m|i!Q(j0nGVWPI@dCX?X-Vx!dny7~8&C5|uo{Mu`SC$qlzGoCo(^pxAeLMO( z;~?w$Kua`cUQ-sVr1qz-^=?GsOH+zn_Wq?L%oeUU9=yF>)}{EJ@k>YMZ=2PSD;~x_Q@VsjawnPZ`*#=zv6W58ZK63P`q7==b&T}Rm=FurahY~e-=^9{ujKxgb`I*Y z1THh}#5>v^#ZQH9OD5itlxV0b6K6XZs55df;|hDNOI2IBM*y|yA(Ny)S&1z@AEQVQ zCA|(h7t40-ngZ#jsI_DEw?6MTG;QJClR|o9JkBp%WApU5nT&`OLo$QhTH)|W63=ml ztn(=>UuL;X#6~eQriZEwf|0Ag+zuTz`=TryKqfZ%VVvj6%4KiIH1P@}&-B38J=5Q& zuKkvbm$r@lN%m3ik2f9n);G%em)tO4rPDDcJNrK?_E(pl$Ue_4P#HnC?frIc6$4Mp zuS#5eMY6^xwYj`LF<(rrB-j7W@hxe;S4xxWspB{A@8W$a`@I7@leVXeO(ZUx&ZEil z6xXq>&bMUK<;1pLc%I>v?#kpO#Q*p^+c@iO4I9rdHbv+5_MAo?O+ny&nEc6zO&INI zRVj&w0quGc%)6FLZmWv12{>p!FBv*e;HEKoiqm;V#cS2BB$3kd=d`IupW9t{Gsjwy z@5q(uVIF;jrs_u#cZ>BMQI-r<_g0nT=TC*%m9&>*d#QqUwcc-XcpoXDlj`(pMO|cl zJHC_hgWX8qZNV;LuEhqMNk{}4NJzGmkdQc-30T`Wn%%VKcerCVe(jEF-*MVCSIhPC z#p1Drd|Kx=PSGRd%oG#l_f*YJ(1#_n9o8NST$vKjjjQasQ>+-xu;p)J@MeNm`+hDat5L`Uh3Bn2Qgi%b~*5V6W_Jk-x9#seCiJEO((gm-N*suMy^o z)VhUDX~7O!d;ziQN}RQ^m)KkR!n0MEhMPRB+y{539((iPZq`e(pT+^-x86Sc_R-Z4 ztzXd*Gvt;Rbiz5Sv7V-Y`tN6!Xefh&PUqfhx*I=Hy7Mf%W6C?_Gf~RQ)m*o7Tke(_ z2sPegOIHzeGWSxvXWs zy{1$3$}ZMFyZv>`|Y z=%?h)wCD1>ck-TfbGO-6tzb|tG;Dlt#kF*^n4V>?xb>S^S3&0kU)t^dtTKFy4L$Yp z+W7~cDa3*~>#*%(Rnxu4x83>8ApbJs#n7r*1y$z{_C~TC`V-&1@4maY_w6YX^O8U} z+g(*wOl`8ep`m#)FhgR??|M>l{M?WNQo}x3HPITqc<<;%Ga_YE3^%hy` z&$O!c9Y%6JB;T2?Iz6xWDLo)Op7QN`dL8c)W#{frjV|AqgNwI%#(xzBR$#12w%^IF zRd4zHpwHw&A^op*ll@!EKA9A2oc_qAouTlx`k`dx@uFj$Kl87#UDmg)VLf#H1(p4; zk-ZfcTU9B2ISYN&^djdA#0GSnEOU67&DN^AmEU#<4{NNjf0-n(fdnTH4h#>_4E4tsrYS?a<4v?NY(^Dd3#72>t|x| z&74%)9e$4GKume&upw1-uYO{+TnIYip^~C?T zu3K0n!`B^2LShzi+K-eUGu&fq+Yz03=4JBU%SMlGIx+1Rr+Pufxl?}AO%kr$ zMS~SA!R+m)&AzHN*1-j@GAIJgiywOa5t{8Uuk9%OGdE=~tm|U`^gFd@g8h8L>I;re zJ-UmfKbD8$bgQeKE$q(39xwkk{r=sm)u;GJGaXeQaz1&^rK;T*-;`$>(;)W0&}6+gdo?&pUtyTeOts0==eSQhvFKC zo6G%}Uv4dtW|*W{9iRBP%4*lWy4!im^<4KoOS*-V{^8P+%H6ATT2f67_Untwoa^JQ z@05D~yx-9m!*h{l>Xu_gPv?*Ku};_`_w=v1W9;#P0qWA;jTSnBr8RGlBv3SQG{`L3 zxUNaDTYhe^$fkRB&p}&CY)rMmM{ShUXp8RWhV?+;tS$J#+2U?v^^Xrla@&{WezIju1K@r1#sq`|MCy-fETZrpF6JyI06E#ZL0rxhdT z&w(84_iREL@?Qy_51is(h#KM;T*5Z3x>Wo)zc-dL;FV$ftCD9{;St+tn&P?OUvqrF z!_K7#Mp(1;4WW|>6e|yOx866}{FH*ReAwe4ZAs16ZM)02Yxi~=n#$`XPF|?0qvO`1 z;Bxm0-JI*mts6;mj+E?!&98pyCRs(j#9^Aif}JXxsm|?8rSXulzqE5NPmw1Nr!4-z z6wl7B_@8s(KS`S40@b}#U@4ZR{7<*jL^)rSYGK<#3;;mA+KAo16dw2HY z>7S1Vwu(HKkUOAM^PVp7os3mh=<^*SyUScd*_6qTlWynApS7XPR=s<+J}mJ`zj?%w z17dkh?(V%BT=qU9yQ>cudU7b$1nfJTsL8c(4u6yNba-$vU7$?rB z>KdgdcDK5u;YWhtVu5V3`)8Uqx`p#T)HI_Wo<(|zmYB3+t2_0%z<09DR+r8)eG8#X z-Y)bxHcg-7iP>I%%_Dcp^^WM-KP@cWdL?7q?5PXV2N{l4+D0FUg1()^9mF%SB307xN#n2Oq^WJ#v0^g0Wnt zZtLc6&1No@k<3g-2dU5cw{2R9eSdUJH8XKx)2&bPGE!p8$&*8rG{6?*$qkCJy9VP~ z8x)x&o?At(EbSU}Wod|-|FSU4?ZsK=`tw8+3;Bb>A?X8COYT_1FUE%3Yn`v=NuO7( z?N@VpkYcyLZ~D;cqK88)i(KUJ_f2#G5eWi~cB_$V>9-#XlgmpzxBNWRBwVef6qgX< zN9&SbRct~pba32q_oj9)es_z9o(4*^ra~5L`Sdsug=|4rWgk zlfHT0dH9;QcVoOn*3FJR-9?Sv$7B75NE5;wrcUnsl-t(&#EN=)uEw8>w_|ep&XYxp z;0qDjk4TxY`-=(77uoCE?kvlF{u6xtT2T}0m$f1ph7vKlW6uJnGD$|>`M#bG2~kMc z6G2KtBI8l{wM$%`^}Qoqd8)1gWsE@&F?(0xH_ErSHjX$(pQZ)yqx?e;E60CdKe?NKM{uhW_l34--e}h#-I@LyDLfl zc}{+@YfXQRF2K|6&MEa8L&UJ+8VAx0)F=(TBv=b~2^(h6CBGCW{mdzk-0Vwd!z;i? zg!lVX{d$f$BW5&Fh%ri@k2FSUtJ6;U4$g za_#qBr_rZ4gEDy*!PNmswcVvN#=CUl@2(LnieSsn$ok4&V`IHREUR=2$~N3d?&sX-0izOk>($h?=DD7Yqdjr@_hKX?omM<)wljITGzzJx z#XE0h(9&k~`bO?)!alb_o>qYtqdHo7PXl*|O!QJ2^0yyCv{rx*sW|G;BmSXEXJAfU z4NUjVbnu9NM$IH_(dek@3vo$`P)ZS@>ve@c`TXcLo?#((kR?k-hx4JKogJwtl*6#D zwMYVptNmnMtD^ z?%b}r=WRKy!rT#s_9;|tb)YF$z~fyyC((w2OViT|SHD6hkI7+-9n;iv`;I_Yau?QmjKqDm`wH!q7L{N;kKQUu?6a_ZUCmI*c2|^(Uom99Jb9C2T%4vLn?l z5t=vxUr~a&^jW3BG@$PMzKM$o%tl*l&8aHnHMjYpS?D!VjFP5GE|I>hjYX}odMY%0#Ak`X-q;x-86L-&{xzK=y}nSMzJoV!#9Afd|G))@yFsD~&! zC5wkB`>1&bTbrL#4lpUc@phY6zy1EobxxHJjSKV6IP}lC<*tpWF4g+ds+grcL{&1* zI0Tzk9diD(EL?*N-&Bv&p*d*RF}8}I|K=F z^a|0Er+&z3;?vyH!dMJFP#$y8P(Ejm3-kNSPb>TY&iAZ{V`<-UB#*vyMMBAVs1qdm8SFmo&!3TgaV0m;C&uA$ZMrqRhrW__5L{teO{TXV?=PTau@Q{||+m z0Z!vXN%azBy!E2yz3JjXQ4fbHrbgTdHry}rWTc^hdhZEBOdnZLh;DNMaxk~e!wMJY zjCo>_dvm%pNB|=golS?F^Zw^GdqrLt7YoDg!ScoIR9SCp@(TIBHHrm|O?SV_H?r~* zhl($XoNP612V=C!csT9 zzIPdn5$3VBqp1xw_6iP{xJ`&jon@GQ7D%0!6?yWO1>1?Ol~m8W{Lj0oi@)_Xm-P)x zy9P-ryrf80TjSgWcRI(Ua6avedii~6^e&D_9|`bT!~MRBY~!X2=xJ3 z3?e-XtjP2W1o2(8S2*Qo5dFItN}(s7^~&sg-K8^%2wZx`i@Ug6*9@DVKL}$R<|2-v z%;oN74Sq@=J<9DZ-KH>9!Qa{U47DN!e86fuC-u)*u4H2h+i5q(=6XS6zBbkskYB-} z)4xckP_j4TRQ~kAjjmb`_<2-a828jfCgkEvU5?Jte2@(2lBIBuds%o0*J&idK(4@_<{l zR9bV-6sV8}Jo28*|JcPBo;7fez@%V$S#Y#IdPMPh$)>-s{N&F1tLfLTYAs}xSqf2) zKN`Z4YmihbO`BC1s76wfN^-?K;v#{yF+XvGF2N?9foL7w})c@gsT><8|_`TkzcoPbfr-yix6l?8d zeA=aZjkG^3D)p(ngXJD$!_2h$fbciSBZ9yb$YcwQA|5EHHoa+9-(^oT=@OH70+0fI z?BMwo?xdZzf}4N)i#7lD`_CG7$Nw$ipSYP@S({6~txNfQ9+MuqaiMYztYy5G-MQ2U zrGg_@IFiw$QXDs3Lpf2=!f!!jWUj%8#WG?bskxgL7mQ#V&KBV|)TfDOmkkozu(nXy zjNi{^ZoP7<7)+75U+K*w7p_`RmNK@UlHnx{k{L8Cz@urgQeNaBwI*v?in>~X zQUZwOEyYL~WsL~YyiRAgT;MqGpKhzmCw(a6 z6vRY@))v<6#1anCQ`t2#TrZQ5((>C+M1$SLO|36o2v0|#n`(IRYgo7*WfW5FOU0jW zi8Xp~GCCyF4hQcx%+IU{=tgZBG*KxKu-WJ;B&@M*1-^qnXtl#_*Y-PdTE0abLg z7hg4YYHN9O#O=p+zng2#{hZy7#YI71e3?viqKhLHZF)U~{G~}k``0&RQ=ET#3XRbW zy?BlZ6Mkj+u!i&Nx$x2OD`wQSb}WRIu9xhEH5N*4HulzRXsmfgw0cp8T#hEWEU1F> zP}=+xX~z56Cs%sWdkpNX{Ds_lr9DrdGK%1G)-ByX57>E=*AJS7RGg7;J|^%ohZoaa z$d$kHMY3z#89$Vek`A~v+Bd=ZjkuK|=gTxjW?28R$ACyYRwt24w8zm||M`dJ1I_OW zkr2LA(J}ols(FMOFZ@G^~PTo^@zgCiowj)ux~Vk z!V(jquqqEcB~}*4I|gT`v2+-h`!^Gasgz4hBa>KtS9Wz!sKCBa<<$UfWB)egOl~fg zS3@P%{j8&e>w8tw+^hC4O@%ez@7Lh~(@*8e;!QUJsn+x)Vl!E|G(FpN+SmZ%< z%(?oKctcu0!=Ld(L65{DhcvnH_Eb8gx1S!wZFlyRxVn7>B5}QKA7KS_^vL^4PDcok z`V0nk)YgU|X;Hu$py3VOeaH_G^Ra%3zb{133<`2Sf`!x`^D!1ugmDYfhK*Q;NfR5{QX;3{74@3dhQI%fYXQ@Kkq!MSd_B^gt&w1& zcNj4nAYA2I|0L+a6-aGb(4mi0)y*O+rGa;!a!lJI!TPxvY|? zk9Haevni|b$^~?MllT?hx>&)csjB=`0f@BvV7{i0Z0XGJ73BDGq#NQM%q&0Ec`T{! z8fZ0*2S2PbvD+6bAk-Zvoh?sKH2fZfW*%JaIFQ!~ai&I3w~d4+rmpJnf7;G?n-g=OU)P4aBw_VT(EYf@ejYAnKuysG8O z4+S8WFml@Uf^SCM2kl2UpnIwm2SFAI)jhE;K)Mz@H|x+q-pVx}Y#;h=$Xwgnn85N}om~3kqP^ zNAYYu0W$`O%%M1s(AQJCCa`5qCK=3VBfH62H8cQ{?6sj%lvX-wqu z5a%kQ4mNz9Qh@Y!_;J!aqCI-|V&0kW7N1-nFA7@%n}(NxQvicg_|GP86(Nini)x_tu95{C}b1!PI{ z#4Ms1#)n=Sj;BhQ8jjjpoW7!$DDYf0zV1qu@zBOmOU-=FzwFb=1c7O>y=_h z8!MJS;*qbM2;&+dG%3&5z~3{9)(r2O4e(5KCFo%J>1CC|sq@Rv@bm_LGzW2Md@^vG zQfmCn)Fz#OjqgdWVwOi`dtU^xOO=e{Xhw1gNBmG7@qv{|(mBA#UE7qULdAdy5TgJBZ>7Is(@k?YOAbABA4nkrlOy<+;431CDg1c^mO}N0mSC)^8H< zM&e3?&`=r~S<>A_Z9O$p{gsU(6LSv1OZgC1&?xVXDNiPvqzWLIAwa&0<%?h?O-g~D zJa6|bY*HgJ+YC>XBh2qbT97kH<YBFV6c!>(5e=(sOKGq6x|usI$e0_^Y(} zv`Zt*x6f!t9m0`TjRIQM9MmCvrOqs?!lA+Fyy}hTwK#S!2j!`h?Hx3s#Cn>^<5-Cz z;1p}7(zm#;=fr)x=Z89BM@NekF4_A{ykef`+_tUD3_#1=szP-qC-TI5Ae|CZKhK6>BAyuTY&I+ `!&_+n(E zUb)C3L{||uM5+c7O!S*n+a{@b^}ccl(RU5J-&temdVIwl&X%iAj|WM~c47{aPau%y zK807fAHCxflQ5{c-xo!9(tV;mv}M0Sx%<2z;|x+QxG?LuV3M)#Ib@pT`;AP?{&HQu zIx5xo$F-Qy?nUKkp;?qJ^3Gxh1iH23GDi=30E;$xM zAZfl$$S!w{sxJ;o`nmWRZKi~s__G+KD1eh%{j36qmt(zm`f#_0 zm!dY1E{qAFo`PxF{G*+NvWQRm#qaI#u-Yp9A5Uyx@eBipbxDtQ?1=X`F$@^tw>LR6 zuI(|wUYwQgKJl>EA{?~4LC>P-1Lyjzk)Nz8kxX_TDzM3ViW!?Z$cib;yW;z26$kDd z+q^WD(SoiCA-$?Cdf>Z?Hl<|Jj&v>iyye6&zMLb2rYL_Tv9RPvNX2iWf6|paIy&aV z;9cA9G{3{*AmydxHFgew4b|M~F2-y93rjz<<#&J9iuP@s0{$m+LC@8*%neBK)U(SxuS>L{mlNJdgxL!^?Uxt2ar*pu%D19un{;a5>LKuj9gU6mcUjF z#z%)`1GZUOM7R&Qz;?h60|kKqY}dg75PreH=K1SC+|(%S<-b@^%wTW9=)z%CqMFVW zmQ)nE=n1Gw!9t?cCHEW|$`ahb1sn^{+Q9!$vOKXc zQ<;a|g*b4jSZUMEF^+9}rC+^-_@t@F3mO zD1Cq9Ggn0NM0$|&mfnA=R4M7v=ZZ?Ta%fCc|Egr9E2?^x76z6^D&;7AMHNvxE=ffy zWswLHm>Y%`Zz!^6DINh*t6Kin6P85ZOqfN19>BXaJ=9E*XxZ$O_TE!YFB7G(igm)1 z0Ii2Jh{=O6KqZihM?)$!_>#dd#+bwxkdbxB0T9sq-9)4ar>G>AlAdN*%}o%&EGO*p zDrRtnePM>Ub)Q&u`u@No*N8%w#SBZvlu|n-#&50?=GK@tpV(&7y@H)MpS3>!Ow=%t zJo&l}fqfWY@{}Ab!LhrBIMLzz^3X)oU$sZn&u9SZd}4?Oaia}(`rg;NzdYXGZG~~Y z+@1e@-UxZUE8}{;dc5C53Nh##9u(D*dUB>4$PyUw?~GOe5oARGeE;K*&F#y3@Q)Bl z4+=rNr{~{~&n8>h@CuUKGmsB|exUaV++Th7yHEU+=!PCecDcW{ z(hKss++T9qPE#1%R?+QJsv<r7QTTxrR=J_KxqsiFwZN_PT68K_G%8uNo3|Dv zDT(~aC7U5e&2p2XTInb1w7!oSTbg#=@t8<{B)>np06A4|wqziDwuB6usVHnpuZfHh z1?=;U00|phpJ_8h4q-ft+f@{LZJtAZ0s+W}tpDgQ9<_z!8kKN7BU)VWU_x<8)9|Wd z4T(%|ZYva@g{h+a0Lz(AtQ4hnN;<{$RMSL52yT=b- z&k+I=Xpo)r@qnun9>kHibbeDfgHK1Mc=)K>^TO6VrgsrDM-fTgnnuJd z5sgUAPAGrNG5Z2EwrK>7mzEcF--BquiN9`hMM4hWE8&(SS#M(V6n&1)ai>b>@vQ$W zU*bELf_HIT!Yer2S94Q#!WZlC<7?#*Rx!K5ws7ev&V6nFrNql|PYc;=t=UVqX?-sA z9tn+=lT0aYWB#spoP+c+cLBO$*tekm5{{;7rk!1^Mvr0cV0wo%ix*!u(pymB0e4GH z-{bbU@}^>%I3MM05^Bh|tQ9>PeB-?W$DzF|XqUbtCdpAu;D%Xp^s|fDDa+2`EC<@e zuuq|9)(K|I41TQ67e0!cR5Itfu;|p*u_;dD)-Z5qTUBl_DHtH`0nN&Fu zkrN60NO`-u1v>&^?QNP`jm$vA#ouc()|)s zky}}5qb>Z!EUsn*kL>k5g*TZ@I0ZUvq#7ZV8V#)}N<_j$^^!tn>wBW2#hcqJ7JAC?=-jO(x!gp(}hy3eqq#%GZ!?2`XJnixe5 z58!#56?JU<*-wZdxDV$0-NNnLZ;T24zYjJ3neaO0&Fod+F$t3_72*LsFrRgSx!LtN z@6g&2bnJLM@vOMsQGN3oO*G7Ha#FlljS7VD3tJr!9`@oyh5PW?6Ay;shock~a`In0 z`~Ywd`z_yi6Jjb}KdQN*YDg@p$)E0n|dPu2Xs(1DYEM?%-6{u|5f( z`^W1vK8aUG&+guDE!#j)yUg|S_dil8RjkNuHO3$YMgJCw?mDXFruz2j%W19CxzuUO z8y-tEbX&qtXbUQIU(zjeERwsFSrwUSwMB$;A7T5K#z#L%uzItJ4C`2WPK*i<>wqjP zKh*u&&EBSGYyb6G=Q<|8U{aXk71sqN9Te62n)q?>CeATB-E3NEZ(97|V_>APNJY@8 zn4_6+BSH(O`x9lT8tSlE(A=Ld)84vgI13?h!NIfP zpHh-U|9K&et0v+KF@8u~sFf})PtKA|2cqz3A1ihW4(0N*)C9H!!gTS%h(ShY)tX~< z_J9<(7rWcn#hN$;cNW=Iht^uEib!%PGMi=I+V0BRq^Ec*ZLy!KStmiGvH0_5LBg_N6ZB-J{EoT~}q#S!RB_q^yAp(^8@VN~xJ&oXll*;e=lkXf-=ls%rqi%nrT9-HjHb z19xxJ#P@H%a5{WAMs>!|j#*7sor4{+C@zy&y&oe}yiB+-zTP@<3jEk#TJ7a&!vkW{ zmr1gKm;E1a^*`Rmv46Y{|9FG`^`+Pb1pCr~tESzQvl3ozqs_LedJk=QV`4G<dLRUIF5SVyS9PC##>)av zGy@le1-W~_TDP>yk|`-9xkQt!#8bp*M+Yl&?@_%ymobgW%TXQYhLhPz&x0KzmJ}^X zcai(}Q|&(>dcp{|Bub3%KZayf*RnS+gpo92f{cXZT#oZNGw|$(;;%YM0RA7EM3?AN z(VcWMD0%343s^wA>4%~OLX@GfB^FNz5YdO05Ho8ADT{GaZJQa20nA4U04G-ap)36( zqKLJ@kYOSnX#gDA2Z|r@q@=gARePWdKal0(C&(-cg;OmF6W|{Sxn^R<4$pz-RzOKz z<-3_^EH_=&pJfe^${S}_Fv{rXZn7|IVAS!l?smZ|P%heig!y2+pAa-4(~n1fz@3km ze8eJTSqhyWfAzAm%Y+q*mmzz6dNs`3T@5|`=5CM0&}yv{{i>4pmRwt~<+P8pSE&8% zkF@Qx^G&eXnsHI8!%+T}y-OwzY3r+sRR@W4USy!b>4;+b14Hek%ocy&?83f`*YM&( z#4cWK>UGI|Fx@9^dnAyObO`&J!i34`ABBroX?Y$Vy-Nff=*L-a(Si65_BCWDcg@SG zn&c4MEFbF*l1Ih0REN;d{FVaRmk25DZ?ezTZ!&71N$+|fv*9g}x!l{wri0{DSN6T- z7^i9esS1#i<#FCyG&n-|aw^r~5u((-j(;ttqR{~a2ppDZ#=tH0crUgovb>_ro%ygM z1sNoCEvRe>&Q?X)2>_X$1GH))E%mG)aAjKRRVe;nNQe)f9}@qkBOZcM?*|S9LV@nG zG;jm~yNW-G5+a;U$BAp1(A$ys-{biw>bLdZ(ab~FGC)f0h!0d^@pc{vQ-j@<-MAZj zT{4nrcc$e>7(NypyGs7poz9$F>6G2^O*2S%-ex=vpV&gi!}L$qzoo% zgOCOxm7C-L@-hTgm`uIpIz%LfW1nVR^A$qf<;U%t^=W}-&Xkic?Uo(g1^n&N2jZ7@ z2Iig7mD;TK?v?k@;2U~2ufO7#2!PA_O)_}gUErg6$v>Uy;Ar(W(Llfk2ml-aSt+Gg z{w^s@#JfN7&FpiptxvBaH0|Q)F2js*HrESw?1JapAb3G#Y-?c0%{$VM4u7P$y03fO zNo(+e!pIuHTY@Mf&EF36?@z=8Af~Q`pQ7bZN#dlNjZyMd-D!4>jw)s|q1)Xm^=fq~Jx6DSYu+qKs}`{$hAjfu8KKcMa5z5XU6n`9-xB;7-dAGkcRb9&($D7k z>1uzg`s)UiK#cwD`&obzVpz;{qF0>7fV?M+M0#_pXMuF574`7$%=<}oWz{1duML^e zd|jQ-1qze|CNM6A5# z6e$~}U-{=I+nYE)T3j+YLSp;sQtQN$JNs+mad#C`)j=)SWB-g6!G{01_I&cN2?`PR zMw2*sMPZ8P;(qmq(a?ApMuP&Cj>aWGP5Hi*R-Qs*I}JSAe@F3Y1zS&QnINrzCBG zdZOcn1vtV&RRldAvT~xR<{JYptjTJyo5(&S>y^LMd=n;G|vxG5%ZZ=JpKs^%p$f%O=(ZHaP z3N5-_PU&--M@p_-^AU@9%GrcjcoLk2t~7b=nXCA;Dvb%Wo=pinvg?#G4#MBu0@AA) zaXgS?v#O@U&w1tUh5g(}c%p@5=+mnTJSc$1FS&Xu)ZPNKa%?29?2dkv%^4bGx0+O?E5&uX)12VD=O z+0-5xBhB4fW$YyB3iMzzH`*Yhl-)N9)CzE6RR9M~7i6R~`(?X#C{&TWC<&)B%v;qu z#BAJ#lqhl8C}kvdNV339^K;W@9;%t{_F?S0^r~6JU#hcW^0W=TEGV3@Gcw23bfT$4 zR)B2VH4(N-3WgbbDLNO({Yw+Bmt`%fr+T!hfQjzXjvD@#x6VHl=)X8L99HMMS z9;!61+V1o}VgoeS1-6K-xg7~##?=FrI1V*YB$iyY*{?JU71I9J$Y3Y6YoPI~mk=an zSp0kI$I+dpy~qsW(M(R5mIscpT;3J%|1#=HB}xeK`aIr?tt zQf$ipm5Z`_IUPTi=IZVK+Q9{Tniv1beU1-x0lbY5Z2@Ki_(-SuhMfK}^N~izfb_SR zE_yzsOHNKlGRd2dkdy;P+5$o0K4o z`zd61)>ldV5`~p4_uaEjx4hGnao+PO_f2v>ZRmT#^ew1^`|-W?)-5lUbK$J}2&C8$ zQQrw^Mq;LA#1q18ye0ksB7HBGK7TJt+GsUcC@!Cg^nwJ06Z4*Cx;uQ``;B73Q{JPsqsEI2|q zUr+9~Lw%kFp^9yqI#d`lAJ?1F$z(}ZphD0XwVW^Rya+7yLW3ksI-mE}qHwRb$S&?r zuMRt3|9Cvx(n~-~@N3mj{AhhK24!~&Y$?Mv$xQS;FomkuB~epRz5VYvhd zR>Cq*^iQLxTbHa4&wXh{a=~!dk+MT|+fPWhNel{Z6 z%Ig`)bt|HjNwLQ>MLL28X-?I*%+i|&uT!R-A-6X6n<-@*{!!$t|k+cNab<+n~M|S(M)Ye=?1|$R@Xl!BjxpC?}0I z(BF3sQ8dzy6gxK?=mpu2Bf~v><%MS+SL*^H|95VOWuwplwhopvE4 z1H=6P!{_mN0Vy_>ha0clu(13^7HOq82tu24ZZW~vr zF~okVQ*Y^;nQQeIW7yE%LDdlT(j{F82Lieazz!;d zZ<@szh;?>QTNZ&G=pr0Dh3Ts46MM3GL067LT*ubf{ZWGq5zsANC47)8P7IjE3+nRhFJK(zFsNg}Q4r#vR9s5O+SyHy7@=c*BGyxCM3zvRErOZDDRTCo+ zy|a`!|40pr1geS#minujuvBaroXCid8nW`@_-F*SJ5JyWy3q_)o$R+7xV?Iuo{%j! zE?;GjPoz7Q?+K~>5zeHnY`;swnM3j^OW>`8VmFuH{YY4W_Q(gm2$XE+p1g`%0l!(V zFxNJ%iUwOFWjX+uRRdss1oLx282}Ohuu}*Cspv7@_3K{YK=@>d@vjH;~V1mm|WB;c7E}3zcKG#DNm1*KzOaOe6KW= zd{cO(*uVM7ulJ)X5!8kc7^(`Uh7K+U`{fnUDV*eDt;0*>4y;dZaCW6{d`+@UGfmOH zYZj3DenUizsdvwZmHeH-bw44;gm(9-tGj!&5n^z(31V=h8u+V$(4e8!<^Z)(Wg2Kj z>l|e*eWw*Sg{(x6MQBzAiE*sUp!`n;Ae2z<7c{^YF&Y_vkS?M!?{}Pg1Gv(Qotvi9 zqaR%b_SKpQguD})7Z8a{{WSB0*G@zRjSxscUg-;M3JOb%> zIBw2lF2Hj}V;ePRzt{;0z2-hz6y!cnc!z8fN*)GoNd|Kio7`6``r=QmQ~C7oIb7KF zRZY3}w4n8Ngd6z%4a~z2=Ga_tVA*~pJilA|2=$wd4~%}43-%j= zzyb>nLmh9N8CLdF8=jGs-z_N}eKE!YTV0YydJ0s-<|th;xM~Cf4@!52 zPg@@x13;b>Ek)Y#Q4w7y`=&p}m=$X#KssJ{ARVY1NXG!AYli~T)focmFzD#dD*X$9 zOyL$&1K{pq2n=x32n5mx+DvggaKs1%F-MA4DDC)hn$BqMbt@E*rK$_af(~TyfdI0| zzGZ<0vLN~al@nFhXRGU;(=BWMQwsFIrGUSWKv0W0^$#O*>A|*Kp`Lu%@>zC9k?&1A zwx{)GFLdlQ1e&e42F3_zXx|!zx5nkI0Rv4vs(orAf-D&K7X&FRM)I^wvsEf582uLn z1t$%I(b82@#+i+~gt`e_lN8Y0$^Z@L7oc%hc;l4bIF&a}UEM^6)~NSmX9-y77X&#B zbwwZo z%sKEo%To{r9n8&p&ux;I9G}L`0Lm~0Aw-tv__Fe)A#Q$^e*KOh&X&v9h#W6^4RJVl zOGCJJeWiTfwSd>-R3zaj#;b^5W<{6grJrM z2ugs61c==!L{`3eq-F9LKOsb>yASjtcZ5 zO$kevdWzb6H?npBa3=xUdO+J~_Ps)x0noYw+U;NObj%E)7oCoqZFf@g z=%yMNnqCZoMM+UaA-%|=>(icB2@KUOfkpL{wfQ2-%7pOF3ha%(r+DuS; zIz=}!WbR5Ak!tKQzyNK6`q*6foKzkYy=v7|_`LQD02Tls@&+aWFf9jw;d=j4gUDh3 zO|@h?Dt%u7d<6r*5deuv000>Ss38$Rs#Z{HovCq9{lBQR6x)0O@QD%t#sH9|0DuGl zBFF$hrQ72V831?z5cLK)0KoqS zm;rE{OQHE3F8&$2O2yRw`~V~dAZY-}ya7P~l!^j?9RP5mvege?gXEa>zYKlYVh;oW zHvq2v0YCwO20s9x41Eywbads`)`#+7CYubdWP>MmWmk|Cui3>$7WP_gmsFSyz zzlIBC@i~Qj}K)Ay$${)=R$Y5l!Hol4g-qWN!nsBhV2yu@P?7Yl& ztQ-sI`N)X`XYq%RD%}$xUI0Rx3m`TDBKo)R+&E|$xbtHM?);9@VS-d#3DL)A0745O zA~RruX50Yc&vCXj>+@f4{R{<* z03-Hf#EA*XfY`R3)aLmY9=vGECtI$}tGW%3&57WxVL`m;k3t;y@!w5txjsWIIm$t6 z_s*gD105)!17Ew5jBnb@EIbr!5*LFoC`N)8JuJe3j}|=dc%2V)!bAaY2%ts=)TDq~ z3Q(s2YLQrk!Te3z6xE}#2dw*iQoLwsaSnX2&NofQR_oHo!-0q$*;RwY3y<9xySJd?^Ix69%FYh~Awr!}r@ zu~%Sp*;`xh$7B3P1b(zhz?kkJbQ<>$1P&J>JlkC%j>XX++v*gwB|}!u+HT;hH&lc5 zCK3UL6=2+JyUh{J0LutqNdzpkct_1{KSOw{?5b025{(vI7=Rr5K#p#}5dk$=VD z%>%~p$DnyDGxVK~=`PZ^fBTFDonf|(A!fCt5eQsz@_O$&y4{U#9i658TH0XEs_Xq> zQ%2Tc7BT^9tHkfj{0)$ub-fnR79kUS6M!odaPb2!Z@~3h%MO-Kti{oLU|^@fz!rdkWm*8b2|$+tOa(8H z=&RY{b^16!qyq#uKsW)JHvmWH+vEX`RbVR8?K0~N!4toM(Y68u0|5g=d>hy}P;oj? zF*i`LD^T&_$oV0tB?Dl10mcJhE&79r_B4tPAJc?3l8J_oFGj4i7r5FQv(`jA-oNw2px7+36F}SheICM z%p$d|WoH&6HFrU5v!sPXj#>*ahGsENrN3-o%wmS>M~Gu}6NO2$XadCG)S$!4sgY`v zr~rZ!Ab3=v!{CeIQKc1d$S=}ar1CichxrI`N>}>a%4m!<_+%b}5Jo&k&ajsF5Ii{# zfeF5yhd=;fn)3Tm`H;v2+Jb>RjX%-@xS_UALUTU(UM7}$eCcG91I#Qm~BE{ z_do{E=Lh{P?4EPnN4Sfk;U?cB_y*r`GJMjiVD1th0J`;q@32~ayk|fqhSW6`hH7q5 z9eRg#AM>6ejudjGnZeWwi0{X~XK)6QL+X;tKsOI1!8^vXV64wydGK`qD zkO=^i5r8QGjw!ep=(Phqtg554*eaY^jbl5*;JdZ~vjxF6(7IU&(E@nI+-Om-4PE^N z^!ziKK!7oBY2z|H1prw9&`t$FIRI$V2z+%7oVS96edbm@Yd~we^AU2Yb0xb2k`q93Uj(Gh2KE!Oyc}wy zXur6q;ETo z3oj(+b(H@2$wD8HgVLuFv+nZ&y)>YY1@t7p&JXYN2n4FsfUFMnz?l!6=-yMnnV$=s zzio$aj47XWYqp}qPBl!a`s{yre60C0i;2h-5d%{MzQp&BrF z+0=T<^Qpf3sae;nV&H2ICdi#D?PT!TizVY1<*a!nxU7TE*-dcYAPRcUV_C3l zzK4=WBL1L~2X8Dm;NFr)>tq>h6B7H^<7BM=InnZ@V_*f+ZABw&kqCragS6~6)7$hF z?@?MmNBQSLww;C#%hHMljNRh_nunf6h2HZ-CF=O0P5IUY%aP}UJ_DrZ75}DGKjqY6 zC#R_N#mlo>@^=gbV_%Q^(Te+>qnq8jQ}V%^qRZ!2EpoyeA0O2<+5MI5X`ga7jB=z{ zkDD)ZRpSNFdnYqvbsM02M~-xO-9Xtb)vp3S<5844eEtU4rev$lxV)}u%(%K%}bMc!2xQxs$>MSj$tJ`bodZtmd?xn zVLw8E+{t71*a*9|Zv30Uln;NpLgh`iDm5jxA&5(TDNKkEat|Vo+Tcr&G2)Y^ih56x zgD)G6FLcAhytgNuo<*5=cwl&79zZo!uy4vZaJz}U7J>4bEF67{yzPM`EWi5Vic;Ya z7T^FfKW8KtFpn{T=Jt&sp7Wm1TH#t{$ruXs;@~3+*{|1rl(HZ!y>q*mq?vQ#Z^yZp zZYrH%x(&FZ!~!*Ky&U~uNeM_HlI$IJyqW8k3V+nV!FxGV%)?@jm@k{1ubp|s&;f6UdJ7tC1iiwS?t4HXah^*o9Qo^fDCW&b+%s>_@F)#(J{ z2MjAARm0R2LhkGR>8q0p^TRTgQS%cCxnFZ&UGNd(syJw2pTJFek!*wKBd1iebPqkM zeZ1oMtc0&`IDO%6m5tmW5^;^$Rb_HB2CC5 zL&&1lcSnm~#SB7=d6Wy%&B8rjQ0-$K(*m96*>CFVUj5QxjDBS5Qf@$h87i7nvz00~;&) z$9-y-!%CH?=p}5KB*U6#)w9ICMqC&U`s!>%HWO5+q+(C>oya&qcX8A;$7+^;g&d1x zIH=;ya@u8$SR-B5(r%Z|E2pShP5Y^v0yVTY0qe*2k4I$?8Ws)5>4Jd~n#hoc@dV zNay=~f)px?(-%+&AO5Gh?f&;&8(YVqKm^fxomBT;#oEAL!AFuCt*3WcAaOVWhgS{( z#xdfWiA|V0I_0x(drjxxtVY6oFa^6TV*Muwv@ajnit2UNa7^h>^Cx)gk=?0KCfhDw z6?Dg3&<5uEn?2DNa-^&Zg#y2dAyY^F4z2csB`r`wN8vyb&Sxtm>A@roO_0DATa@?^ ztK3f3g9vm>kx+Q*HOrYnJo*u;rIgz1=)TYqgYvjl1fOgIuJ`yllWGNTWNrItx5gpQ z$}IL4P#?peQFYeAQr%Twc{`J^)sMi75S?OhzIKcE4Sl)Boqd>h6v}5dGviehh3JnI zja`hf{sua3zVtOYi;Oi;zG3K3%Z-;dVds6mVf1IR`RfbO83wYT^3T9-{0vB=o*#Vf zWM|e~I)7+<0o6PU=(9h6xq0-MyV6)V-BO!bQ~M{t{T6t!o6X6%);5r}!a831MMN*v z8ku3UtN&LQE8`G{cR{XelG`Z&Ho3-Sj1E3SM{Y)f9bIfO7YH7=%XQHi z7-x@X0lCVr5G$J>>9Vql?ln%e5SZ+x?&I)K+V}A{dHL`Y4hxg*+zq3oA8HosDo8rZ zO=cZS2~IgJa`(`mldYgR*mZm}z#Ma*@~&#Q-{se0V+=NQ@N5V0vnGJMo+NB8$GmDR z_2K>Q$L4p_ZjGkeupusWD#kcZyK}!We*o<^>7+TVg2XS4VMkBvIo8^4!*~0UlTY!x z5zqE|<+%u^tyj85NhCdJ^4p&S{a_RVv!C_79zT*H5yA*R9v&Z4!t;AzemHihZ^~l2 zSrnASzX)H$kLH6DdlU-aCX6^47+`o^$UT_l*0-V`Qwo=Um@6%bIg?M^3ovkZXqX{?@cY~6km9oB55LoLajsvi=Nejh9wjRZV&ipA zMxUQNk4c)mCD*RN^_=;7)IGg4=H?qra=B4Db~l0Y7_3y+2g;Ysa=GC;b};fhtlVb+ zlp`#1xes(^VWbJHtp933XX>M1@*(}AuX_A?%!x6dhsVqgJD-K5e2Ogu?;EQpw?(d* zNim_t1@$LuFJxi%3$Pi8tX`Myj=X!Ac0a36ZrqG&_0y1in)05OHGZqMvo0YPv!lSu zox`>KQeE_w5tbnyXNjLi;rIRTJg8TCE6OHIci29*&yW6W7W5gEJ=*XvV@c0qyQJd5 zz>d35P`sONKp~`}fw*K*m2Kkqtq(%3lWQgpQBK2R1JrS~+AI$-JnIwdIV!5b ziWX+U!vh77v(S?{oJ8e7cjp?fg_cL6`o*TX<+-kwnI*du0iju4Z5=o=bm%lL2_*7@7 z=e<{*iR5O{Lr-nhv0?N4aODGI*TZsb4-4QqGyJ~ab#7%n=YHy0-vIGRt*_mDRD>zn z&P@z2sBqNZ=dJy*q{L`Rhno7GpSp4PAO4KwJjr{(1j?)yUbyv&p!0d-GI`7AbUCMa z@%C>zVZpml=Fu~rqn*WpWz}<^H#IL*_lkMj{)qmT)o$52gxis?O=g#lq&4~WSgtDN;zr~fg(Punh zMy+5)xL&v{BqgG_aeOc4&n%^JGTydx|6qP50%qlEV}c)t*GBqe@BR6al4PjuEqU?* z?OOugYTj zmYu57{b|2bruFod74uV*&t#EVnF%Fbet~o)LOKDqoM~C72JZxCg)8jl*4zfLw3~386k)5t;canE<8_mDFcP1yQ z8cS{V+K(=08ntdbN+v&-@~rLCx!@vWOip`bdwbwP%jh~+@sHoEoaeLFA6+$SdD~we zB|c1^`%PBPTZQ?rW;$a-e$FlzDr%1|4Y|GD>kQ`a#MD<7Det3NL?~ zWrPaDmAkwSwD#bi!gSY&R@Aq;uc<^@XuKcOzv`wXH@$1w!8EeGYj;|)GBnZP`H7nc%C+m#Q#F+QwktF?a2tFQko}gm!@Y7BPtGmVYIC0XEaIbt zhDX%wxpA@QFBCi~Y5r_G@SBs00vvuvG?^ZlycQdT+_)4`F)2@z+ z7RC3G&hXIpv94QiNY+M<4^l0+Hq~pbTvb|@0>{T@JTBcYWcYs!`_vr9Y=lOb^>N#wqv=c<+u$3*&`Qw5;&0|k>0?5F9%fD2Io;#-bVb)406lpXy!p!YD+ z7xi##e5K)m*+XBxZt_42w4*vK!;)aD_UN*?|5rDbIiVrd)_J%A%$R&>@fM!O-`OuyRX&L6_Vz)xNIw6D#g|C z=&2uZ+DNHpsDk|%Ccyhh@x0_(^b_>PLZzin9%+d*+>ocYwiBi3IfD~h-;rG3*)HvI zH6;c~namOz$G$aVp(=wz4A6M|E(P_Hl#_C0RbHKD9dt21j>xgGiCimwCc%5`>YLKH zOENOu%VVKf$XUX(lEHc*)UwR4-X$Y4+P3V(kWQL)drlFV6jt+C>Me<3u#_CWyt#c# zKePOBXX0-}rPBrCZ%%pW+@Rqw<ExMf#$K_65vJlif?l;)wwCc;Xp!$NP#?zio4ci9P zLHhTahHpKEbZgY#uYX5YV>-_jmfjj_#T_gpuTH9M64{?&99$zVWK{ZleNecP_zBA_ zn;8>4v|4xHB581A$a7UJc(CyR>&~w1a%Rhd{Gz<(qa%(y$@LjsY{^Y}P)GmkFCH%g z7sedEnU=P{UUQM*X_O9449@7yHW`1|*p_fIrMco^EA%umI{k!ML+mk50)zFrjoc?s z{Rq+XqYQ+w=%O!a%ZhKp%&%Ax_I?cDLkw!T<|Af#ZHZyK)u3TqlXxe>ue25lR~?A_ z^%DTBM`<|&{1X7uqJ7+l4$P494}^Jn`~ho%pwxK4v2mlOTJId}R?beUP^vKN7vJhK zNUEkx;7jRbq(RH(Hqx-%tyVr$3 zUQZGObA7?1`GM5jtXGy;ijE@Vug`e{Z4TTe^bLj)SPmb#qoJ$xrC>Yw*?I0mg3}bq zOzziWUeo$%enTFa4q$Ru4wqBEcgx7)(_U$JP< z)l~MirpW|PeK?TzKwC*1*k%v1}tHk#U1Gmo1 z$!CZ9Z${-oSI@l;^>k4A=6~9dElJ>s6tA69l+iT9yov{=XbcL7qodj^GjFnZAg6D zX8Y++yHpY4H7FFdgBc`BypLR3y~Jd8x~S&1r;_V}=y|cTWj!x57mGqt$U7V4qKre3 zzkO`Z=!${Q41eR(!VSLC$eTZ!+BIyvDX<;;cPSzxg92ecK9OCpf!I|R9Mwi8uk|zsyE$Jp) zs){{~RoTwmr0Q9SE5BWH|0YWOx>lYHRi0PRH+0atyo$u@L^~?gmZX3hVPAK8?2d>) z?2?B#?`6-0sMPlj!9BsjMRoMkv(#Nl);R3xO5TLQLK>{azUYjh^ozF{P0An-E>u(T zBU*N|)(gQo*(c<(cME15P|PKhQ4bp0#Mo*q?rqBt&5UWxIhK;AkAa=Sj+~#RhDg+y z^vd#j0Qv3kg`4whfxFobQG{Y<^%MDOiK}a4x7qD8SL&b$!giCBsJp!D5x+BA3!MqB z8;&ZK84hVT&RiFClqhm<2rq*Mg}H`13#o-2#OjQ5X6I$+1iW`!FHh)pURu|)o{x?3 zlh`feXy$!sCjMo$Ze+X8hs?58iyF_{uo^UdGj#UCLC?@pEB7Z49ABOBM)#0m1&_+Y;!vVVSoEMT$ zeW&I&YmBeNbbb(g<||Y5Xmj;CZu9%m%KPuJmQT1se~6z;65JHa9?=P%+j&sdR3*#N zOpT8&Q2Vjk{qb@>|FOsIa;rvfqoN1c$v8KqR%C#QYum3u2%cz4!$NWdK-jIZ&A*sphY96EFEYjP`i=5Ooj?dj*wj!g6u zWqN+ah35xJ)pvlmzQsnOr(smvufHY>8~TIBdV}8SNz#?Fp5het4-lc8b$iL`g)ZR( zITrbRL(Hq-HDeQER!wf580XV{)~ zFhdE6r`FCZxfoiG3aFJYjVwKUm#=0RgsC$Y@N)L+55ITod!q8qvBcVa{9@IU4OiDk zC48&-^4cN@$Ld>28%+WMlvBc*F}%8U?e_$u$?iST!gn5$7b|!nQnikseCfSGetD%g z#FWXV57Uck#~0_kh>~SY1%|4$i1|S7jZb;q50_7iISPw7<}MpOS{4#>6cTaFS-$XS zSxzilSY*Sb82_s8)|kU1m#{ebSF=pYS}Bz!k)HHFAJHxsnFT3G%1I3xI}HWJE&APG z`RxR+MZM&^FB-|y2TPrlXRDF9w6OH2 zAgsg7OMlN?md|52peF=%9rL^J>8Bcg>8>G_{*PiWq=PkC+iZ$SQln6>B>XE~Y}U*C zu&LajzGrw!0&1X;S{b5bZI;qM`$i8Jkn%&>LCbVQ_yvh z1uF(&Ys&_Xr*>`%axV{t>ZohveQ;f*37uXjFfFV7smo#)^xV|`GH%o^3tc+SK=PSde8EDLe7OZf{0T^BY0ECrsh^FuJ*h^aKo0Eg6sP%Qe`?EOadOfb?6t}Q;j;=Ll^E4?FxXz`cKU@6~ z$qKx28NjD1d#6TcZjIRxCCp`I^Ir6X1m6&g0H-C7o*JwVe;PvV*KRa9E%K5{d;4e{ zf2j4XyHpvm$JB56QDv}zgBv*Ts2`!>xuPPfzgR_M5Do=}U5?RYQFtA6>BZ3DIJHZS zEy2bL1XyZkdBsE(otm5f+tCNsUU%b`sLlv$q;iRD>WS8>H-s68sA?+3HWr<2D2xVD zcu<(Srjno0XJ1%*TNkJ{C5{5D{$f2qw`#J)`hmiHeWXhY4zrt^U9g&e=ti3i^`D4Il1^86s->wO$EiPd4z_82u!q96;_57@6|9G1Vsm1x;-RdBl}oz zfmMM^{a)7nEuCu0oGEo36tU3Y=Z6&D+s{d*_H6&fvNmeLm6L`m*LO1)q7BR2tEVob zVGvw85x8_mL?X>)W7Ccrd1_%xuZ>ud)&|WyKChhaeLRTqxM5cE$VBe$r$X7pB-WW%Nq|zq-e+>-{(~wMq04yoz=rz7TS`I~bVMyHEf>Jps>F zVw{rhDl&m5H;0Gmb$A8)sxyM`a?0ArL{Yv-x+;hJ(ztkdVI^I~!s zCPuxKkD8Os8!4i%j=2@B+tqpCX0DQ>q~An+qp{15m2B3I4v`$Q!IwRHtY=8bM?y#E zJlBDK(~^YfbdfjN3bkL3?Z7%0Zq>lU7*88w6Rxf6eYdzPy)?b5X!wHpMa zEdDV1=1O-XBC-Dk%pBARF}Swyq8u?I26he2eSP*S^w7G$UBANM*KtJ)rj=i`sryMe`l5KX>o=Wk%+g zng3pdU@!kZt$hhkllj=>c2fRXEotSDE)B8#lc-DoiKus53*%X2?_4}P`VGokUy2)T z%67wTZibBNER0B0wUa8_g*?LELh^PFbzu$Fgp-Z8#MsC3Q1@NF7pWG{7QQem(9oAG zO*o3z)`;0IKOfsVjLvT``I)zu8=OPf4VwDTL2QmgZ3Ca2fHLQzWM$nrKPQK4?k zlX=lQswumFWQ7Y4er0ijL?Htc6Ys;sB{rC7AOaIZG`t3&Y~dGx`PLI=b~o-ZFAl>@ z>YxeIG9An`34)n66fpBF0%l@MhrP+&C%`1RaL-gFFDKZz9IN#vjF;2yoG0itz=9!}zu>id+Z*LQ-H4m{4R_K2tZ=0LSKiV$bD) zPpwk@>|0kKA)N*u2aK?kv6w;JnM` z6wH(&jDGi=axw#Hdlc#8QpKSeK;Vf9ouKYZp`2u=fR#~u$|E_UOequ4{#V1{6f!{j zW=|^)Ytw0A3;R(vUZ1Pz0ACtbTGPQwZxn1{T$zI)x95uiR!;3HDL%r!&H`TtVPB?{ zFp_6asj=sa>D6!pCG1LWPpJnhp>!75f(Dh1m(fSqm+_u2Hdt9qb-SwIT)#uj&liSj zXL;u1PxJ(&s8h67b?%d)yAeENY3HPX;xr>)4<2Ff8QQ{da-la#enw=VRVTk?UwITMNl%1eJ>y%K5Wm+^LkfTxRkQe&S(Mm9r z!nj9=wVDAigb65LKc@tM+xSuv1t0XMeCH_g4_E-O+mix={-*rJ{l6KcBm{z_|Ka7r zJES~EC8{+5&NPJnk4!s`oi5s~MFa7`Ugoe&85D}Qf+JeZ4mYr*A_VIFEsxjF;S7Jp z_3HK?Df}(E|92tdTS(xyw*JS<@`)qIbXk7!z`ai^_bYF23-$4ln&?i@xdyLF$<&|x zLie?@kFVpHj5>vW@C5tbDX6ADGhD!JA-FL%v`x*df3?#B}{F_CqdV3HNh9uAMk7TM$T>h0pz%OK0a)exEMN z{#vk>!0ml@D9%^}=?(gv2y*K(9lRcIIp9EzPpJ#!T&CN1EQiic5BIU^wBET*DpapB z-5BP89qLr9C75XY#fG&hzD^EC_ZS<2oV2H z{SWO4bRF$cJZ{Z-Q1=>V(d4kujlIMiPJBjpH-SCEUn2fO+rb|A`b8J)U4Zr}p?E1I zicufO5V9qjLwDEU-xB;4zv@5Z`~RETIXJawYfkDPIy5rsQm(<D%B&J`rXp(`Qtyi^ZUx4dGjT9?lq9u$Q=``;Le1TI=u3l9{k@?-o zMS2I!bAhtpUe(Ec3qu}^a@F$qJ1CS3{v9QX>w3#_>l}YdzhpJ15O=59s&AF5+9?c) z$Ep2ypO;+Qc~6KJL^?4d3M1S8IaK8W^9Wg8E4R#o$i>uZdEhSUFLy&dlGUojd-yAq zC>wJ|ISSxg_TLO~$>UlKpF$28q`l|ELZzo$LK0aWKSd=ZJAU#@v~>Iwm(VGnlssFt zTX(mHAF(d|Y-nEq>AsLG#Wn29{ZWV>;ITpqf0zmt0R;&lJTT8+ma3ajR?YK&WJHuk zQmP?lCHd=UTW{|UW<)>6@(z%vpk!zrt5u!s=S$^?TU{G{ku8kzS1g{KX;8J)mE7`i zY43g&5k(X%02twmK;QOC%I%vo@T?fG)K*<~Y!)@dXuzyQ+veZY&LQEm_w zD1k2(SFac-ORw1EpFbd?Ae8_K@aGB9naiYO6ci(jtH81KylQzbIj}mN7cDY0R z2s{@x$_AnZQL)j=7MQ?Q1M`0jT=EuPUdy!oIaRtAoH5&Oh#;;Tn?<^j2As6M4U<&lyTVp{r zpt4f?lT#MliKp6!vNnqtg^kRf%<)lmp{$x_ZD0h9wx#Oe7{`IZe(r&}LD@5# zBQ>79j`NOKf}a=BsfhfY;rzuMQjpBatrAd*xX6kuvsL%87ujMMe{)c!Mpeiu2hUA| z5|&$IISLX5qilgC$TT}mx&6f%qS|kE+CTzim@-4>QEW zL1Awez(K`)$4l-|NX(YLo=h7Zv z0;a)boZGT!fXs<@M}s(SBz>d-@tFv7UzI`>;c4hlMtH3QC@Dxq4bkU=tm}dovkPwN zUqj@LI$a-y(o@i)}`DwYgiiCg2( zI@rD?*tT3z#;Qrk%5-z(rwo|6ehKn%Z9Ysp-F!+-JSCZ#EfFA$^&GR#n5&c*kK0kL zjX!(L+SdA!rUhy~RVVry@ZP|@S1>P-W^zJ-YGS-(a)kd|!psYXNWhF#5vb6Cy&nXYek5v5O5w|CueHj-z+^8DgrmYYVZusDP+~XKkl4*STDGe-UY5l-v1WN< zVy&Udj{`9={!AJVZ0eX9;NQ}NQZ_N5FxC_Ob|8Ll8P4fu_km{gmJK2?Vdh-|-P*Vu ztyu?xC^!BLtz2H5hE&GV1-QCuqf!PIx=$iN2y{axpzMD_He0OT z`;WuVGkX#^=%UB*5CaMar6EB&Hi$M|6v(Cn0UX1Y+`F1XeO!~=-v{F0DCOpUJ6B$; zQ~DiXJF0*iqPvBc;NmnLLeRB7U;{n9|J20V?T{58M60)=$#5A@rK?5sW!dbog~V<{ zfiDwwNRa7cD!8ny@akO#;g4TLuDZU0KmyHy6w}R@=>oc4b(k03cW}+76w@SJvj)ZF z1Rru@m#gJCm_HS^4=(CqxHbWZtuxrF;^OgD1gOe;6ug4;uw5AhiHj4i%IyG9m4`?` zqejCtOaM-Y*2y93j2P_s6-;xbfN9WvWo#HF+-8ihWo4MR1TSS6Dkb?n6115P8n%pq zd6%kkck7g>yi#2e#K3gKVwW-%&4fGhOt$iHnIzu?YiwdS)o5AJqm`{|*OaK>(jb9R zLwHeHV4GBkEfG*lTN>Cu1+X~Hb_kJ8W-GJOBw>?>4UD?0O46!(;&dY>wxf+YtX+3#KnSg zH6-V@A}lfxL)7yWi}C~PUd-d&RyfviycLdde8LLHHlCj7i9Bcw$vm1EpLV>EH(*98 zSMN%ATglqs!YjR#{fQo^+=P zzzvBY%B1x$F)Jkjd%1uWhS!?5-rHQcWhOXqlLgVz-06wfksF_uM*trS2ouMw3KSoS z1>vNPr)NPycx^@$3x0tSMTK`@MeXAwP*lmI{wfnNY^>*E0bI~%?pef3v7$Ixag-@D z(o_N2Bk)qJ;VQw(ENtLom{2Nv^)UT!>tX3dx%h($fpx+J4Bk~k5G<)lm!DdOZmK>_ z4%;++n(Q(_rHqBJ6pMYo=PrPlY3__hypu7;Af~qI@y^UBd3Ytx;}w}vY>+a!S|GqP zS_YEyPUdL}Ot>$}W=Ga}n=7=;{B*X!M6Z;1C3c5Vtn7!tf>e^W-M@hG zs$GU!L5p<~v52(;p`Zh5iL&hzBOi9R#tU2r8-C;R*{Jt@3% zMyC5N76M(mm_G3PJnt54{&!*qJP%KY;r?^Gf10h^!Z?t@=f{tPB`r>H2hwQl<#V_J z&P+`33=3yvpyt_u@Ze*==2&3|9-}P-zLW*(Uuj1B2ItcMJMoB+NTwS+que zHXO~nKDBH!j0U5t#(m(`7Y zpD(-i;?3DBWg1W+wLRs~O4&EQi!aK_87_d)i z4Ce0S`O1$lg5X^!9lQ&5zX$Is`Db5qz`M$b^I%u`h6!d}gjsT69~uttU5~Yd!jO0usRPec0{^nAQr@v}>Z?aM%EV9c;G*X3?kt z7M;(4z-?toj+jXF=nG`=U#Gb}DHHsNF7v=uu(6q^g<0|_;9+JUfSYp_(Fe~uwBe08 zP&)VnT;N|`)sX^p(;J-H1I*m$!N%zCqlsOcYr9G-*t-l)PVEcW=2Qf4DxjC?0tkFN z7b*n5&4t3~@AfRM?hyOuRy?D_9#7OIY^RqdOl&Z0$ao4{_6_jN(?_q6dHOrCNrQ)% zu-LI7hAEFqjJtl>YnLHaa~7#LTweN^+DK7qi*Kb_wXrCvH+VWuRI*&63tt_OD28HD z;0^3w16pyO^NV=^b}wKM9tilaaW7!}F>aI)9NSfRkk(l-Cbg)*D@E_~&+%X+oe$X3 zDRggucUIn6j%tX+i7gLGa4J=YRz%257K42lT9F&P!%0a88#B&Tx4WMBVNO&i#4G=G zZg+vflc8`S8M|dviCXIz^eZDvB@&_k;_7?_MsM0cy z2#}52fRySF_<4k_h^=EX##FFyU1_rU@?l=E^ShT`!KC!1`SK z{mbuQ;al*48S50VM&mXu)>_kN7B>!?UIwO*6t52U`ETs@H-R#cnwUR+g&jrPbbzyF~8N*3mhJ5Lh|fu-$!U}fGN_>a;b z`eyC`Vyqko?xOT}b(!!7`BCb4KR%TB$)eK!@I01Ye)CK5b?F@45|+_}UKbN-Ou>58<$)JBg0o#k6mopuMD)m>Hx|x zkc4mJN9q5$G%BZec>3TqCQ{@su2~H?)l?gYg-FrUT5_^goCH?jYC@c2#IGZ?(XEO~ zE5u79QTjWA__@Og z#y!m5;kV?jtgo!}-Pzh?!!|KQj$pQ|9$L^~+vOIeNjb8(j0y;+OMLEu+mW7AD5J-{ zXdj{eamHdIvaoWS)PQGLP$KxPEqeLNZmF5BQ_ITZWN;?0csIpKU#3zkYz_f>&ETL+ap&kFK>|iF84Rg)r^b`7gT*7J~gRudOMxyTtDRnM{D7~L3nMcN5Rg~OSFKwK?A4bYCcYXZ&ox@CT=&||< zCFV6s`?Ig5@0a%kjN=Y+3q^>{oMc#nIx?M`YoBBzrO#&NhE^S6;F77zS7Ou;i~V`` z-Jp3V#j7g4Ks2*L8Y-f)44JqNp|6a6$+#^0&Dqd+BT=GOU!i!zBI$lugKk^s1IV)G&rI2z3ApiftUAl@m!w811xXzo1*=dg`BlK%m&1CYZ7{0qT~jS zrsm%i7oa<_j2lg`S4){MA#2^t9lorocEl$9K7r9!x&6uRE+Inq*P5fWPz$L2oZ_Fi z2PqMVCj7PzN(U*0*VIL+QB2W4Mlx{VGj&m-6gQc{IV*l%7sbkj-IxAp1&u(+@goq2 z5P$#D^xQ+8)C1pRU2%KoK6-$$d@s4-4HE)^_5W9fUfLe23NVnz@QZpVF{+b{fqb{| zeEKL>l#(R!@pBvt{vr^#tNYfuLx5YSe{e(W3_7xM*x(-`>#+3ysiOCoGLrX zj9iKjFhH?VG-~gW@tHv29=kGfi3WtyeDGh1Wo{IBeE`9)!Z-w@oPsF|f#9e8R~*Uf zcbvQ-z#UXKU&jO76}o@LJ@ES-7i5T%LR}5`U1|Uhu_C}mWU0P0t`4=#Z^x#G)#5`2Cd{`qATCq73C zMT5U>ggS^1KZZJZ;4cG9QojJUm%&q`)nl-ri`>AcTt;!>>5Nb(kz4pB_}l`Vqe#-f zyLe*+n&+G>{+KaJ5KjgI5{;KKMqQ$aSNx^RFb04W>@QI;*D35F&Bjl>6=pai(~ lZX-wpB9Q`tVEij4aMr4ZuQov`BJVsgMG2t$wZVcS{tv|myL7X*^OY&=YZoQk z0fzwV8PI+3rH6b?XAz+Zrg`Jx!F@7j)U};E85m9mC2Ej1idD%Cq)`J;d@L(nwXp`)P>rd?kprbt3uAi@Ph;&(QCOP`g`vMNk2hOHoR@Yn>6@i_GzE2=oO&ae zq0J9s?62a{QB#`GF5}o8a`9$x^?5WQNq}lEP@w8VG0G1kJRvVF{G|$&mIVAFYKAMx zx|*{^dnVCqNqF)1$(?v+nM_e}+_ttHDvjg}dwcEf4~OMT8DaDjML}f_XT?p(V&2kC zFS5u$I{Ua0&o9@CJSxE_t<^QuAlQ8>s6Dmh>Y0+iw|Z)F2DHDvSPp<}4bnfAPG7x4uc=K(JLhA8=mC$-F1oy}Mp(FdfXClJ-Fr}tb7jcZpP zmlvD`n|K^#uiy4tVk^L85)ZqMK)`Xu7u{TW1m!fQc8v$s4=(HG+V45Cy_FFwf**t8 zt$jcfwQ$>^Mo_!XGB6!_$_{S!nt8l(!?Zz2!G^%%-_|{ah}8AJA3s|Z6ptFAmHUKffc9c8D{s<5BG9gMrA{3oz13pOQ}7V*VeW5sit%(`CnM4bhZc; z(p5<}<&g7c$W39Cd`@_TNgp3^a1}+XwW|-;E~dnZK(gCVOPkTu+b38_IVvm!aXTLf zo{N*C2j|NiWmTxk+`$lv9Dw4V&}}yu!pd>S+(Ws}C*h_)VRWQ=gkpaDFglvoXlzW_|N3wB#({pd$O^YFe=c;M9qvC8|(=o zRCOfck*Wv=4~4@OfCxG#(33WUMxO3*HzPp7bZYd}dnSq_IcEYrP+5gYL2#y&+?4-S z)it$^7?T6)u#jiaVo6KIPgt?iJRX@9H9Y`!4$y{YRB*dG5Us(|UQRz{rv(+)Rcfrs zmLfRrR9cD3l@WVTDF(`u=DcSJK-i}kk&msWIdR`;rUB74{h93MPC2K&mz`lpe@PZt zu{CP*c0}B}jw5rXaIF>DX|BEU^I1l?jhIwr$frH*j~HG?5ixO;O$-6-KImfIy(l7L zGya^otk>Al9*Pcw=RCVVQCyvIv%wh~8Tn;#Bqb5H}JyaSwYrxxi3OPCFr`613I<^9O&M979U{SoiJ>%0&`At zEPqZV8Y-rJ_>_gT=E#lxe9kOCUe>K7YHMUI#Vn$c+<9H1cw#McW(VVL=Dl9n$-NS^XbQ95!`M&k1(NhYbrBoq?^h+whQzKdQ(>qZKQ5OhNKn zXUjKl10D_!Ii8N4fAT`E$}*W&Cf0tiz2HBdKkjRxPvyAZYf0v0wQ=~2H{aW7d!gN!i*aPf6*a(?$+tMn z_V325;Wv5eGeRibs-&)8+V@UV{i?!y3E*BK+ooZ14TySVfVbzLfwF1DcDg)%W zW#2%hEKhu?^(jISD);Odt*{49HOVy0cu9njbBz~_wKe}3fLU>_j^b`aRIT9la9Nd$ z3H+%n!`-X(Yr;P_L71?b{Qpa%Y#r|#A+!!;??S(Ywa7!1^&^ZWx$!%1FQ$m2E-cq_ zsXYQJiO>mU%BnQ>XwFa1KF7lFjy+n;Jbb8Sb%6Pj$k7@;2_40cq9j}2? zKX0u?>iQ&0zy^x8to0?Ta0y~O7ElvLs>DQ^)wX#~-9dU???ITDmeXtgNSxWp88;4Q zWS4!qG1eJ7)X`1|v((KTHjc8Gn0vOWx&f&80%-XZYNvBsD8c6QJ_lMP!z`F31?D#7 zMdRG%f5W4KZI!c}k?^=VYo->0a%Zp=lfqbW46a<47LJAjn)$daM-oUcc@Pr~m@;mv z^23-4*KDnUISYc={BPCS+=MjN!6WLW$=Vx8ykId~eHC==J4i86KYP#MEK%U^Hx@1M zg5}NQz%WH?{nc!P19Ud{C^EPo4B#jM_0a>G6J z4o6r#OR>LmBZ3=9P6&3cppr7d zPmyv!lJcdX9LbbNg<^?7D!_v8nGRo>35vCFnkAI$Y^eeXeNtMNIwBDEKr=^Vi~=fK zR+p*;-fR4cNM+uX9$@?>GDZZgaxCByNF9qh76{YZWE;lxN}#XR_#vkJ({DfpIAF8sX;vf>sNnkET+sT4BhS2rounPNrk;GfG40x0lIh<*#W_EP<|BB?TQ z=*Mlc!V6zLOigRScsHX2a{Wjw$n*UudX0k%6&9`2k<^sZ&kjs$E}=bF_^I}UeM&P4 zPQ!PizemEDG!)VC_4%}NzzJV^EB2XQ9<7kQ#)v__D6B)9BU(q~^Lh8spWgu9tFK7^ z-6Q>c)~H~Oi`T)5QNMiQ_f7yo!U0$r+^m0Q>R8$Cv`xS3=6>{CK15My##iY#h<3O% zgJ^B$mZVJTiZ5YPg(^Xq1dZ!EtV zw0m~q9H=k3&2`zhAgwGivhM(|Z|7@XJY4vTHAp81YgV4j?@NS(!1Lu0KhW{fwesQO zX1THh&C)?=Gblf_vvOzb@Rz5F@uYA5yvjQ$d1&q3#5?d~6-dKhzdw8Kc{|*5S2EV* zb=S1j8_Ehk=@cD0zp`()NNFEmOu4`N`*rEpg_n)4uFjQH z-F1P1gR`6a$Jwt0F}iGv4}hMo>&xAN+3zI^37~WSskdKV)Hv2_UdB&A-AJ@OU zgf#*;g?J5t8#3vCJRBFuuQKL#_l!4uR`Nj@%fmO=3p=<@Xc$I{yOlM))q;On0dLMP zcFga#O*9w95!>fF^Og0kCb|jzfB!$JC z`R&6+co68bqdK^H20r+r-X>&Y_3jHo?(N_1o*wNVUTehmXRHR#!xtt}tHQ*Rq=TZ9JWaT_W$vssl{vg|b) zbYWi4lF$cKbxngkS&zofR)4ngRr7ajTy(|gbAq%J{njzCpQsV6IcM0UqV|mFWjAVx z*%XIL<=)^k1}>;Jew(m&_6tevy6YPK3eZ|l!7oxz>DigxMXiG3M1bZ%w z;>yUGm)X?Kvc=B*webzT3n#!eCoXv)^R9~nW~;D&<+ZL|p?*UGTdR zw8G*zhra;qS7F89iLLZB3yL6LirQ2Ms&?7{M~)CP z5^m(g`%?uyQker$IlP=f&_L3n+{2=uXq@r}AaIHI2A6wt77=}i{tQTM{mL)L|obH(YiMC-gE)y#UauRE$|{-|HwqDL818iRmag8g2@I zN6zqp3WB!#j>uB{%mp`t0J+Nl=AZc6D`HY3b6b|S`I2rz$t-$N?@A)Or5;uNJTP1S z9YZMA0W<5$&kh!Dinvd2v&JjnQemqRHl_TpRP*tGVM6akWhtY#BC$_yupYKwt-|jo zv1%arCrlw)1jyA&pTKLXHIz_*>j0QuwV3UHrQC2}SADKXh4A~h6EVR$`X-L8sMEq& zX!1VcshE%$b-nGJx6>0b`=;6u?^1FwawuSi_$iddn=}2rEw7h0L-P>kHjIRna5^%Z zO8qR_;TqT}L>C~7cGvmDBrO*GMs5Js#nprdt^R;8YPsUrxNtm!T5ZsEG&~K*7Hke? zzhAsW)t9qvUZ{~2kHxZEt9Oaw2+7>{++G3idt@l7oRcC^Zmr+G$zBljD)EZfssBUc zQJ{|b-&4Xxxlw!lu8Za=go8vo4~!nL>u36NmDy0v6;62+KfM6Bs8CXbYZ$qu2u!g~ z(aDCg$Nhh2RKr;%QD%M9&82$GrHsGl!$2Ih5nOBv3>X&Hrz+8jg{MN!i5S6(8IcM| z3JKIv7qJ&<1gUs1V?e8Z=j1#x2aRmdf2H(CF6Q5kA=0rmRFev%VT_0V zRDiw`+|2wHIsr%}5(-HyS9pzJX)ON0&tsrOuAdG>W}0CB*;ke`qkyR~g9z=u54l3| z6`5_WzmbQ7Ko;5n^(9U0FOmgRAdicFJ47C7F-c(o42euW?=18g$(e5~n$yo;#47zP zfle$Wfs$TkxLe$X1jyI5p=X$Z;i;(ff6axU6GA6ggq#2gZsJ`W#{aK6ycw@BacQ zi*X?Qqk_=zlZru$T{M2Ye-xE`CCdzM1QQ}es$27)8npON%^V1(gHY;wu#I z>;Az15LuipmVZ^7d3`#c z(fk9M#!#y<_j4LYa>|NnX0s)#FhS~m&OG6LobC?^)Hr# z+z#M@=8oHA!Sa3YC@ku;bd!@m))@au#6d3L3=+@M5LbvR9a$)6R;05r{F6yUXwH%z z7dRoj5`%))DY*J%HNKKCvPe7Jx&2PxQO*+kPMnUpwGAU`ws;)|YP`+)T4)ZAh=|6kyrP3G*s)kQBa>;Xr1%PEU* z5IC#i^I1|R|>|PpB`hQ1PWl{6G$Mo|(`{ykB^Y zWJW8It$xDKrz}20qT-Ph+AV+)l*wa=Sf+wg&9=AnKZB(GWJW|t7CrPQ3rXnLRTIUR zRS4qi;ixlM5jGO_^i;^WZxjHx*+Hq-KYZ6jQQ0B>YAWgsGnCCi$b+ms*z-S@z}M4H z$R+;D3%vOU@$z4oBiVpqF*N_fSuBm7VAs}#z-(g#c|D_c-&EFD4nN9b&hm{PTR9*3 zw8fM1+sM!#!?^E_T2`;Ze)^+jxy_@xIp4r@eEUg|{o_~-rx&4vK?TXMnJkoEIuSH_ z%&_gDeX{dMaNk+ftTf{yZBaA<3&V7>xJn5fT^np?@*JH{OP4rzc>#jqBvgOO;;c#1Qxf#N6qJV9i2>dGKv8-YZx25iRCpLkwcUBdb6^j$V&aq>Z7fX~ zyYA}?jybQXV+Jm^U%1qfgnvn zDSD}i<-sX3v7$J3^9LtGtwI-JiKQxtAGHS~w2&9tJ{x^2i)G^>Yur6iA3&v8APC=OP7=-4{S6$h zpP`XCl$kJJ;V8DCP3}osg*g7z*GXjtVd+Nt(@7wNA=WdeNZ0%1Q9T!0w51WUNR+8) z{4+fFagc!qvCEvV@a~^%P6|?H9~X+%%$=k~4!)EJ#DYzlu~W-MsiD0PAb;w!S(s|uV6ps&n4NxqCE`Q zF+*wE%btXLGVAe++-4Sg>4-d=G&_i1spfCYXVamcy)+i;1&4OT*LP zQbm7AYa}kqgnpaM#=zkK$Z&V$CxZvo8cJCE$Fm{cBg)fKS=4s>8B|gvTUxnnLGh+KynHc76})zf_`gvJ$!fbS_ydpx^U3@qmMo#< z-Kaoz#DDc`u;}_Y z?(n%Mi}-Na!>G(n2sd?!7M(0V#+=w;mqvl~B-gP-l;ejkLV_$7k%y{peu-FK7g7|3 zoizdlb7TpF-b)(^6v;xMVn1zbmO)Z21Z}FzU^CTd8#yLkF{=;pfMP{>&sh~Y ztLA<;MX!dIfs6IrbEV%ZstFyXr-9WeSgk$5O+!&E)S63WcA&69qbolLM-`vRqmvzT zwzeHD{pA0<*{;+o-_1nO%LJmvN&$({&qC^s!~4b+=)yG; za~1;!hMO5fX=Zxijx2oVKEug6s+fpvM>5a7Tm)@oOc?Er z-~i;|O`yoCE9O_`TNvnDDmvn!7om#n=aRacYTCS;v=LQeJ+v~}6RInc*HoF{8)0i9 z|4~%83Z6^Dj0$DzsN1LRipVX{h`sq60mjdQ| zphm*glEPCp0(HAU^PgvkHSk5%RFq1RZ8Fx5 z+8QSvGUohnmRvE@UD%^f79GUCd}gG(q25+~WsR#^2*SD_sh#(k4JY$I~RgGlUE37@p13? z?JeMi<9he?=mzNn>c4kfe65Ji5K3K=%T_6h3?P(%&59VZH{%pQ{Ai;%n!!+u|2IDo zQUb0(a>XoNOH)LmT1u&_@UYwUo>bQ~g$)BeR5*-_CzILJltW7gaQnl25|*qw5}qVW zsl1Xe+UsI*)l&cQ*w&f8qNX}Dz%Zd9sD4jdb&AB!|KapDHex&PH?s^HoUgSM(#FR? zP$C5&vcy!taL<79Ej2L3Sh@Y+hiW3YH@*38KeI-or+0-Y9{I(r_5D zP?V03H?>E&QV+S+$XdEKhSwoX*^nEm2;39Tb(3gl^uZ`>PNEu>kAa}w34wR&M&_5R zOhJ8by*$XW{r3Q9WVX;4V`ULd-^F;W?G*@Wu-h&)n7NC|C+Sk2DM@71m)?8VkRUg2 zSxp{$5v;Ez**T&~DRKH$|Izxx_F!xIp@!{zuKRkizq@TkrjM2#_8jwka3y|asr!EX zjv)wRzq~U3T>YM2)5l3?rL`3k@|n44QuUzeF01ZU8ug}0%Qr0JSGPTw>EW*Ts|3J5 zRCB80Nccp;ehX%_@t7u$e28wyF$mG5+l}9Yses?C+OT8RR~$+trP0+ zh>yPWxWjuZbsDbRne=@YCaHP4;%|T4i6tm$R7qSE=&t7<68oQ5IxAY=m6T6J_NL6 z5bjsoy|1>g3UF5u9DGLmD0KAU))i_?Nq=6S?ZeLks8Z?(M;Rc z`lW#5;ZOb~7MmXXX+@3@NN2uTYA)ouJpqOqn%LxJ8wmP*;yEke z5E=j(qHM>70OwS~Bo_z-7Z*Jc&S#Kga`JB7&ttb`p5rPf*?mv+L1Bp6=IUx?SZaV+ zgO619TiIF?NJd7&?*U=TnrQ+xY$kb(QC@XGv?q9M@DKNDOVj0+e=UZ!FCl{_u_0EM zGGc<8NcsyYcJREQ@YNk<9tI8bE@&RJFWyE6h)y03`X@Wn3mQ*HxOE9gQ!46LBhKS9 zrorrz7FT^Ob(!`s%p)F**wd$TS!Zapd(!f+{fmQ2t9TL0>Zg4wudD!o8M+hUb=Koo zh9Sg_l0!#`l8B++MQfl9ix)MsLa-8JrrW900ZJa1JU%NEucWdp$MjY(z4?lzaUvws zrBdu-$TT@sgo${~BD~x;3#*!2_W36KP(;qKw!xN`^nwz%@M-+NY<7rkRGB_{uO@=yVI z9U@|8G1Pf1Jko}rGQ>#kCKXT+v&m0oUm=gCv!rwDR*@epf`mMTS4%PAVZ?0KuoVfJ zMi!9&)*7?ecdq>k%@llQ#W&=pMNf`=tJIfZVrxXf&=M5zI z&>5*I^uM{LENnpMtc%QzQm*?Cgin0mdiL9{)jC^VqwSZD=qW>Z8JR+Yv{ef2yJ-E{ z%3Z5LwLT@i+8SOhnSj_DoRz?tE(mCxHwI?%7J`&PXtr_5u6;{ZYLcGx3R&UUn%3pe z8SN@4wof!EaMND+JJIu_jd=IjWBM-)_^*o{)|sI!fNe~AhKli<*_#4yyBD02oE%mt zmb%3@ukq#`&H~m236wbO!en6x4>x3 zv^Fu=u+zs}X8f+Pe@ewnO6sBH+dvB8kZLtx(CxeL=72*IZ(Ra>Tzxm1sDGx)QhnP$ z!>O3G)%Q%i@yWY8GFQDm2t#JrD7jO2S&w|!1gBO08-T@cRCNmPV+(c}*L#-oDxPpX zEBCXEd%VVm{R8Abdk{onpyG;W$^{DuHSoV41Q6j~@y{NFuad4rYFbtICrPL?xiBPf zw?>W2A6<)VlAG(&P%$h7%e%MBLwrL+b)GLroje*f?rZ4t_9hW&RzIG;S2Pb?xtn}k zz3fxgR~5^~tlTOP+$6oR+Mde0^1s`?sLku8duRW`RN-Kw_1tJKDcWHHmiQQFP1Ull z$vPS;j+v~thMt!!{zX4syvcp@wT_;l%To?BgKOelK)m7zO0r;5BTt@IX^pnS-&vMHeK*U_~3cG zo*XY-l$17!n^#pnTgFiVT%2;gzWoi$Vrf^&f2B%7aV(k8gX8pDR9b&ahC$ z!5smSV(8FvyeD0!v-Cmf^GLiJ<%!mIvP&7czrD|g`oMnG*Lg8?{W`O^<(M5@ad58=fSxe%;6*{VCAv#Ln%gH^-i?win(z|D2$RH*iBOjo_}>@xPG8S zIp@&|^sC&{4!`T>$6BYpde{1~;+4{czZ`OWsa|LOK+Byj8Zp2V+8gBUbMx!?tfa$j z{g*zOn<|V^>s$J+ETmKr;yBOzTP2r(_u~c)oCT+X)^l~XZCmrDnWHU=80h7K@_J*2 z&_ZL?X^}-m{fS>Ju-2{Ox1^-H>0Z5k-^Nh~E0a(TI_a47G!}trh=P4V+*h+Xb$J@%a&RzYo<#bkqG@>KmG)Yi}-xM|09he534z&B^gNXi1+F zTZu|_h9Qje7L0NUl}3e}pc_h0$0+JUeeg4HtT>nh(CG-+W~n1PERgUi2O{_4`4h50 z4?ZbD3cMpH*5*DTH<}7YkeCa<1ajRD-z`TmnBZggj&k&t=GlW^;YJr!*41x4Fo1oF znU>%)kJMtG+oXC7a=r)>M9Q=24k3~|GK0}w+RU_4&xgR>7YPtx^+v|sXN7=aN1W3B zHa_4_WPS+DI^m+qnCA|nAqcSuk$;5+#nn)faWrBP*q^nK_?Bmnk&o#QNrL-5Ur3h09WiqTQ6+QvEd)1!Hy<8=>|3POT@VGcV;&9y@5G3ps9} zdG5eZS;5HC)cry8Vcu)w&v>R_KePjo5q{dk0)`?3EbL-rY^L^>u1{tf#) zOT&2Jo!_K9f(CITLLXWyV?rO6YKML>Ru4?Oe-HQU+4KHXgYfwrDEX#S1$W^J#?;N3 z82ewekH!06ex9O50XVx|W{EGbvMu@-uBBUCm-xu^E|PK>u?h>&*e0}gu0_kh)h zNC&;Vu)*2~ZuD*c&dFSksLy~r*_qk@LLy%{0Otb8{)0)cfrS)N4$e5we8MbsaZaY`gxA_ z&-;JNLB3#aC2IdC+B z@&li6nQuhNyIQ>up;h+*JiBA`X%L1#W9qLopW`4A+$ja2Xp2t=mBLDwxMumJ^KRQf z_c>0noe5f|d1@jk|!g`D}Te$am0Pc;{&Uvr@QA*>z!RR!h&aoq6fxnB2C0 zujxT~zSsKpsf72{L>w_C{v1BAv7-F`HK4<|`?YF#?c>XrFCQsQWMC+;qw!@QFQ3i7 zM40~``KJtXgWv+VOx#GcRcfA|MPUiKkeLwA#nbOE$=}KIetPH^p1V+SW|k{gN9=s| z!tpTcYG@X9{7p5s$$+Fq^^u5}9ellsd87LlRURE7oO$JMJ?5&Gmeb7t(de_cr|fK6 z$>y6^%C_HH%}6_19?v|wV>!WC=_?=IF}8!Nn@m;FmPiNiu^{cG?fq@G-Luz9jWHacclwNe_DQt=BUjOVt z;4=nLZ0odU;-$R=7{4dU1XgH&HXKGhjTcM@NcZZC5ty;xcps0s_?=9={$5*h zI(VASel@dM3_*9%C}omzSxx1xf8PFE+@!+}bE`h0Thac35Em1Z$sdN)iNzFsa4D=Rw0T3r2T=#sM8o+#U) z2L*N8iBrAf!^kX-<56dw{PEegMxm+y3l~#^8}nsiAdaq976Go304|H$Pn-wvXKXa_ zYcc_@&W^$bJa^zK=_BA!GLIuR>VGfSyUq61n@j4SX z07*hz(bO@VX8!~0W)M`BfJfI*?RS^}T`#V13NC(wUnmZ7^j_bzxBy4)Fhj~$0WB0d z3&kse-2Ws6M*Is2wuyKdN>nR$5$a4eCsr8HbJAVuNgDJ=*4=?t6t)lC&B7M%sr$aw zYW2ljzzdxM#xh+D?G3pbWvz4C5he6O=haT0AMSE6aHjRa#E(tbpV<0b@YfgCcTt+q zztV-4HR)u}90B4xqR_RZhG8NS3VMM7s2oay#Gq!0mNo+5yN_-tppl{+?1pLJsDUCt zu2-}Qa;QL4gZel^sIMBEZr~SMQafvDWK=(^9}x6EMH&~i+RxN#Xhde)t$c~pgHB`L z%Iy>wLQn&Zb7#U-rg{gT3Y*x7h4Ev=N0IeS*cH}-|3TYfDzO(vI9gUVh)N z5cIYE&IbPyF`Ahu!}43OwcQdaeg(z0iDE5$B`3T$W%Q$BCe=3ob7X;}>fC%50-KTV zzN-@;$}C5S;Mp?-PE?@sM;3@QQnN=+kRfeg+PKao{xIq3C3X+@cCO}%Z_x)^=edGq z1oBo2)8rQwyRy9$e06#|*NK=(adk$H1K`<-*N7w8a5ayj+B{)D%Efj2_7oqE;j!xA z&yi0##~R5FoF9Z%!*ps~etm%b=SU74b&7Il3i;&=89~Yv85nNLs{jaeN|G-q5@5-d z4mpz*lB8DA$)hZUtMXejm%Zw~`=Sn^pO4LYCe4yk?sSsqz>?_ngt11|g7-l7$CQV4 z!sm(HJ!@J=k-zec|KqQ&X!E>_MW?j1)`8Uvz3my}f9`{XGKTJB53(TOo!gs{bX>JL zvGz62*!X;7>%b4&L`}l}$8(5lzv!`Vv zCvveY?rAQ>fG2hI*>5$IgDF*un@6XP5p!qo@RxkLHg-A7AF9pI_X@L=os5DP>f0r0 zcgw%|k=`dmhAw^1Bvs>B8;f3SAjhI(HPwM5x-1sFG^e-8&-B~yYN zyR`#t={3Q4OJZe7f>zuarEk~OwB0m~5LZ2F3x;|e^>+;}p4O1NMP1h}V z4!CCsw)m?sGwR2TnZvwZTBt&dazp>RP5Q;?ze2{m0f&hK(&3!*Ypq#7vpI>kiJ-~@ zMq-je7ZVKyEd=^!al{( z^oDsH^n9Ou>Yg0#kG)wuod>Ep6p}mhcDtFz0?Nd`AZCe;+B=5e5XnBa|E2-D9u8Cv)bzB_F#kr&;skTQ{Q{Ydb4s`{2qC~Mc_u~{1xAT~ z2CXLS68N`sDmv20y02sUi_b3U8XIW;BD~ETwkx?(2q`Ht84AgF2DGbW`%3Fns)!bm zXmsLGN|-{<8E}WV7*w*uT@V}JDux6s88;a44;!>^h(AI7L4C*shQWuE>R@(*sgt9K ze}d{1OQH$*c>jXI4lxBl{qqHUV_{+gjL?R4h|#bG|AM#4)Wf(HuHt;Nak~zWr~etC zhBY{fmTq4PbJj|NhyfChiu>Pue$=R<$ij>t`*J4ET~u%VGCWH`TX6(CRRYnvM98Un zy_&KgaY_wBmvNe65*mG8xP071hYVjhHQ5xm7;l*qfPA_Fy2u6M7lcD9n_{-VPYaGh z(|`HVw^P!n`z}z0lTyrjJuK!+UKN5UYSnm4#bu7O6}5QjCTSH{Mu}3wlq6sWxRyJh z(yQBp-coAd-&Y zw&Dhk3s{&C+!UJ-cxgY~DbpM8$lrtlAUBJ=56f-Q-5XcK+= zu;bNxEVhDTsp>5x3Z;=!O#t5(nW6$Q(NGsyK+YrEfhK``wBvF2ejHS91?1TybXm=I5bG37^4fs!G#{2Xc*9u*O<+=Pz50dmyejRq-C0+9kQ zIrtzHhMGEtW=oue26~{l{)i{%qG?qax}4LW1j@T5+9%}fK4qU%iSQSp(UAWqv$03) z1>v2?VaOOOAEo^hAE8?`t{$DS%l(5IVu$tlucqctBGq0dPN{cO`F6XD$AuMtebTdqat?3lC#KzVc|pK?t!p>W zd$xIQ{OIgEI*c!;w2Cuz@%1d2=v2zQW4+^v=)W6`5T@ZX`{xEzP4wRlCRZE;3RsG+ z;6U~!vUmr%%Jv<{%qLgRk{ezPi4$w!n++r{6%O@XXGsTg>PfIqL3@(gGUWCiRSeqY z+%>&lWNMZ@GqEIHew-NF9BX++)EhZ)*W7i#!<)kC(2iWXz}GC%>z?S@=K(9Pud~Nw zqk0k2_$j#GR>PZozK*`kd<#GPB;4Tp*31->*ZsCBS}FIi zsOFnkw0!tC>Uq3cdp!YE?#RYTd>`spEhP5UYB#9_>dEj^l?lJ4QbRR8V1xbh-8fvz zySLB7_sa0jLm)zKZazOIsy!|P&2S|Vxg#Fag3i-5J!kbDz-#+(`d2<;X?w}ptodT4 zfqv=C^c*eKyKUw9#{s{00~h7D-qWf^9=@tOs(K!Uq3_N{4cp3x7v%5MS|3&>kJsW} zQ3Xtp>>`VQ;l2OVt3$pb0+j1>3d@jQ!SBgdLyzcPI-?s6F?!p(USIwC{aTiOGsft( zw}k2sf{bT!(S=gC`+GiC6v0Rnq<-Hr+vDI&PH8%yz=}3%heOiH|CK*B1C%pLtaVsI z6O7~a-W0sAXL|PE(l1<6FpLlz)WOFKKslniEs#gF?xbP*X$(311z4eYi2PzX>ttO) zq1<-te=FNf1qo+%02ki>ZkSt6>ExG)W_zN43CI4g!L2 zC4+g0|0#ocjDIErHK1S=56Y#lm=O^?=*wrtg}C0eX5U9J_o))duPS$h8m5{0OTiQnO_ z7Np=br5oHb9arl(8dnVC^8yfeo=_mz7g>H77c-{_DzRtFhCsCQAc2y1hbyF7M+C{9 zGOL2%+xk*(1qD|?YlDgYKzkv(AMEi1qCYpEBaX&|_VJ6-K3gfJqm?wRBgUw19XRY{ zp7l{AF-Q{OMi@T*9qC< zUF1C={ zE>5dBvh0^TM{Q4&2f8MDP99ZK?jZ~{{1lZNORY!~SN7=<1GE`71q=s71%4*^K*tz32@?+PTveW+@?ntl2A-v3o}#9GFoSjpjjtqUR8#NB=ZC@tk_R9zTotAfa{*ASQLew^}{_EKi$nQYmaY;9)hpyP*xB_0x@%9Mj*Qm$2Z%nK-h zfykh`!6}=lV^V;#BKuC+v;}$rc_1F=2(Ywk&kJjfIQd3Nzo|<91MwM^2EXMeEQEUJFN1aXBcz$bji+f^n9_2Y7=( zqu`@`q4dAr=C4(m6F`E-`21SzUtQ^+9PV!wpWPso=TG*!k_yXJ4@(M^`g{n14?PZv zOvQ=Vnei*c7!tBz)(M}*NR)1;hJI6ZGFEL=MVEo`J1&jqmBirGVvvch42QNP_LZzR zH>y7zuK!$YV0N-3kqfBrM0D_z82Htb{eu3M%dRqONyzQwUX>7Hk2@*hKUt@A@zwCH zSGpo9wAFrv&Ff6_@(giz2S0JPVl1=rU1bQxwsf>f1=8|zDEv7;eUIHZF`>|g=Ht`Z z)a41zfOAA_*h@6o+W{MMFKD&c_t;f{q;`Qc&aK6?TwMXH38Swm8SUCc$7#CV>`g> z-S)%lV>DsooX^|m;i@m9r0-WriTpWV$J^shI}+e|bqjpdEN-02=Xkwe@At*n`aC^u zoe#_cYurBF@xhDs?BS}?oV=yyWE`(8WhN)n_>#SGV$guKZ&q7M{s|N8+wI<@Yxk=I zBY#c~Uu(DI$Me#Xl0|Oo>sV+9wVzOH-)?XW5ZysFveV(4) zOS%ajOf(jz_}yP(CiVEbKDtvr_OEa5s0tcJkHK@Z=6GB8Xm3)_?=XnvJy# z_r|!x-5H73o0;MFv-+&!t@jky=I?sTp#UFt+H6#R4XxOAj^0Ol&D)fPNoOPKM@M75 zcRS-~$9Wjv5<^r!KVuYK-&Q=2&7Njw*Pe^}-Tr7s$|S${>zgF}Yztxz;O+P^h1V64 zd~uQRl`zvQrys%LgBfW1NO@NPAqGSj-=}3li>;<<(Z?6_yK~K3F+0`dqwAH~aTOQkSz2~=pLm!rP*PEP^ZjI5)whyeDW#B61Ua!Mu z<@429#_H3Mlw0SI_xBK8o+yyJA&3b6f}?(QRrH4$MHZGtp&#j!XY&f<^}rdPUex8B zH)~fn)@aW3YEO-7A)+c8V)wd>IsxG?_wGJV`x84}cJESB=hAe$$GgFH2W$9t1d2`5;MYr$c#ZJ z#%jvdVW%RwGkg!kj3`6vShap`4zp0)6Ed@v;lL*_9D@;}$ zoeIiv)!AIT4vLgiNIAN8DdrwU!$M`AUKegzUrovg$@#}uyY#`sDC6$O%a%`t1DhQ+ znj>{?WX4sTIlhL}AC37tcw}vlRb04E$2Fk)k5c-ocn;>7o z6dmmlW%eU=j7!vq<&bsd2kd1kOZ?E2GM*vbWTo`iOKfVb@h7m^@T2#0>arQ0dnxa> zejlKdT#_2k&lE4>^Zahtn<1msf>sZ^K=|?Kdk%Y?&kVht8h6$1IyZJ%_vrkK^Nms! z%f@kM_hdQzNK#UgJk@yr0h-(uAER`?A$4gasVUhqLboxs+P-YozU6Vw58H9wz1|fk z4A5Zd%hVzVjJ!JY(V)}p&3g_vr{sI};wz>acuzWZiR|?@>XI>U)6t*&#AMx=bZt}DGF&1Q2cEik+O%*x5_nM&-LqTN*R_+)sXu8j9B(mY4;qcfuj z&E208UyLOhbs4t}-h0Vw=m#6OhNlu@mDG1g+UMQIPT#)zK`Dz%$ym%M)B?`BT5JqW zxtdCv*NagK3bNuE!dKzyL;I_B$rQsB7wxZ?=G1KLgMoUU#YUbv6bXqH; z`E@5|U*t^@z@koU$bAaSG=!(h<07MDJ_4jlHz?&zC7yaG(~y&T$5|;xX*&*>@jUkt z)(Orv_}&fZ5HDhsj)S^aflB^Nv6I9hY`d3=;m6YJlA)ZuK6P#iNqhoyHrbIa<#TUM zQfP&HnvQYT{Z~mnogmHwsr?+1FUJleNTn)g zS!44=s_fpAj)(h>T=^{zvLuAUf456r*-ppWU-Zr+E+wD;2t4&)fph*NFunptG5OaE zyd~0)&Ta+5_}41FpIpVS{Iw0^S6)l62l%qtr1_Htmvy^OAIpz0 z>bhUOkUH)nWBsuy^%ERgaFbTvlst@`at4ib$Mb(N(Hcb>vYOe0AsrS~)Cmp$?O#tA zoa{gU<&m$CtS*thpueItTxX5_=!?EGMMY)gaNv|69lq?NGgQUjUYANSw-v?z-!(9$ z2bq}ik+wl2FT7dM;~lk5oi{o@&}RDV)~b_o`(s<$4y?&!F|{9# zk*>eJktK(;)}(YckCYf^dKbpr>Tk2b*hZ65xmcYyuP4st#Hc%EyU1l%2B)5u0^ zVN**T9pKwcOB!fmhV-bg{-JYqB1)VN0r_kuEbh6>%m1(pERsKr!dKijAAJ81!i$_lu|h%S{3iPAwIO z*bQ?`hV=$F`eBTQAAxy-BUa}A1? z>z~YxJY`-TwMAr`ROGr8HlJsvI_u@X9f&RA^5`5p@0IE~uqAib(H*kGH0!_~g|o^w zu4^-w^WciTvU8o9O#%yZ$Od2X_(3zi$*A67v6F$zMFv9uYHO`qU0+Y=5CW{0c-43R zt9^3a!7bP|KT?yU_HFvq$T4HUU3#6h7K0HwOW;*F%U971>2<1B>G=j+_93_FGx6iu z{hPu3Qk9&WUnD3NPgHYA2x#7UIed|0G6r@_30PJZK2R+b0Fzo($z#R~9r0IouTwjf z5b#=6dJNgU$$ELigK!vG9SsjGV{2}a%Y?Mpn$w)Y9XomAK1gx32cAxUp4svIYA$!7 z4Zm&m?nXs2bC)V0OhM{j?cDXN>&KL{yAPK;2&{1m{^}n?zn8Jp543tZ!AfJKfBov# ze{NNeUJF`!kP{xVH7ws5G|@uG%6)79yq^0uZU)2eq50d^xaNMr<_R9(c7A=8qtvsA z1koU|4Da07V6)Y(MQuwX7;27WmfOxCzmqJ+K4**yKb6nV`8ApyT`!-0Ft({ZK78VU zf+0jG5Vg&QpIq(!t<$5_puCW!%{(RP1Dwi}Gk9v}da#?5YaAs~x>;kJL^Jp49XQWf z_L=48m!SRFdike-#lrYN@7CbuP z#l_ZK;tc+=^M(+Z`i8bn!BO>*{tc_KRz3h~sL7bj{7dz!lG_Oq3(c;Lw6+S`8XnvD zbBpZnk7|tYZ(L2}*T_(fT$lQz#;aAkvg^kJ9u`g)1F$f$8cWB6!6rz*e>^t$!;GAKwU+%^s+O)-2Io4k>(UVg} z_iwt*5!L?XY(Y2$`*m(yR?Oq(w&ho-xp4W(k;Mnh8}?sSGHQrjt+q}rn6qcd=;-xz zsYb67RLmUf_Y068H~gG|N9P#^4fTZ7qGA25FI`2R3pn3ka_~n{H)|?b$5ljw zMk}SxL_c8~8`LvAPUN%yK*U#ioin{4igJN(Orqvh`DQgRVfj-J!({efRZmL_-+C@3 z1dM!IG1RV&g8DU?U2G1v9L;nMPYJFfQ}U+NWul3yk^H}>tlBE@yaI4?@Zb7%^f11z zZW=@%R}l;XX@l$sId+P@$g#JXw|(hkjqR4%wQB32A`;p??RAB+W+4yS+j)s3$1Wt8 z^Wbiai5pcuFra2otvCflJj200c;HA0VSTmHm9kTAQEnudL|r0hh|Dguu1gw7j(Ln) z%q$FETuZ?SAhKABu#KPumgh7lq#@4C$fx5I%w9*K}Ny zB$>q&m+2t}TiUtL5wdzyLnxXM`}%+6J2hva;TsBGz#EGV>4mGK9HOeBpZD+E=|oOu z)=bPgRE|B%MZ__`WC=6|c@l(CJ(!{i0eI)Wt6{^ zn-15=yq+3nCwJ0B((I@-`GNNmL7i&^Ecifx)-2)k;^3V#^LlNl)C+f;?ZKrShbTx- z$M|TmKGDTTglfW6YrtZyC?*W`7P7MMD+UauiyTwgVojn;tkn!}%+{rv#NfR-o@yZd z#HWho`@X_vk1ao>tTNv7PNO!jG1q{QWkpeom(QGKb4~u5!-`#%k1s5KA8#71e4<$Q zLSva+ao{2Mhh^vCbVT0edmf}-`_AHva*scjEPiUoi+H>sQ zEUe;Wn@~**56B9JpT@`Bvh0RR?N0w`39aDe?J5JJgY4OI**hjCVx${4U98P%?e*1p zv%^mj6!ab@dd^_dL0O!Pnyh>cJ<96bfwP3%i_hM|f+VkG;uSlNLD4n>uM9+27ERW2 z(J?PEu0S~^kI*{3((pz=3qaVjwRF*%i~j0&|GS+P*S8WuklWgW55%+50Rh>~E^5Dw zL*cklx+$;Sb?++25ldTW<+*Fu(uJHmlfj;YS)&z$GPVK&P%JKMOEbB0P|hI!@Zg7! z#!nY(O%2B1+zDTGGEnLpJ}q83)(a$i04k>dvdTf=qj7_14Kdi*P<`9ge~4&V0d156c}KX#48xNs0@ zyA?ngirE`AZI~)D|vkNq)~8|i{^Rt@pB(1 zs)@nG!X5hMABdDOd9P+d!JIm61w}ZuQ{8Ww-EZ8I=T;}pR{M%YVr!zo+`QUs7CYr$ z+H(wu`v2hf?T#fvaxW7%WCH`_5(WdDc#VfP4jzu_`pJKxt z!9GTn7e%X>55$N4;uMn-x-pMTO7Z*tO@X^1)KwGd8iMXrP>c%fptu4S!^X6RNl51t zF%NV3j=Z>&W(2Zr%&E__G8+i`scU+bpGoNxM-b%^haS*WNW$s{TEee z5x|9Tn9^TH;mREI4YenEs*Om4<Lf%pm*!tj+u z#wVH-nNX&gS1EB2a7js2zWv2>{mAExa(@}ETl(4~%oVF#lg{aI6&G`vSU!ney2+Gt zLXCdUp3xZTiO<^083sNdh;!#lEZbT3{%pUFfpd_p?p#VHLb+qm^9zyz0piVB($U^#x$t@5Gw8v<^Et|YbQ z6-C{6tqAepkUTf09^2&G-JGSxus~21zxd3I`&9HK_yTmq!C5EY-<8kJ zv3>t-1O5#{SZ#wdDMsWv+r!0f|e7vLrnSN?g)i-{!Qhi zQ*-mdRnlV6gH#i1LX42%K)78XfcjAY8H~Xs-Ka6;x5iv)l6!NM-e(PR%6`B9v(?&F z(P~0j81`{|t3b~c?ps5Aq{Qwzd}QS?do?*!#ecL~8?$HS@cP9UZD?bfFt(UH z=OZ$Bvfe7qNMi>&Pb4e77=-1zvma3JIt-2D67UZirT%y2s&mI77+Kd2+I8dQIUSVlr?^ek>MYW3nJV; z<$x%p;pz4*^{b)un@%jukERH>ACxATvoqozC=HntD!pKxPw>?}Oi*l2$#GS)S}(LN z!C8h-vf1Oc%##C)qz^=XFkh72Z*gDCMC1Vkvzs8L&Ho^QJ{p0>LN1h1jvZB7|B?H5 z9QHVN_y{K71d>+~*RAs6=L#3apdWR^r7BrC#q4$A5VCuFGhtXPuf8_#V#F#g`Rwp} zaFpg6IvRk0Qoj`CD%?ZOZ%ra+fXpta3A9F#NKhfh=Sxv4hZrKuL0Kr|eixRYn$u87 z{Z9=vg8hF?puM*0qp{)ltnyo^GPlgBO5_JYykhc)@m;p$-0Lv2cvAZBDpYx`>~fiZ zzb_O>2rl>t!PPHXPk4!P4Q1m-MJ5-HVF;3UqN$=_IvTN*T)f7rb#Cbt)YGgEwi}@) zOE-u@odLd7wgHd~s5U0mKk_0`=E%jox9a#_4x_&hwg{1QEt~t?Dc%(sRs;`si?uSw zTLqZ%w+I*x2km};@Caxg2zc}Gr_7C^mbp+F&k;H_QOtI*U3Iy}OAh)|s3VKUj7z*z zhxGJtMeGNDVOZ}Gbs1EgTBk5VGYksGJBdV1{2P}EQxQ-VBMqBt8l0axrh(2yyLIp) z8yp_U1toSWNRLYwx8oJ*>(r2g^4};R(QXw$r^P#(UdyBSrvgyi`h}-Jw{YJ5EiSp0 zZ-XemR-|$F+tIO--{)V;hWa49%4f%1Mf8zw<%F99l&JQB7DgD&r}ikZgWaj6gj{zK zfdD*{K!_(ILp&MGxfD(07et0H4J}0i&3ad5#@`KA4O<}Zbh{fTTo2H;GLB59f3uq2Y&p%QNr%>0$oa3YhR>}^i zEvHo8(BtM8@-AX&IW>uLjG$D!kH&pJctuX|#09-!%4b0b<{=E8{v^K}g+ZptZLV_} z$`e8bobw?SDr34v^Ky%Hh>t1;42Q-jITMAf|SMn{uJaL|o zcM%hQi$+T2&dP+^Q9Yv>cT!4Tgm5J7NFBhFBCwkcvZLU&Kp=ym0HLM{gj!>6=`ljh zsU;<}h;*Zg+e_Ty-gw@Qz*mLjO5J9Z2(b`2OdpXC$Vsu63VF*$Z^=+?SsoJ8-b~O&B1IcOVLI5Ji?zZfa)bDcyE`;|u_@;; zyrHK$Y8nMuoYF+mM$QBE%L!qRp{->^bs`EQ)N_4U@ofsy#)+B`$0~rF`|lzUvce(y zouJxm8C2~nNYCcIzz~pkk+u9i35AhPlLo*;1otDnK>Db6M;?Wzzv2pY@81l-Ul?2a zLUt1r+ZzD}2%abdp7;`Vh`5Spe}`slifjkLW3}qw#UxVT>dvWU+T0k9_&_*FQ`L7NFt>S51Q12 zTq)XsdR+V<N_Huat{QIVPDuC2Ej8+p`k|U33&^;3&4qisyrwsnrqfUE*&@IzlZ@_iq^V2 zoP_ulXssxe#z31ripQ%}A3z zm&UTjS2_G=sxK;%eoKx~M6b=$!y_UW4O?r@J%>z01q4!33w*m4(W;P10L#CvgcCRc z^Xb$O+-=lAr<5o|-4a)x|6e>6eikarKy}BS94rP!c0|TNzwm*GaEt5%moJ zLBlpc>R7~0L#|j*%;Wh0fCn`V4rk^>J;d!)MjEXE(555+OGa!ucnu!ysniM%Ie0Bf zBMkZ>GDY2ZVu5wAN7O7Sai?NMF)n{7Bit-T8i13h@=nNnzZbvxDS;f4Dz-EkVjt?4 zP%xzU5senm7?hy#Xc2WnOz0Ho@Vl-wno*)7PM_oa-~UxMAWgOGwK-punCy0DM#|XW zxj=?SsEUd-qDkSPeln~$e}$y^cv}iaX!+5|-!}S~X9;E571I`_(VB7?(0gH>f-wTE zNwJyVMGm@2!EGjZ#Ts2-$MO(My*SdhQTDdgXb!kN>?qH!f_cr%UfR;567>CL&!3c7mS}z$OYrAmeqXExXX1LXH8FhzzPT^dU1(Jj&y` zzz%9eWlvMyi(m^kb7)Zxo<9w_b0UUB)N{~ii>@|W$)b*f_u5hV?xT8xu01W6HsGX@tZqsA2%%f=k z|E|5lJ;xd2c{$rqqGn}j#3Shz(P#^3#DKLvCD;;rF@X=b#3&*kBh(Y(jKP3y2%Gy4 zAp?eL4rH#ni_84bfPP*TZ;M?>x-7atdxJqg@ZLccS~BbM-l8=6`NGSPP32>KCYxZH zr$*qGqLER?5;>3z=Ds`9zEcC%7H=xt!V+``FgB2fGXjy&FKm@}b9{n}@I1l|8!&gMrH+~?B`HUu(c&cZd2 z%zv*UQF|#BCwq%hAeUQdV6UhgJEJW8aV?I9n=25c zvrKNGb%y}vWKCEGQ7fq4Y_riEpOa7s$~M1@3@S^NL7!E3fTQP3~-2( z3|b9P;6{A|lCV+q@4e!1*eKSBuMD~ecZSNkkc0U%qItovKw_0DT=!O}k0^vb;A1)&Bz`;fTIAjcpEARv`YM|)Pu(xS)lh!BS{)g0oTaZXQa1fxQ*%48jevU-8f#Mw3RD zvr+QJhdf)LQqEdA(mmcr6he0&HmeGUPQD3RmVlkdh6b~*LB zF=MD?D81|lgCC*yH@lhf3G5)N+%zzOLIH(uX6MXb85$g6o%CY*vIX^ovqf@kC#%HDQy*V=9iRS$@fYiHav zOV~ZHHDGqlwrFFm?Uun+&JXEQtMAzuDL6$S(NLBDpGXr&HC0Fl>O(ep=f}^d}ptWI}kmF9o!aLD_IDH zu*cgszLfQKiyrL?+2)Og=_%PP7)9_Zqp4Ls{9Gtr;z@F402wxPC+4Ang&gHiF_eZN z7TTjYurbbdOD7_)>|_4VC-~C?^HA$!8>pcYy307*Z4$683b1&5hhiW7Z>ktm!HqAo z*6J29PuV~o1`;VOfu6rL?N&f`=caiYJSv<}!)~LzR`SUxXxz?MML1DGI96rm^h-Rv zJp3w(uPiO-hz3@oi$o4}0C-v|cMH*;`UyUOXKS%6Q-I(!-d%!1MY1|jn$0%o@j^GV z)a+P{q4c;9Zf`06Zp2l*IW$o2?At|v1&>D-a_oIvCX`EHd=idbY$3;zjo%0G%+=t& zE`di+qlEaHnkCHjDVY|k7z&=aVN@FxsK1*Z7vQ1?%itPeszd@|I88;#ym(8BtId4> zAEo@Y$jXE;Jkj7sXcC3mr~E0eDHv9_Eo2$|l=f=c8nh5DA!MNtQLAGf`m=D@3!;Rd zag|XgJ7pFs_%IsX{Yd|Kj-`L6CXrg=gQ%93p&egV(tZz(^}yRCyt<(T5o&-`$Bjb# zPyR%(2U(YII9@qQr|u}RX9*X(|4>bEG{omQ3iL?s0Env?rNmHTr~S8O>Hyh|i%3bd ze?h2nQSDK04gejHUAX;HZ4phLG6;%N1SRGHIi79qx0f~T&`M&*53}RTyz&h@UJBUr zdIey6mD2lhVT;=*Re}*XJVdNCd=*;k@Z@S-yLk1%go?$}zAJSfs%(A-ct}w=2;rhD zVG~jm#rPl{{s;5Vhv5MO#YB8WsP-qE^*7`g9OX9Cycf;?v|{R$*js-~iMN{5zdcmc~e> zE6EnZFAgQ6ZV{id`%$QJ`#Fj@AQ4@oIrI`i0Qb#M`NmXemI^+`57Uz`g*!j6-^W!z z3GgK|Ub$3g%5%5lg0Iw-I2{fuP#F@$L&PSWIh^Xm3}S!WfrvoK!agFv5a8df2!)df z@kD$^p+As|sf%{-v0AqDEQ&@W8$ZLMxoJ&hj&vvra&R@a z*USelL>r1f6mponJK~F)1)R>qP^?52yPcBb;nH0Nw24Mg^rUj%xCcS#!+8)EO?(x} zg}fKIDxsFyo?zAT4MOU-BQ&u^)bD_*p#}xu5FqCQi2yP5JpwXYaV4djVE1Z`6pu6% zZ-$4Qcuk(`zrFw6BJ{nna_r?e>j~84?XS@3i@S>KS$P=%j|UxWg_~s%jt zq|hPY{PE2pc%gyrh;Y(gZHoQX=(q^ZX#F8%JdYI~?J$G}Q5?(lSG2{S>B+GtyNH-Z z;%`szX3tgR;p!c5vnK0HCHb0w5s9SO6XlKo7ZSdLo;sr_Hv-J3F3}vi>lG#zCqhjJ z_0Hhz{R%4v2SeXLj8Sg9ict?jkr1v{8%%;x1yhsQ86Z>S2^R~SxTR3;p{EHE?T7CIf;A3=BLJ)2^ql}pFBB1Qpsr+UsYQ+oi-S&ek!MhQ}<^EQOkw%x!9iV+$ zfKFW5jHxYmMMbPd=e1bba10R2d?OvmmSxa(wTBZvK}H5 zvL_tz^0UgqCfs}NHQM4Rr0oLrr3e?%5)q)cah@7I9ia~3Z!TtifHnf z`MFXhc1v1K%-w+m_nV%d-)*QMTHEW8=NWy?HJ1r+zPMtF_{dc`?2j#?c92#T z^~PXi0&!_0t7?7WJ>(xT@Ef6dy)*cg09UaVl@xBRhkWB;3pWm~llAsfSN_}+?D?syuB2{Gj6 z7YDbq2ov43MvJ59wj=ERHLIk}0$??#c!g6!IyE|F_O3WBXmF~uU=A*wY=tJSzsFJ= zHW?)JcD^-dgyIQ!zs2&q&e>zeIDZb3&CogP+Y7+0^Ppa*OeuaQRNUZqR@8_S9M5W= zh;Hm~yFt1TIP$q3t}gMnVas}VE->p~1;(pp|0-!T*7m;dT5h%GmHa14yY6H45aQXI z)y~d+*ut1jR7)%4g3Bz{>-)-9ctL%8Dvho7;@=TMJN`7|y13~kH?y<~O-6@IxWqwA

+5wnV@=|%wt-Wb3v^>-(5Mi&q6 zNELgy_v2?kSAKXtuw~yO5ATO?vb2j8!*5|~-aVQpP%1Ssijqg*jS)^Ke~qfmuq_ssntSw)lRu1p|w-K>|lgk$NjGAM;E%ej)&wS-4}hE zc#SIIn#9lWYPPvXBPAqvhtm=VUQFQ^s>Fizl*>w#1Q4OE#_{wzg&v@W7dp~q3KIbn znsPBXw(5F#0z|pNsLg<%Ab8`cjIQf|2FXkVVsf#M2;4Ug#7OJNu|MO9x|5S{;L`%U zKfE}U3;aZUb}C94US6dW6^&5xMn6@kN?fa~ZwAjkx)9H<_B7z6S_8cAahU@x(kRL7 zYj71=^-2x#Sr}@w5NSdQppTBY@%=drE!!3F3CblSu8dX98Wa+Y`i;Ql^DCmG_t8Uo zbZU`sI6OLNij|`5;05YFCiBo>8O+;|ccg^{8TbdN9o9x?!<#I4e~mv&hhI-P2ykYi z*J1D=cwUdrUREZ8{N=>YSx)geFCA%~rJG-3t$Zl2eP5!!v=J^sH|_4XN_(vcxD>Zr zia+^1{MLS%6(bfDTy<(BGXt~JZ9Rs}tey@lbv&3V^EF%E`lh+X?0Z-Bao_DpmzEM`C5ykL z7~N!?+LpikZIS-Ddfzt>tCW!C$@oGJSH|u_wR*D3zUiQ;}R|mDp>rQ z@R~SBhM6>M&l6tXn|!FhJbZ~+H!4l3`6n8FweeptI6o!3_Ov>Vp1jaQFCKCBE=?M1 z;7ClxNRzv36cr`Z8%KP_!nkPkpISoWbN*rbg0n9Yu{>yja^WzZ>m8V-fF{=M+JvYc zj9^bH4e_ECT9l!*O4l~W`I9_`-VWFhj3keXP3GoLM946a1|BSSjM@-b0F;HFDJ@G6 zD5|1PQ&<*NllBHrZak#7LDv;-7@m_lh&v?cH-&{2k)3_FY^_Ql#t>Ke$XS>(8MT{T z-~p*dzP#nzfJsJ%FE7RrH(i_fT*yH{WHk*=iHh#sr6f^H`#5B%B6%Tk316%7k}Kyh zn#Nb>9>*657Y4^er%CPMUkW+a*bqL_<=x$Nc6x4q(W5g36ltkl+*QIuV-v0s5T9SW z=A76hA`Z^vkUNOHao8X~>PHcU)tE~``sZF18-gdony)g0KQ6PZY7*@kUn-@-WNm_Z z>P+TNFx{=LHoA!z@Zv%aQi0PC98Ii*GWBWg!AkrMHCl76eVgYR0iIWnhd>l z&DgfcMWJF2&()z5G(NvObl@PT{wW^Z!tNU@*b-$g@qj8^bbNeE%=+Kg|6S& zLiow+5fk6y_m%IXQ9Ko;T@RM#)%~V+cdf>f6TIKTxb3Pm#VU?E<0GPlv zqt=ARBS)Ea_t#E5r@;E5VrmXRT3+nbH}ReP3fcvBzgToK7i<&${+@|^)??_S;c~^E zhh7@r^F&Ngwj9ni`T=VZTAN@h1EA4)>o~M|mOq=7SpY%}Y~Sld6^w3;O=(mhBLi+V z#Ef5xZqQ{lw{sI)^VHIuNzC-=t10iM2^7qlEtO2+1@0>4yvPxR=el{KW2cc$dl}*;WfGlf-z1F(13Xm8&@|iUA!uhEX_;kwix1x6T3& zn}o8!N5wYB%dL1!fbn6t{&)^yhwOo1Mr4>hPkWV-VbLPR4=(DxIXJ(FJ_GcqcJF+4 zeHy$d1g%z`@<6b|(Snae&CI%@G2X3}6bZ0LA{r?VoAp#z*22x4;_U{q3lIXp&L4># zc>bXHn!oLa8&)_Z>M2_}a*~ukD+hvZbc{jtjd23aav^V66hcCk+}+?;RLlBOHiW_9 zNV(}_2%#8=Imq;xDm826*SL0DXtKs-KCYU?W^vb6fuHNl$_tx3o(cVwlM|G!^?i(l z(>?AdGP`3Hl^|f&jwhfC+W#}q$!Bs=Md^QMObjdh@4)}A0iW2ljiUgokJW_>fL-vu zb2R&cMA?#a9DiAik>s-q-e)z3!L=VgrFJ=Y(DFUyBVme)-t*_9(6=3&V_kb^wJunV z=w|(V6zKH9CIp8Eobm9`erH(TmXPWSar4(=$@))L$4sHKU82@^xmy_Ck0ZZW+5E63eD!1U z3i%^|2rJj-6=cz9?mw=>WipVfA0ZQkU;WWBy1~LD;rE*LQhxW#KZ)%n$`LZIN8Gq5 zCGS)O1kWM86q?B3J*y9E7R#}dBs_;geV1_opOd5~F!JKp-n!*nN1hQ^k!D@WFM%*$ z$OYFYXXV&IANQ{P4NinU;*L0tFPlO{yus@rfNsGj$csbgn8@G_D+fnA6;xDFmw=$! zOt*9B5xv)#~>6k#hLAz?t4bN_)$<6K$?(PaDEaaR$Pj=9>=M`MwB__5+q z0s_~JX-+kxAo^cjM(8^qeWP-&5?-&^dQew^3fdxtQOxwb8_1902Y^?rpV1?=N}k6* zI;wqERQ{A0X}kjA3dlO6i%vmwLA#1C_-wzuD1H~!1bqYXlPcqH3;X4tC@=XGm91!E1;+N~fVxCE zstxYG)mClkfsP_DB7F-k53=}kF7%Ngx4;{$=9)bXpK$Q=_m$$d!v(>N_L~25j-@P! zW_5|!$~tgOOoniZ8v)>qICHAuevL-=#!xa?Xqx;7<^K`)m|m0&F*Wfs9B~C0BMgOg z+yK`q#1-JUZ?@Kiie+UI773B{ZZgG8S1^X1+dokcFdt2E&L4B&>^ORZ^06Kyc%TJ= zb?$ZxEKdDwaq>8d8jsIW$Wzyci1a*?>iDunJ$>7%_2PJerXWN7r~{S=aU&n6m_uZU z=iMlQ1PuUxtU_MAGy#t;fmNi?dds;JOL>0|HyqPE7h4`pIU9OH8HLQbBJIzr8rc8q zDv-4uTEM`V90tz-1#R-45}YDV;qNdLj5Pl5swcphO(n%aRY#9P1r1>%Y&rKYap)i{ z&uhlYH13nxpArHHZU?GjUK4Wle{ir&`x^&o@(R4R8Vw5Q{nAoaD3|OLMeJ3Lri#cf zA3Z`_-r<<`1-HQ7vham0zCNb2t31XwFWn4H++?zYW>Hhhsm@xZEyL2n*koS}vE4r% zn;rE0;lboF7AKuQcu3uZS$e58tY=rTVUSai13A^+)FqI4ee$D(Q@ylmJY}^Nc>?8` z(af}d}0!;lBQtUe&ObY5U$%*!tGlPrTB~EV>SLTy4IN)j|gciGo zFIEVP@%3VHH*DTCtv0(j`-S0+#A;D`CB~XNo%tUNzqy~Y_8iwNIdJz|+t2U5%p(&l zMY)c5nrIYQ%~~eP3IYqiU3{#_I3n?te>0KSY1!P&I=*=4X7f8AIhadf<6L~>3<+gE zm1}3)cWic(X$n43#Po8|xMZf+md`ZNp7)i2)k*AIO(&czaV#$C z)CLEw(=j%3fbb#4xLtkgU2*uo=VyGPh`O0~?etA1t znuojSD%G`fMMVBev{x!|IrmxNbX@T(PA~wh?xDgc>lb{9OH%9#&vQPu9A+rIx+qzc zyXX)%*ZaCmZ!K3^+4_<;%qq$!Ya*>Oey-OjuJ2O+;#@D8{&yt@~M}JLk_~!g;{c_Ly^mo{=<@f*Iofh;M!UB87 z(^TAk%wA3S_RnPf`)@g)!i&GXUy?id5&qBzuR-&#ukR12)S8_2*|sT{D-aI%wQjb5X{|TtRdApI5LFiLlH`dk=w8Y!D7~s}7-3=vI^`+v zjKE9{WWN>&MJbsM*aui266dwnDfYhJndK9(-r@)2?$sV=w(NT|k$2*w9ox|HO>P>U zXK!sCn~19%A8}PyUfkBc`I$pHi)Oqz-zV?1&MUqF>&<`dsCuQ!)00ig-y5nlsM&d$ zWJ!0^PvK!$iC1ji2OE_thMV1P6G=>fie*P5miM7ZrAiVFZBu(y1iObCZsv2owKZMo z+DO~cazKF4KJn5vVinsj#m-k&&8&COT0Cd$$zGz7g|z#U!Zz+PM3bDh-}$#Vw{A7# zKaq}M$Iw_&{Owf76J*v+cB~x~!86q#^frE}=YJFSia(5IuVGLY7UmvFHs0BobXs=s zio}7wZ*6BU`UQBmUN!?rS=si8w$nZFQ{c6pIwfxWa&=(9dL7vTXQTvUOZj$13$4y{ z68qXU6P=RT7Ja+MwjHcu_@Ps>HUw~sH@fY_HT!6r%@w0VF5E~>ZvpFbw>4%X)f2dF zN=i*vTU)I|_@7(zMc`U^J|pcpiUy|604V_)i)2gU!2%uw0=T;wJC^1#zit;GjYMasQh+{Bd>+f8ACE- z5mh3d*>3_!qCy^!D8|tP`_vz}dY5-$u=KsP<$_a=7Dxp>1~S!-gSP&104rTTtEUNI zSxv#x*^V_-lVSv6!oY>m4~?T(I=DTD5G^t(4Hc zTMuL_dHKC%|J{O~BIZ2Pg^ka(t=>pxcT4VzJX~@-o`v-8;o3Tfx2IWxWvpget~;1{ z@@v<%fE``xIrq=B_rA!P>-)N5d9+@GH~j0?Q?qs2yE4DlS;!8b=sB)u-=)c!eE0)) zUw2<*dCKO7vKtQZEGBU|>b9}A-Pt_#JyNoj@76sjwz#x>!Jj-O6#iiMbk(US^-|u$ zB{F4^jy_%%LPs8_T31C%FwNJOtuHr}THM`4l93l;ch%Y~>=Vh7v(-!qZxt4Xtl*byJD!NxDR6WSX+s~XgzZeG%p4fKh;Hf=RRF$=mk2O|QHP}VpJTf(5u|7fQ%$DT$9Xwd*%8J;*QI z@H)dPIGk zj%2!5>mofPl((fEOLDxt-3F`;EjjJ1MU^k?w;4-cPPcD6t452w&5a*R3 z^{Ce2k(OkSrI|0kL@R>Sd-!HiyH(C{-`gZYMx)$Q;Jj!#Q%zj^=Jj);_V0t;3EutI=_`hTrwjyE&H0tEZ*+ib}A5 z*14wM_0P?r)>?*=FU()opLu;>SEYt<@%SoR#vT}RBlp#dD3#A1OnJRmgg?2^`iu)i zknab%3$+GqURlxdph*+`UGB$|XEow41sgAGbWH2XDjYHTgcZK)r+m6f?pD52o#dWJ z?Zz*EY-7n4p4mC($msrK=dml6O6@Op==Mi(hY84u;6d6uXzuymQ%dV<_8yLTw#$!Y z+W%t)pK}?lzPIQ2g^&YspouQwD($|Ay?tx9E0w!HRwHnO-=eeUc^*ueoiZX5{yn~` zh7nU)*V%8XU;NL|O^0}+v%@Ywc3h${#s!vccZ$58YOQcY+E#Y?RLS|1(e8777l|E; zN8HBi?v7r+6Q^1S4rThO@Y-xNU%D{+e%;O4$bD>afk}d#4Vmr{d5nVFtlh)mP~8AWja1`#zj0Q ziBT|dt;RjkKB^}3PE=`$;Op{Jh1TP2P}>=;KF)g+LVmyLo%X*6VjMxM^y_zB>caPl z$it9$v%CLSys-67b0it#tH*@yzgD^>5+2~bt89cMV)I;VD5#NNc6 z(QO-c?Gi`Qfa^W3bC$M2R=wD?Syi_abQx>>G9XHiPB1a{<9zydeJkvTsMG8Z@ z<@y!E7QJK13oyu>Tkr^1{mu8C5&}S@<_oplAOUsreFXCR0F^fw#sJ>w=*rP zYYT{ql$`3oEdu*}aHZZU9M6cOt}y`CMNdYJFRvmT{yJkI$!Dw%Y2p7*JbhVq4QYIz zHRHGjs21`YCTVmay2z;Gre!b#gXrXIG3@Wh`8Rft-cqtHE-oFEAGkw99uZ9R``8K^ zO%H3meXILSm6nmpt)$mVTAEq9WkI^jC%{}$?4N|#5ApNTx<|6{0BkL%8f@SL#fA^0M_xv9dl%ZhA zf=vsA--MKr43^w92C>(U8ha^6f%FFkw_>-{k8mk*ySO-R?=IVps^n)lV6=9_39%n{ z?X?lQ8D=@#h-?YI`EaONHTs%nd--QLSRJzY2KIc8-!r-Gx;)lE$ z+p(T^CDTivR9ag^o}kpC@La2I!)iPThwo31=Ke}9eSI_j1?YQ+aS!~5sxTwA5Zd_UOytu{>1LcZiFVGohr9V#d+s%*Y18=heQpVf96I`#CM$8 zd6FzUE=-cLC~V9-@mjZv>j~HH_M}-h@)pm@yc4&!8fx2uVn7%!cbgJD+3QEx?uSAe zzm3G)@bkh9%e~0by!gCZd05BIc*7@!mQV#ZeOWCSvi+L@r?y>{Gxjs$J+?IYUS&(> zuN|UZNv1ypvPk7S%Knv#6bTplvYD4*CDbEB(7u?wtvtyw{b2c8LBi6^V0qfY6kE7Z z1$|>R4JGVt(PGzNdtYzHZaZvE)PKp~a-#YIHO;%}NBiP`E_Sdg5|8)Zw^& z)OuW^2I8Wmx2@B~XIl)VrsB|~54tMwhwGGnD@#xIa(GR3dR|9BRL!MWy*^a2OP&la z(u9cES@|X?Bhk_DQwE>Z9?Op@)BZ@-;;^1obVH!x%N#R01Ze)3H;vEtH&((qqjGZE^moT1xDYD?g?$+wDgx z(}aSAPE|Mac)^cVUi%M*ZxrFw=JsuEZJ!-#%`Wa(lPT0-d{X+um={WOuEU0W|9-GoKcUncu@?^oATD@53VhIa z1w_4|6AT%;r%?8?cxxMS1?o_By<-UgD@6_FQ8lbi#XWkmxm!G&in}4r+WN!Vsz;{x zyrrP8Ka=dtV4km@?B5N2tg0^j`v)_bnpO98cSfK5xUoFFdhhCITJwt!f*A!vu5G#+ zaptiCLmrKG0`LeT8(npm32-23tYb7j8z z*Bjl_eu7`W24#;Nc^9$e26oFDwmqFi+1Az_8U-7n)*$T`><;wP7sxi0k_G;OP}Z}h za7@w_?_Fi~WXSJ{$Ans66re6}j(2e;bEx|wXeZ`ll*d21x|ibu`o1vV1YwuYU%=z* zpRDCCsS4#aB{Zf$LKo^>ZwG}d)Cm@}6K@1ypq>*3Fc?8q*;!VwuwK@C5O8sap_;v4 zM%0$W@c+bcejnAWGe?zyP=fsKvLwetoQ&}j=TYySwQ;o{e zFzg!{?j+%SMZXy3`6DI5dE0Xk8_4f-m#IA7KLOp?PKM)v(HV8 zqzRWEz~OAq7fK(yWgYs=+D&+J`SI)RebqlN_@(Tf#*Eg99TlAPoO+$n@a58Dn#E*K z0z>Rw=oL{;)0uuG`RswNWn4+@_Z%r9m{v9T(fVVdBuW<2?LuZ+b;eh(#mDR`aBUBg zFXOn<__n_6Mr-zvu)WF=tDCmnfkVQsHdiao`|L_cQ%M~bJ8wSp|1kFEaXDsh{CJ@Z zk!6M!QYZ$al1VdTsVpfCkrtwaY^B0zQR=oEQ?yu`u@x#Rm8FHA7TFRXqbRhaD6OJJ zDt+JAx$oyG^ZUMD-`{__-Ostta-C~=U)On`lgiID@4bpOefQ#e(TZa3ZDoMF>6_&% zdsP%@c$uthQNJJu-{+9sM@_u@m&P+q=jGHvM2KOh=Q0UMbC8~xJw)NJ_f?Kx8mpc* zlD?V(lcu`L;o%Fof{05!mMI*yBTpno1D-T(b=R9ej_uTX0K0e1W(<3$y>U3+;aG@! z?0X7vg>hXd84}Z&e296p#j6jSYCTp^;x%UFJfndwG_nbfg%K7@p_uAkM$9?-R^Dml z%jyCRMU$0blNw4OqWau`*V_)dO(9jd!TJRgR==7K<`BrihrZFVoc1h?1$St}*5lXP zv~z6gtiINafUF0HY7Lr`Sax{XDS4Ws4pe9P--9FOyOZtF0jqbNn$c7~8U1Wt z!&xsH9n2#ByVvO*ia&K%t6RWUxKj7wC$Qd=-_Y}KIT7>ZjH9j1zLQYr>T?jn~wvk#VZ13@B5AW5~XB*4CDb>G?I)x`{9_;*c*9KN}a} z{S&tO`!(BP*W<|XF7f@Py?H(G&e>@Pg?7a5)c%r>9xyl82Kzgtxb5c-yC4o|9#x;U z0v5WOJT(Lu@DLu60UeHw`gVRP$CPdruM@;w7Xl|Z@oZb>Ts{KD0YlpP{NAUuX7REv z9T=uDBPFl@Vg%a?1MVu>ez9Hn9_Y-~1a(D3p2@U;0T;-sHdfu1cMzWV+1kdClL@)S ze!IsBb1v=Br*5c!c)EC&Q>>hB8(%8LF7>0(=Ov(ojertVPX6@%vG@slV~&358o1%` z@cLdOiwp0j=l|QioSb2RNOQlv`cZNh$k-mA9;mSLt}#^A?+durWzf;UX=R_EOWNFi6uoj8@DJXEqi}^o8(X z`-=X)vHJ|O+@pqt&6+9W{qPI0wjobV>xt+5Vf)I_ZhoGC8amKd-OX+)pcJ`LVM$%3qGctOO5mN z^Gyw?U!h-GlQZ+yxU`Cx($0s6F8avrki6xrc5br&Qkt-_XTxB@SIf0agja-_{syV=d>nGmHpjP}Z|X}R2~T(W+W6xsEu z?=|FdP3C6#J}c- zQMRd5mFvPaNnKw*w{jhwWnCV{yIa3J$yNMxv$eh~5;5e%9Rr`{Rt0PRc0W2Q2|Eu+ zq=_!9P-4JQaZN>^;Xfksq+0ubL{)eApm&Air|H#!q4Fu z8KR+L|Fw{&chnhR{T#y)L10x1S>90m?HB4=67O$_-!AOoKPI}Z(Nvv?zu~g{+J_Y zl0-@Tis*q&ss?Xk?zC#=0r#M|=(xSQ7J~rHqw|?UU%)GL0SkIZF$i9`3`LY+6=UWH zZ$S8oJV8$3dhtx-bEgcM?aE8C4IQquTD`wN3Jr6W>}TRYHMrLFc@-}Nn{(+9AqY%z=?6{*=<*#U|dYShe`l% zL_{ImWhQ2`u9N?fb_avA3JU=kqRS#OXyt|6&j3Ws%#G^wcN8TnqG1h8}QXQl=wh_KAhvlABb@mGZ!~FxPX(m2AO0itphzaJw zCz@5{Mv^$cE#Orm)E4tl`hN&)jbh3IiR**d1JE8LZN=aa6CRld#{O}UHsp-HS&#q| zq<>f1K^-|Ps4{N3A-0ns-M59edVWjn27aSHmg)nxrfoB5FM?AR!1CXg8cVXw8$Vv) z{naJ$s?eDS?G}QER}!#+yKQW>D+o&(!^gD$K;7N_W&d~Lskj{GHz}7nI@oDBOeZ8Kcj8!13SHs=5#;f z+&A^Tma6KC?fs3B>wbg4p!UXTuwY+u9-ywL`GTK>TWq4QVLKs(zu?&}= zm`}gyeg(X=(Cr9t7DU6;inS#N$fLcO*L%tNt>wZ;&u7L`avP1 zSOfD-cE?OK4nB(cyk2T!HuU@{!G9N3`@Uef0=agZrIdDrQi7Q)@PaEKpiFowRz-e- zc*%+v0#@2Lm3{5301oaisrE?xzkOd4v;9B1e`SU5ZtmyR>LUz{N-tt&4>s5WxvGh3 zd15hTxPDJjBJ)-th0VawOUyS@fdkdXt_G$`QAh3+EB+lF+AuvV*tBjib7m7iyXAhh zMx7mBjMx-%;!*X8J9%07|11Hl$cK3c7(CfM%bP=-4o;!y9zt#=Ao6x!R zH&Uqo^eO!_F{4zJa{a**rsN=bJvx1_>clEFfQxJ$oCMImARw7CUyrU!w1w~PkxX|F z{Bg{b|IJD5oZ|DozSHyEvz5EOK3{=PZQFveLv@#j&S_JI6V^0mm4;nttE@%v6}g*F z{S7ZETv!pAWTI8DYXR1RH4P1u2S<3sVw2l(?-r1kecR=qLMY|l6FF$*d~_`4>9}K7D;k`p5C`x=xvBv1pVOx!udyizjcc>z5GJ8nyHAKqO!& zy$EwtunXo!4E_=NeoZ>9ry5dNclW#1VZnrQbJPn0qgcbg>mq3%{HjV~Tk4)t9v|AD zd0qErKWv}UI}DlOjRe8H5z>iQ`v-7m#TpjFSflrBq^<3Wv_TQx4kh<_oV9Vy_|k-! z75)%d@+ie3{Fz&5rg~rwOmI2Uzp7o$#-qKIVGv^QT#Z+UH8YLnSr@+$q(Yx zM^w?ulX`t!({>J)>~&SIgo-HDC(u%Oix2*t5&>2)T_YKzpes?0z>it@`vS9lsDJ<8X@(GA+I-)~dDqA5J@1@`U2>M8x>}wAsXMX1LF53#M4UGuoE=U&V5_p^b-0 z0CG@byg&-tN0xEoNFJtvD8?`}9>R8vqbkZEQnt0&%ltQy>B* zWPr|6JctO9Di-v(Zo9XAk^z!|$Q@$CU$cS{+h3O75?q=}`3OJT=MVp4Z54Av4JNQ9dINq59T-H-$cP+xpc`P3D(J^MM62l%f<>8Rweyo6aNo26 zcR~EOl+Eo6etLXH%w4=1B4nlV7^!!uxVI&4~2w8TuaiI<3Or>A5j z@PC*eJ?pk{N~dQVH`0evu8~?L$-b#j)fR(RX&C%^Xsy)Sn7iR2wR5$8Jr+-e4Ct6s zuAk1+uBeUUy|T|iL6Q-VS*1~GtCy?LzfzaIW}0RCP~~|El&Ia=t&fir9)oF__blG+ z0}|c}+ag}P;*1EOETX*aJwZ2PJD%@dJi<0CI5l9!h_;JHJ*#Z;B1PWSR%NmBr3SkRPPxsKP78V;S%dd5d6AGV7FIz3BQV@sf$w zp%rDXr|%_5sezPCM=t~$v?GnS>xreA=-zm>0m-(ly# zzJHa<1UQr-GVt+x((QdIW=phzf5DQFV*g@e=0t|0j#tdyDw3^cX#xgp7tt;k1KX`R z0SbfvXn1U(9n5!Y{Vqa-nW#&wV||v~`LthCuJmrRV)+726Z(Ti3cY8j=lH@#+)+@v zZ48f_X7|hM)qi?hAP>%=RC!g`*LK%ct_P@aVP3mEQ+eYRO^WA5xi`1!NK&P>NR_S- z<+;Q=pQ?uU(MOm08;?DaO7a47du#45^!3S4^!q~ zo4)_Y!<(g-y1WddCPgI_rNcu&S!^@Rx}yV7VmY( z^?P)@ujhm5zF&q2Ib5V-Sz83DK$8)~j4g88*d3_%H)6(-%rKKVpB1OU`)on@D)zI5 z{HAM!cP$^(F_?Ujc5pJYp=kE3w4O`ZU!BfM8$s*HxZS|MiGUZtMduu6O_RJ>kn^G9IoUeqO_W^Yi$k zxeoH*`<|BRYMt$QUg|gLH=};`akXZaKf&sHYkA#h|M2(s;x1D_J0ZVzQ_z=v&41J$ zd0w8#{g^Hqv^fLDBfu-w=jcoW$AGR`KW+I#>w&ki)+VpE>y$5bzk2I&M9ZkBrYF(S zQED8(>)|(UCRRzF;6dY2=b5GagV}NZ_tX+w7Y8ICYzmH~NMLW%P{)RIqg)5Q*H}og zgY0{aywW-R`{~KdSAQww z7wJ+j>RP$4ZG)OUz0I`R7S6PLX4=4Nw7l_|4vR;#?&in-s?Aq+nL436DF?NKBST6B zh-O4_txeq?KY!QgI^d@YERe8?DNuPnb6?QUX-#pFg=(DtzC!OySw(XcO`cI|&bCfI zT)Apgbz{q5qo+VpmpTtNnq7yokYs9^B5Nt7%&UIdL%sD&N8L6)i5X|$PfAE$!xaRl zo#KFHqRfZsmmw-=mk<74$Oe6)2M!rcPemzKy@65m(rfRHRl9FfNAWm|1 zs_z5iW?CZ}2hz`jR;w@6BANPb?70^43Z;?ml<(UcwKVlvldP5v2iP6ekpHn*hT-tZ z+wRt952h(Tn0LscWcNq_=iZjjDlXdG=)EJ;)Ipo0NRp(f)@CwNbH5Jvytjm*W2LXw zd#FJweBP?@h}!mzPvIyq`N|BFbfW(RrCCZFV_TkDj6iy>tf5qCr!X4vL|FDa!A1ki zrjmE8QnP9cO2h8H;Pr@zEA`>4XXO``x&+m&8G}v~*!k$>t#+uh%}4EmuD8D3nSK8< z{jE2Ei{00EwR&A^d(=BKzkS-lDr#fBRl;AC<|n)t*D+taZLrcsgG1D@BLjVMMYHEC3QGz9m9ZJqBwt(-?gGy;;{r$QZH z6J&1Lba|}@c~5WH_@Z+TjK5P?-`G&9^1JRvav7sH4C>oEqVOE8z^05cGhNO`eP7TI zsk_DVjlF8Eo^l2C`^V~Y3srXLRx;)Q~hjjq(z7I9zQ}9lD^8Oo^9F)i%%El%~mwAEt#JdGd*yxHk2`X)w$9p2Z)=?TITG^OD>cyW8q&90f^?`F?vR~%P{Xuw zv%O3VHCAi?h{DXx3e~9%r^D+t#=`&p;o4Ey2zU;t04iCOh@bX$4tGEKvo!#81Qunh z2fo+Xe=4FBHKlAz`5x2_5BcGLA+^;z1~Opgy~naSUMA;)g*vF?y^3Y6_499AjP)|v zo!)F1$?Ew!B9ap)Qn`O;X7vc7@iFCEAM1$G^7PZLZx2ipNyUtcD8MxO(VMFwGZ|( zq?Dn-tZ}!X1ur3e$z7=prIt+lw)R^7g3H?nD?ZI6@p=6N`&+&AlI#A!u80iDR6`%? zZOM8E&WEH4II?NfdXHr_y<)a#FODvWyx;m#WkpP48D_Vm)04gS9&pvJAo~WKM?hDh zvC4}0Ol`!;lGQUIIIuE!!~Y7JzP@xa@=tm5_I@yOZ%_E7>yBE438cb@{Ko*aH&#D= zRGTdo81!527$+Tp8QpfrPaCqPOC~M|r)P9m1bEOQ z@z$6Q&$RFzW%*adeuXl&$L$Lg9t<|xCN(4c-`uW?ZSi_KkkvQi%j*BCJv(5uf5nX^ zpN4<2qdAD4`L3e3erY9J`UW!xb|gIQ?Wq+BT7h^^O)=a1xdp5>>byw!$Oi2-TsqJm zr;o@5k)!g_hUHY)NJd27;k&WFN{uo%lV#3^abn7W2O|gn!Y1E7hiZ86Ie1=@{&Uu% z-t7az;DYoRBZ-fA?p<3CtZ!QYnYw~F`|+Yg8k9r0Balg|t-QrQLFGy;b3+8NIAY2= zNhNHL&kp}pGJCw(34)VH(m><4xPEco5ps8)l6y0jO=!Y{t(gXU_5)}sB~O5MY+KZD zUu#(If&AFu;E*QFHq;Jo4Tk|qV4ez-7k$Aa6O2^vSEDUo#<858@MNzLDb%gucw0~N z+#Vr$1y<;lAquV#<;Y{*a3WCeoy%(|aCzjdSFr>auM227Xs&5`@RoH>y2sSJ&!q!{ zymS~uY#!bAYz&rB>VYxk?bu*j%T>sQUk4Cb+MnxFw&?qAvn*fiMU5it=n|{fwo`uxUpII8Yb07kS=~r$&)?aX2QQa%sy=YWdVFaBr z>7^&C`~In^eAwY1tmU??`;eoaYZ|@lh4Xg^3ieiM6djIh%}3-}Dq}lr!`I5mVcz5W zzt@0QK8>%r-+gLfU7+1IspH{)Z#g*$;=SzE`inNkTEA-ga9w?tu-qv$a@6prrjQ)O z6ufAeC9)5p5q?YDg@?<3uP*abr-S08qR5u&1wTXA&pB$K5fv4Qdj72q%$Bc?#^D6f z%<&oC*3bSD%=?MA^QH$eUn9v+#>G8)KefeaoC1h+(EVJRvS?cVY_Dv?rr-sS(|}`Q- zINi%D+civMVVV8|3Oz})e_A^EcU^9m{|`%-lgqkoSKQa@!iIKBS=slFeYBzXx))}N z+WDHEhX#<)la^&pJjB)H%(i2tD&$VWNniriUh3l%EuGNETVcCdvnSIXCTEgzC7ugy z4L<0ALpw=?3D6GS%h{_p=UaQj<^+QfG!kBfa#$hrccMmVu?JD{gB(4!#LCuL zR=>0my&97#KPl7ruS=2cedUUK{I0;owQH4=B#vO>dKS2-*h`s8%ACcr7yeeWEpT&6 zoQnD%iV0cHw3nV<{=aR=6OFgAxB%T(7{yTTWRg{r&c#{thDN zExztsdBlKR)!^^d#=8A+nGc9!t~w>p)7)tMR3vqz*roj{oc*NUJ9;IAyKK463|F7- z;AxV`H+nxAS-1)ij_iKqS+PNXbl`F*a9IpNXQrjsjPQEj=MeyKImwU*JGXrSP-5XCMxoEltV#^*bCUY>rzGsAzC zgrT$Rj@#nLV(CfdPBR)v>eg-(D1P|U^y=jVK$OmU;^VfzVHDWQrzj) zKWCVKBRwHV_p_MuVfV@BFp*}7n)yaGjf>6)Z=U(C{6$kl`|^N` zq}waU!H8yPbqt>06uhuaxl%1{-*(QerDWCu=sgqmEc{NXhS#C^tm*KmpSA9_Wp3~G zR9^EQtzycOnf*w2sP98|*H9ePttrR%(D;a_-W-8x7`V0lI54B&@3&j7U$ZK3j^sFRAyMEF7O>L&knvC zS)N7bLoQQwC+!Qk8gzy$+M_x3zFJyE9|#q?bwVT8)GEUJbQro$EzeA=&};S_Z%7Z3 zhJ(3%Q-Je9d*XZd8N2*A1%JORk*b@S$Lpl_N>)9R#@in4V90gM)0rG>&k&B@#yHixNg}45%<<&EdX{E6DpF&xZpCtZzi)I27pw;T*Z_R13 z^2q3l6Y`kDc5 z+KP*<-5*;_YAcJ<>G;WWN4~{F@6y(^_U|~}0*gxOCYH8iGdRM(Oiz{my z7mO+~{gP|i&=PfkIU7@##-8k)ZW&yP^(?J38|_=D@*aw4Di>w-*eI%n-Ym;soRwx8 z^=^@$#q}l8K22+qSH+wovA+3iO#bFRW813kxo}CNh}q+Dez~Raj+rh9SC+*fY;v4t z6XVmAhB{#IgP=CTJ$fAu(azHjwyYX;X%4`NtIeMIoBsxYSzvw6duO4FXP}`smp&@~ z60)oUkv?@z^LzciWUS?)gN zbIhR$Ytj^K`B@ojl5>`e&x%=phrIoXI}e+Q^t+N7IHFMDZ)ZMj<0EstM$sq?!1|`( zYv)$@w@=(T5GxMRQJorHu;o#3l}2-)dV>$>nrv^TIq$1MO}=(IW_wt#9v;rN=>wX| z)va|$2+y(bBzf?D{SD8DaF?&Y>tA)lBkG4+4Of6A*^ACpX~cZcjrMSx6pTYELo@E2 z%r$)|t8(&(bXm~M9Pf3*E4A%-uIa2Vvo7zC-%Tfvhpq^)#(cOVD?*$Id{m15bE6_o ze$Zv)I4ft`>5kB>|I_Z;qLjYhv3y^F#Upf`tIU0~hz$}k$z?k!(K$3jLDiLg1HORh{>5btL{h>9+j<53ma|t z-S@mu3Ha!AaydFceK2wRpgi&`Z*c96(FO4EeL@|XuxKlWrA50ZM4iYqekdDpGG`{g zC#%_8h!6Xhls~ICCN;M(ae$Hev>)^L)$bOE6YSU($*{`Gn9=^UW~f#(RDILq6+tY2 zq(}w(82lG@+JS20(DHXB7i#6>@_~Hf^u$KvH44ui{c>hLthbNe{cl--UIuzTzwF-K zG3fbgdjsUjpTrgo&$d@zH|K>_J3SQ~o4rBD1{x>M!=9&OD{~3uYZxn zBmAznx$_X5f2_XY0lyOkalQMU9e`cAuYQSpUrMnhAKu0MMzBlFZlw+vBW`?0zCia| z+jZUR#($xS2)l*WgvJm!dS=ULy5a2@*2*o zBLJ>U8wG^G3f)|yKVnGjGeBJnbgh|uA-C@{Bn3Nlh{&S<7Vpt@XGJ}CG>a{^&@ruu zu3)80j>5kTGNmf6FP{B6V_R0uo_zOHqo!IGi+i= z)oc!VnAEu`h^FXO!UM@VX$A6q=h!<4wKkJ}y(V3jf5KMW4wEpLRuUhw$ATA6VF+)J zLuviE5jztg=GIB|je0>*mHFlrn`ivnNK=m9AT54vTZwrADj{LMFr=VHwE05j3py}QjH zhYr6PHae5CwR|sBjC0!fJtlk+yN97NEIG7*(`9{az*)$~i}Q5ADiYS!aQ7X3g$o&>mTNqE3NSfKJVg3gGOGbiipXHn`l*?tBUwGQ|qqEu2y}p`37Ws?Py)qejZ`Kpsrcx38SAt+1QSd&9&0~ zIaQ6(X%1t&vhn|Xd=d~GXr}`Rg~w)8P9{vhyp(dtN&`+#GSFI08!^czGSH4vlz+%n zX;84f*%4^ap(+hOs>&fHj8J>4Ue8AEUZ;=x=qrk=lWOH_wl6Wd&%HR082;^};Vfon z-uSq%!?n~9r4JzEr!LaB2p{CX&fueepw9Vp0*UYb9v>%QzUBwYaU&6_ym%2WnS5UEN&ntUwQ}Dbtj!I&WIl3Qo18jxp^1!H=#sIH3{wgQc&t#~^pL~3T64y9~ zkYjoS-Y445duDnTGOHhu^b=oOzyKxf;6q@iBG*{r)6W%C;SgTv+MmFRwbrdt(o~ZH zt!MKc(dlqJpAP9`%Hax)2y@7`%8w;$mEoz!A-X2FRLr=;Vt9oIa>_$5lL{B!B6V#> z0@psC9gHNWjs+M!I>Q2t-x0Njm}G3`fVPhzd-0!-Q%Fu+E__Ck8gz@8Dvu1CA5p)Y^9b3%SGlnKAlC~4z3`T0 z!xxGZ8Iue9*>PLzb+cHfW$!TZAj;@4l&H^#Kp*0}$w5tSt#};pTycaKTZb#IB|N8_ zSBFOoh>MAuq3YxJEFB5SxXu^e(C%Uh1NEb+1PSIFL@s+4h{IiLf*C;0WUEocsMW*$0dn3~}K4J=v z$C9~6o`jcXvA8f|ALv2-$wS%HKbWcHW+2620s-F?cRG5_|7Z(v*aM6KsTgOKSbmcz zq(4|Y=3$&yjD!lM6RL!Qr@8iOB}qjp z&r^Il0=mAu_-tx~JYzv`g89Tc$uRaIIeQxXXV(EP^unhPfy;;(bT^AZXx$C zig)JM!s?kOrgTk6ko!HZEotGWnIK+-?xKw6ngIUy>_sn(bY=9gt1}bi!n2pRp~)e< zXL!PKo^qUiJg0Nne2Nh&3P`0VD*CN%s9v)<)b*5o*;-_%@ncl(7$22+dtS)S&f$*Y zy|9(b8vs9gS<^TA-Up6{^ z=918L>-;}aP8IApOp^~zw;b;q0qB|e{uHj-0>h?*XrwDecYfAM^(ADXe|6o~T zak&aaR{(>NJYp~j0ggHdPe6IZiGwCQ>FwYU%1jz2zNYb=oaWHlsc?r;t?A_P%21X{ zk@VNl>kt(+Sf?=^L;>=!^_HD7YvIPBqUcw$ z8f3Phk-VG>Y85D(?Ly7YH+61Z#Z&JVcnCk98?vpr`N<8>mZ9Ux8BTWunkKi zVaxV2GS9xe*O1Tj2;&MbU7A<_N?tv|`bFE#G3VM)AVER2SB!-yMYgR}wK!T}dc-KQuJ%?ddvMsUL=`bAUBQy5d4NW$eN23micR;GGqWD7!4L&|#PFMs~QP&Ufy;;Q_(YEM)|uv}~SqT$c%a}a#wU<)JH zi9+bgB-DnmoI=b;LsI)DXZ}Ln2a4djlOWOWcJbxj&_cE`7)x}OPg!>yioT# z@oLccJ1DT}zpCO%{Lr5W#|*FD9p*t>Mo8+B8x#KUPJ%~Y54CfA&q)%7Ron@te@Hx{{ifX`H^@ z@r@hy0#>oqiFem6Wlj+pj;K95lxMPZEJtB!`+5I9Q;eH}Z~wBf!7-Kj9IUV=a}-9$ z4jo{pCsL)&&ky2&*|2u<(tjMAZNJNWSFg+}`^BtE;e@BvvXBqi27c37N#-m?FfS8k zBJ()Ac4%6-n$c4cc*?+ma48EY{(kNAS7SINZUyuJr9EnYNfrWICN2EK3ZA%$LJacq z|EbcD33zsuc)A#HFi)x9D2KUP6DrQKq-DILNuAs_6#Hna4v?j!0$-~sr{IBiR))6- zSzE}{J(XP3{`aHY`*O7P53_O*?kOa>^zgA%Bu?KSgHP}s=|AAxbphsS2EAot$Sw(Z(H z)(+l4sm)nONnVypXks3{xE*CQJuoKR#>vAWI+uPI6H_-EaTiEnHd0L~Sv&SIRvO{Z zr*Ch{rPZ(HMiv5u zk5E4bowfteNf@fnS-3c6$V2Uyr$r7Wm#9t^Zfo~5G1fdwKG%1;N$YTl; z{=Q&xyetAk>w#sQm4dy zKt`ztt4c%A^hjo)N$pel3KaWbmf)V4`Tazq$rsX4uX^@edngKmCaNZseKSia)xvnG z=aS$HmA4#%9mzC7#NGQs8GrMD@>j#5v5&Io3;x`uAPoYBgi0g)hUJbyUsP?|Ne45S{XVJ`fX|_#Cne)Uv z904})Y*?*jH(gCHy{;eo>E9g!KA+ypePiblRT0IVAm5oc{ry?B_@$s&kQDO}8BU5% zWqY+P(~}4oPY9R|LySNQ>o+nfmn`HMCY*@(wcNtr9QlFR= zq9RkWyjDNfN?5?8eZA;WcAp*2y2ZPiWUEte%u{Y{CaddPaY!pp2Xzz zo46K^Vp)2?Ggt{}QV>J9t;DI)ijn4a9GuWD>IVv_QXW9SUFa)|KBpBgvA z9YcI&K&F5J^@Pp56&Lpl6$B8`9VLt6cOEWbo;Cz`1!|G$X52<0_>33`sRA(PEM}53m1bkh>cvtcHI14#jIVs= z*{|f7J0RpkyMI(GS0SSS%w&PIo$EI~JoS-E-8L$$R!<+rAze&Q(s1O0YAS3iH<;bw zwOxEs+#_o$-@lZ0(JPgox@Mt3#5+0*>K%k&m|!(j!3ZT)jI-t{9Yu<66aR$g)uLkd zQri9LoKR)Yn+T3Il04@~8EW~MXD*&0g`AnxBjQ1GB4epEV4L0E?Rlc`Nuqk0ZAemx zZ5(z_nyM@RVE=O74!T6gl76}uCln*yj7q{HMm8{#Ihxaz!V6s7>EWYUsH~rVEwRum z)AX)Do;2qu^cAc-!Oe`RK`2*>rE;Z*6Xr6s7SP%B$=AATngr>%40LZ5%?zssdS1>t z!-`*ZsQ48s3^fL<8i=F1P_d!`kIV~Z*+>zRQ!inf!G;NSEU`6@#e&&hZ`_Oe0gl-dbc~?8D z#suG44OQ&8oeAZR?OSm|p)Oo?=EE1u4EY$Gl=*_D;1>hcI;h?THBVkIe9o_;Iv$)^ z;?H0?XQ-%s-Lc0V74?wY(bhkgdTQH43v#3eWeSaF8ve|VbJ;ahu$txoZHTX;CTM>P z3tt(FPIKJ5hv)}iLD&?0yh?+qVRnXv{O;x8&g`MNBb6Cz8oJ3F59B%vO}f;Urr+<+ ztdMW?x(==at;C1;7AS)ZnQTHV+lmjVhPEr6z9r&-n!!*W% z7VR`rR99(gpi=lMKcT+K-$4e&%RHwJ=`%3UX6_w82|=n^yT)qPn1J(eiv;}X{uVd8 z4plPF2$k6c;J6*>+vrW#2#l~2*X?0CsqzXVx;5t^xwKnq0m0);5|eoJgQ=&KIc=+yyl~6`ObB#!yA-3Oqo<&H*kUJ(O z-x-P45L}W-bh@6-Z?L-Y!1rHJTcuA;Y`erux#V|0czF*oEp7TQQ zHHmFZLtHBy;>f=H z-j+2A({AH{%H(pVL~(gAY!R36z&&%`P?6Wr4B5R1JX>2wM24d%u86wBALT^3^lEk3 z8vb*F=mR%{HDb20=O6_MrZlr;NW5D^>8fPgEkQ*`U*o`)=w+?m{DnpOKX7HXshuY? zwzqnvp3mPDC-v6hY`bfDSBFc3@7uYkJIn)$4py9p-FV734}AW_nVKTt8{1?qLFWG; z?{|ST(vR*-jE0JS*eh4@7n69F7`P_w4Ap^mHilGbh)PzM%=R+jo;~`0E}x%8LEF;F z;USw1G~JB8ppB$@L~9$(Mi#Xi)u45wiT39 z-hrbM(rGvcfjUH2>JLr;1YoNW>|Tz1g0@d^v_O2QJHus2pOOh zZNGfI$se;7kezA5fgyJ93p!2WPOePg5CndFu9fKpzPgdQog`o4ieLuTiUmyYIZja_ z^Pl}tAf$0h_ksxnu@5+ z<`S$33~sFqB~E*s>|*ax=&LrCTyLbL`K>CM5T@d!{VRO<8(!d0(aDqoO`jJco;Ihu z8H)V@24MFt1Z&RF8A_lyKn9u}auJOdrBu2A*ezfW`51;@fcLh>iQtEbE!kbEiBq%H zjZ78j(3kec%eUWhT+S`SaHI9oOFR_7 z18!&_uVA(E0RFJ$oTDr!7!}>?8V*~+zeRh`%Pset{-XFJf4ozP9x?FTauQBtvV4p< zTYEB*6Da4+;dSKK%$=r)*(mlZU-~SsP(^V-pRtY2p8GBPft4wL@9%V`>!m0xW~(b3 z#nHa9;>0%(Vz0R8z*qR7tdu``j}*>Rc$7HXn`#$GKOa2zV?1&L+}OVntR2+&y>J`{sTFNp%k zQ;?7ri9-o@?tOb=;R;E+_)s@#5fd9_CN>|tj-6R?t^AkZxve@QHa3o)^*_hzn9F)P zrhi|x>zb<*{q(9E9 zHe6`W4ep)%^hHJ^Q;-A28AlnVU~gs z$Ys^W40xkdrWszmy5x6I`Mk9p1LFN_rd&!U&urHDj92j>?C{ECG;0DkJxGJn)m(`h zZjE(|6zYh2zQIU=!2<^pV4er=T3=&0?Vvk!bX7PUuKGPOMG23ZFT9&vpXBF0#(mwO zK$4?a^|Q`kSEGj6X&zdNI_v0Pj_ywS$<-;#42+4x-af%6T;L3YiOyULT&l7bLq`(G z{#L$*9(6J9H^xt>%4pnAdt$lsg}l z7aL?9-Hn@c(7_(;Q+fbUh!l`xyvSR&OWWuW`60)XH?mR`Mh<%0I7xEYCNp+t9#}tN zC?J~@Oh?$GY+F+eZw^N3KRbhOKM>HdC3JvMMRy(p=HLhG|yvh+a)}J9Vp_t;%28A3gh?> z>!}E(X&fU@$G)f)6KU2P;C>hjSK>PC*=(6b=cP`YNlFd2AjlEVn837)Z-J`Tnh~LP zi$)w{nG~-(1v}OyM&Ipa!YmOCZfLal4en(L{43oM{XK0ScH1}T!;*wC(dYfdk>F?k)Ai$160zzVM7U>kLoqlgtQ zFeyjwZ%cAS<5s z8hauR`>3%vf`nGVtocc9T?<$KR{z-Y#y^v}ck%V}^-JS+4va=AkD$EY)F{t9CGe9C zHm|lmq_o#S<4{l@@um%xo734pIpps3m)(tYtm@texO?CU3@6zKCM!?ca6KdI_+^sp*hAa=X$g1yred>G*Y`TK0-3Jze$ zM2)63D=7kvJ$MV#)R!s$ti(#-A)3t>)+hBEOm7%U)Z8 z22-J4+3A~bihg`=fjs#Q_uF@WizwP4V7-&8335c^uS5=T-HEPQ?&&JlqZ^w7YpY?_ zm@9bE>Rh`CuESVNQfZ6G-Ahn}YS5%ZDU5Si@&wCJNn- zROZ0g-4>HUoZ2I*aDS7a=;H)Me~CyY?@Akb30hN6;PMKU+et9^JI(jET@vr4@U(&~ z%mme(S02yOC8qw(zmU}91qiIUGluxy`0Ief#|xYw5>Vv=7j;KIatq`^Qs+EzJ;C(ip)Sw*>x zUp%C3hT^s=qR#}M^oCzpE~Qb>Jq6MdK3}YjoZ{}*!~XW_BDy`Se0py&6*_po@W>c; z`ExdI$JrVDD~Mo;8w~9JbUhC4TkG0b7*WRa;33h4t0NW64sF7;f-Vp`FSN_E;W^#P zrc?KH(-5Leg>8+M0>_vA^S==|ttaE7uD{ACSwf>+GXq_>-Y5D^&@yWzmk@?7hBPzB6zOzDk#`YI~*%Lbqm zZ289R6)cV*qhe0z+b%Z?Tp7X8T?eXq@vO&12u<(UZ;UvB9958kubU_{d?#0CV|JLT zmhaY2rHDZerB!BpZ4S*q*gXZeVz={!07zCdAxxXU-trDAfjf*?VjgI06THN50l zzO!>GZXSvt4+W#mn2I}idEPoA0fwQ*H%QmSz?#7+z*-H>bJ_81fFMFyRi#18%KnBu zxm1b)E$a0AL*dov++LU9|Lx2}+=F{)@BK6Jnda%;{?9BwuE&cXKZOR6ejfk)chC`S zy}z(7n!gzly&090Ah$uSVZ`Z-$~fREvBdk$_Xhd_!6{LNv*5v9;v_5(sE($qfUn^-H<*l92U;R^Qvl@O0iJP*l6(pUzTPI3SG}(UJDemX@8f|R>3T`C<3JZHh+HRD&;Tpir zSGc79dE#g<-1MU`a4N3WGJNagP!f9KK1g#M7R-%cRi&0iY$mA zZqmgyj#j2~wGNFkP${ts^+@=bdFov0>a-un9D>LQZ_fKIs{=3IkK?h}pXdB<{y^V9{Ysq@Ik5eO zoyH|?OAtTgE|x!PNa=)D&0NzrbuH~rxREAc;%xjOkQn`uubX6GGDGghZapP9@u%9D zWyE^1`BrfeT3ZPY7W64 z-3;@~2n{VFU|}rIGXA%A=KYxOa;~j2-8VeGjf?Tr^vHq&(Y~{(0bMJ9tA4*rZ zAU}~Y@WZc=xu0_ywW&-)W$zN4znAvs=)PtZGcj{ zZAp3Txqv#FcC$AD3jg#2Lyyi-y#!vv!5*{5#O$wd=Tw^H-R@1udws|Gtgola64-2wC_mv23Jq*Ew4)1nz~F$&IBlC1Kq^r2BVZ z8!pZhzQjkB13{o7^aVem{Rn@A-uQBnr~B6J9uNZ(_s|`jXNTL0N5F4Av6%3JY*#$R z3Y-u^yX*}ZQ@R@rEI*scx1{)k-5^HvK+|}uM*){GaUo08dJX6PI|~rbv)aLQP2!!4 z4ddUHhqlGE7Z3qMbk>t`f~USs%2_?`<#RBa!7+vg_xPJ`Kk3@TljEN+y4o@2PI$=3 zxmpEuSZNfUqOEze%0j7#QZkXtUVl&AdpuSeMza)r7PtmbBK5Z*GuxA})UDzbx1W-*-3{yrNARcghV% zKYcKA0jFWN*3!tIa&)_|z|Bk-iLlm_T9Jl6BVspzd_P3jiI z3#aNaTelGb%DDcnO$NOgiSQ>IcgXhW7qhGM_mvg;j_(F-#T%rDz(tg^zvRo3PoKH$ zzJ{iydMBG2^yU!d@4zo0`r@zr17j?F!1)7#6H;^tVw)XhIX{)aDlo+eY;xVVryZ6|gH6$ZL+Z|Q2^ZG&;!Z{z!_7Ug1ch1fm}!9QVRTdNV1os)3JpvIyYtrooJEnr1&iAud$1#2{-EG_O57?n_XM1*CNcctD zL9DxrevP(uUir;9M{Zuq?o0*F!M48yia2tWK@q=dGVU7K$lvVDLEaDkB707KYafI0 zbLiSqW|-J2yNfbJzmW034XqRhf<n}XQu&pm>fk(n>vzl!d>_D=JDSvC)K{Ef_ zD8hY65ec-`M>@>3WjnY}$5+py%ekn1o-wmNB?{Ln;R1oZNJ|#I{@8Fz8d6i3R6~^h zq%l^o9E2zCG9t)|y``m_F+aI4oZ<^)ez9s5ozHt%Rn~dmWnX5pi+%VE`wGcs%(jh$o&xLkluP_7DdXeE3|LJXnjfv|l z>IqdFk;OUY2xUBc=BBC!QQ1mw{U1 zYQIHc!JA!Crzk&uI-zH0NFU>VA9kUNoG3p)=^}rl$x3NZ8WS}+yE72vHfwY?lIKrY zr3bqltIF}4zxC?~>Y2g8opZQ($BSOU)h)-zf#e@La1rtJUyX^0h;bP!Yew9grW7Ic)!vXEl1)`1&JN?RUz;?+G97D8zM4iKzizVZ&%FCv{ z_taTT_wWgW;_usnKHB-z^y`*Gp2BnnIZDJ-vXbqMyi9ic7Q9FjSK}VuM65l4E!ofL zqc4F>bpL0qSXwwiTxgj5qKSR&Z^UJFaxq;YI-Zfk1Rkm6h4Mv`PcH|D75t$m;bL@r z=342$-*f*e^Vd}{w*VAeV)AsYlb#RD2I5)`RC?gfE=~yjn8L=nRxb(G;z9dJ-_D_? zE}_MvUcjE&LouXHi}fF`N<4DrRbfn8ipCkLTFpGnlkPFZXj}Q7uQNJ*?6wTa(kyPYHBT^u!VV5&_L;dZ6F08FAl6i3#!Ewt%41ADvfSiGSL7e#3b{a)J(m!|R58N(Z zOPI{&7P&T$ShfVnV6d(IJFa%4djiCR1v3bpQay_6XV`t}r^S~$Am&82Z%3wqe=9s( za0cPV9&eaMH~mstg|3k$3zu?|J0JyV5-wCea+RStAPghgraL#`;n&IP?f9u!>&Bl` zQ0|WzFYf~-EucMk&y5}B5kG+JIHx7H`$)ijCI{jaj(8OmL_m?qpB6`oVg@1}cAe3K zHwrETOc~=BI$lo^rpMCEZ>1Vj^w|l_d3tVfxc2eyuYtzsa6;a+R zt7fiz-tro&T>*CE?)))mu-go!Dyv=9zNtU9PdacqSH|}vG3Nj=1m)2^o1Y)r_=y6( z{+jZLy-FUUzT@*ZnwxVPhrV_KF%npgqgAyY+B5|R*cmBoo2RgwIFl`=Uw-uHLdedh zHLW*oW}~{{A>lgfCi{MzujLNy=G8RxvUO|u{$k)M!JBL9d;>ZbHANM90)I?FYbTL7 z4W_#T(Znn|r7FCNyAl^Bj!LWe1V64yXVA@m91S$+hPRns*_EF{-Ca*@*Y{QV4v#^L zus^;rs^}k7@B%DY@|^$9W!54$3&`j1x&d}W-=c>7;3Fo!@Y$xBU|jkXdSOM~l>-&~_@qWy;|`2XP2}`6buV@7rJBV+mQLCEcD|)MOgpCKXc4n%m{SnJ9SNM&R;q zS|X>&!U)c{>ga)4b3}tfU^qG0eyQ<^ZAQWzv~V% zqE$mG9n`-i6VQ} zDHI{A5E&85&fY|1C$cijmX*EvUFW=BdcQxP|M&BF{2!0^yNA~~_qoq~?)$p0`Mj@7 zY3B>hvA01s7hGDgVbxBUk9%X|evaTI{;!olKNBUdnO>mHp%D~5^skkemU89`I-V~2 z%m{UilX8?hqdUG4vUkMaYZTn!BeLxY0xRC>O&yLISGg) zTnx&PUHqWJhSN9lk9)8zJ1DMXpjX4pYV1mb zrvTk?#!is91SO;g{QpePloUC(SoR3}NoSi^4^!H@HX-GLPSk7vvFi1)M+<{IZ$=dT z4d#jrDyz0PmyyjGWOK6v*-D!M4pwj*l4K6&7OqOX!7)(DO3liwfH!CMKz*ung4)gt zK~1ARy>k?qa=g#yvTvV&Olh;m?=QZzlZ=w%C1av>ujr7%=>td(@1f_j_4Lh3^uNqK zAX6F!0zh#;)u*f8{t>LO5ZEoP-47z5@gOm`LQh!os36w8BpWJM--VvyeTy%IdyJ@A zX$h*YzJo%w-qM(ixzcSfBj%Gi62hgXfL1KVJ$dY6$>-nAO0i-*(;i6r6L2dPPK+$E zOjxBre;#|gGI1H!a_)DCrm&W9qN(Z((fmzA(PpKJ-SJ&Xkd_MLs(L=~(vM1#mA&@CrTq>rAio$GzG@n>A43b~jv`c`{K?C` zQ!0eQ=C_@}I{4-v3P({#(UWK(WGusB3)f<*BZdG5WxvNL66dO$+yyn|K-jjuJBPz? z;LTbPdR0A(xu>q~cvTd0ydCN7O9s&jmUCEgq4=(;CPc!lZ&og794%SCdfNv~_A9AJ zqN>K6B`f21@Wxn3);tGmgY~{su9eWSCifI-Sfenpg3ltMhQfpl^Y|Bg73{3Gud&L50FZp@{Y!~6LrJQ-(OQi2sc|e#Tcwpia5w2fQ=3OUr?(H z7~dI(MidAIX?aq*<-wTlSzBjK1Z>34SpDI+YJp&b_*6KG+BgO2S5Th{STMNZzeDre z&W<6V<6Kwju(54KPwa|#|8VKcn^G*Q3slBNMWM^&cCPr zDFL>e8YiTRcGOh+7SmSoeqPA9qYx3-(L5DN4>e^au0bg82K(k`9>~lS8+mzZNp}|% z9p!OA3$hXi1oAl7Re^?zRWn6lQSdOq_13g4#Ne3?!*5u89&8Q8;MgY47d4FHOkggF z3pM1l5#GV(_#zANhGVUEDx`sP0{y-Dc^b@|y2d+`fG_tRNgsyW3sAfa2Ot7B z*H#*cT}Ya96+zYfv4fbQqm0kt!>VuAorYBbhrBc0XxC`^L2#B}FK+K zjSX$s!O4TS7JUW+Ez1ON&?1B^w-%EtF$9cO>6g~H(16pEA&C#0FZ%K*!DC2W$7`rn zi0up14HHKBw+JDMVnp+*p&5MssJlCZ6^lCL|Gph|4gi$+q3A9+i(MXLky}W(g4X55 z`+HD}BB2YM^L><9o}V-DcpQL}ur^@!v$CrpDvq`=6D(T)ybD8WB?4^b?`PqRP%Hr& z8dSw9Zeq0?A%ojIP4euF@To=bB4;LZ_1I8|w?pLN(gK!}>2vc_@Lm?9O8%xJF%O!S z2}NaLLqI(bKFSErpf$?F@QwII9{g*+{#`9lzA-$--=s{qdXESHN&bY18lXM`*38Bo z%2`tv$U6lG*dgT-xa;K^I#vPr`45E(7w*}^QP9h~DI8=Lsw@h=DKsdG-*`Cki)X39 zs+I5T4HPO0xnNL61P}xq@SO=)=<_eB?Zi<3rsTq@PH4%FEXcrx$6%st5CC+} zoS!S=0U~}QV`Y(%a+z~_=`U81X3|N+b0*jtUm7M4A;bj+^ISlX$uqprhimov@%V6Lr zuJQ|%G=P`@Zs2$U2yTolOhN|d90IT7Pkb1i5rCm$6KG|7%&Q4+M&b;1hiz|Jhp~W?#T@xietwf$MBzBO2Ly%Vvqb9r45RT>FC*%Y|*ZGax(@o|5{C z|4{I>p{pXs!*7VXwg{=t2d(~y2t%#VZ$Ze|!DM^(LEdw0f}ajoFSF)!n|FUjwGgfn zr&0{Xt9!o%jRDMo0e}^?++9;c-=BdiLdozl2HQoDUJ14D;lx!5e0c`;{^L z=ccE^l$kC*{A7dDat89=-i0rS5i4+rEgNG6y7Bx$C)pv1%DyZ=3y8NE*!qG?-$B-_d0Ek|#1Pzd4i;E&u**P#XKZ-u=-+tP@=G)ur$V5gN z%mUC{C2zb4Be*mcQNW_O5hnm?c&R?I`GtR#V)`*aIv!oRty7BPXl6x=wjMSf^k`xM zaHi+3VqV73turnI+3sEUzpw*344Aa9Gy?94ZMU?LaDajQK5VFqD?QFhRXXMnE1dZ5 zU9!ld;BT`*&Yp|0z6X=JVnZv>AJ6HAI_BUs_qlj&q~~dsegr=RrVbJxssogfU%nIM zq@=#HQVEsE_yHKn`}~g8V}K3`wt zL!~e@zYJ(ASD`ferI&;|iA}INxeD2j19loPQJ>&BPQvgp1k;aiI+`g|YsM zlWtUUa7@evkWh^VeJ=24b7O)%n0Jd18jv{|c^40TnVlf`rUoiW^9KOX!GRE{INk}6 zI;gS^@W5PkM~qvFIpBTB)RznJsd|8Yq5-t$A$Kwn42=&=7%RRB`}4YO?!=pz0xfsv z<_Mi#EU}w?C>#fc(1_w(G@vQ~6%YqY%jJccsqr4dg>M@mf`ju1qd{wf$LEV{q0%h7 zf6bU16+ZCuMEnf6JR$c1ie3jCE*8*5Ou#85{kggMej3CGAxa~)^!goks44~gXL`}w zdih}Rz)mJm+)pF4vbgMOjp}qT4;UY7+Itnnf}*hkYy%K($>7fynCF0TuXcB&2R|_l z;1Po=e!`(vRLo+sfDOykaEu6sWeEDH!cP;UX-qtz z$70aACwt8cn4?2u2wwJA$P@15BLd|BkN&|QYXUi&)`mue1=!2w3E!nzK7)WL>O7}7 zUbuV&l2=Lnh6pqo28Ck{u)m*tc#p=iL4s`zVQ$_^5(50nUr8;+GtVy`SVSB#BDF5s zR9Rm6dIK;&bL0o{RWWuzLc8Ip7$idei-OO0dJvkO)PJt~r%0u_=1{Sbih!eUk}-q70f9&g}b5Xq{4%uDzU z$Qd(HC}r&c^J?5HY3YLsYX%0=a4<*d&l82&iNYTM2prIr{eBwk$UKiGDr0mvXq;5_ zsf-UzfYq0|!ZTq%3F8hngY`yT>_sf6k!|t95{-AxXB?9I+XgDMP;?FyV@l~}#DgGN z(sp*+Er=f1e?NjgTLS(_Fe`ter&9p}iW}=+v6Y8|AN`fU1J7<-PD2pOXQD6KkUh)d z*7SuE5Ieat16|q(I^2{*`!;N>3< zXqTgW16KLn&=@>)QS@X6#VEEmE2RypeFLtnw=`g@hh7J@MWT7JtV@6y138%aukj&h zI1*crf7z}848Xxg05=5SeKd4{W+{mSyX05TQ#2lFDh23N$Y7BGs9H?tfnLRoIC~!z zZ+JH8Sgj{+c;_J@>C<;4qvixZux>wGxTpte1Vmh~@FF2NAPsz$j{?H00H^`IUEB~} zMfdRi7Nrotc;HScVJz7Pi@-kB8{gb7heBU)zuWYnq&Nzuusj3mI4B}m$QC^YV0m;# z=JG<20t$?orK3Xk$#wM9RrEWo`t3XWhg*Z|u7H-o4aR;rln2hrpeAN4oSNG1t_MUS zJPb-2?7K~ie7%MJ)u(x;U!?;Fw1MrL)W4SjXE&hAkKYcvKLz?e3I~b;kK`iNgbat( zQKI`grDxk9Ny1;yCw*+Fa$c5n|HD^kAXtV%YZXB;|0Jdy-EolI`PUevV8aiW&A)5n zdE1IZvAxUv?l>^EcyL%DZ6ztLU(NBm^SU)9{U5#pMStJ7pr>!ScyXy=aQhZrEnFfT z_y!0%g>d2W+@Ssdnd)np9)oLw0AMp-<2pct{>jyXo~T0sm9^->JbZ4J984!a^{)&d zn3T~uT~drDK)`{LQB7axG@NGJ0o!28(f`>?Z|=|1{u(Jr?r@?_ao`6=aWAEjA7C_m zFgS~2=8$)(*n&8{|6Q^nJvdK@g|x}c}@hpwUCwOEq2-jP>#5)G7y!Fqd*Z& z5T;^;vKJ+Sh_l2PLG&*{;m>6#4*fAMMbAhJk z0cnfkUb;wl0}GI3ET4OeE?5oMab5#lwq!Wi2jU9HS$@y#Ao$TCjzvdF3eV}ah=!kIj+_lC}-f+ zdRQS}xaqjMuWI?$$+>9Z&4}y1;HxpH>v-$DvE01R3M^PN96!f=zA&?kBu?P(0B#&~ z5~vCRvWj2Anm{%i=e-shyoD^utp+%#%U>Cg4E!B;0M_&6E)1d$iZE&g?%-+iz&1d^ zGjwl*{*2+yyW-x0n^4&JOe$1ZWj%sDt?lkmnqFeLTblOE{0I zi!Dm+|2poej2>a#Ngo2md+J%*@dLq7HoSm3}ZJ54aQ! zDAuPCH{8pDVA^~{r2}?07R`f$`7!}~JpD24@3~i;PaO+%7W33YN|D(Q`12c}Sfkqj z(xBiBNeuUiEgPnMg#0o7gc8=g{L2XxwS|vI!pT>RJ^=Iyurd(ea8?9k%aA4(*rBut zv;GIbE?9zvjW?jN^~XFtT8}-^P%%!q!>E6;1%s+!5+1Or|H|Ej`MkAIs$zs7b~09T z5AQc5haeOREJsjyIJy*gt^uhCQT+q>+`p|$kmxvC{0H`n@gg!-YwQFPBODZ2!jZV7 z-15UHY^&cWdB}Yg_D0Ii5lOQ4?)vrFo$;V)i;dqRsOKKLl#vYe?ZAPGRthbSenCG$ zvUi+q*8fF&K#bL+0 zu#Ja?p#eb-)jl$VceWn3^AJdp@%OPg2@Gd}9^Jt$$4*DE^q7={S;M&yZj^vuy$#iV zac62Ew)gilP=IO_B_?wK)~fg?;3~$6unSno4);jrl@gd{1e@pE5K4xHyJm?yBp>|q z@MsL!1`(7RmPNmWSW)Yw7Tyh6a?m5gaDomu8i*3Yq=7a2A6HPLV#ihlT15{LkwKjH z`a|6zI6mOR=H?jz+4SC^QHN>#`|+A5dg>4qKxgTTa3Y0P#PZlni8~XZ3V)`>4i-aJ zCSiM{`*wgI0^)eIHHajG9)!}#&iK>8a6yR{f1Ito`!@>Ygj_c@SaPL5>hB<2+=tTs zHvXtF0$xGP_YJ9x4(?dqnA<&t0HT`MhG`{N!<^Qz)D-|if`v__dkY7|&^Lt^B%}Ct z;)%AuB+4R>rw-3t37lbWvljm-)mKX$BX_O*p629QJwND%g`Bk7zcY z<oe=Auy3 zR!C?i)_LGT{nh7Acd2`nE}TYMgB3o#=<1%Q(fST-Q#;81L)q>sqnRr%B>r~_LsNb# zQd=)lK4>W+?#8#_$_u=>DR|t^CG_-VgRit~q!kG+wdB)W%|*J}?0&;Xeuk(BqFpTq z1ti;%3|u>{&s*zM{9U|KIQ|IsXuHBPwRf^(@%P)6ffR_GujiV1%FAgkTJ2d!Tu)~X zW+zEA@7qn>(~@L@j==z(3u$Zyqs>e-iL{|>&HF7S#_>x_t+Od%Pz8OfU{ej*>;0~; zYH8_JwK;U;#ZYji?YQ4?OESSYnYlo(l5BBJuz(ac?YFO{q7NAiDI%KhghPBDUq9Ct zK5oE2Ad{vch-=}}Y+o4I5c>Q8ul4P`OID}gYZH#8OpP1N?eZ6bb`iU-FxPX@vWpwt zM;96YvH=QuxW{DDv;_GW zjS5!Wu8Xw6GxlG6^is|CSEJuzyX$Uv;8{M#yPnuysAA}8A&I*y+k$-BA$?ec!pCPD z<+~W6@OAQ`$_%}(2Qr>>-@piUUzJH?rOsFz%c$2T`Fu_1)`UM2Pq4+aT}0h=MqMU=n(pW=ztC&Z=U8} zWhFkSJB zq(Xg~<~Z(U%H0 z;e62`zZQdQi2vM`(N0a^c2H47AZR1k3)cKAx=?#zsx@;q5bR2gZyfq*8G6{3hxhSw zjHA?bieXnCwq$6xw;!%4{)SBld{mtN3~mGU{RfYP&;K{q96HNzrj9r)(AI9*bbqz` zE|lcM@?>hn;tYF)OMQC_7l*2uhlreIZ!q6;AG$7+@_jmJOQ2Z8Ls*yY$^hIZlNp>DCQaIcY4k$M0#Ha~zbU z?e%|GGZT`R&*b0Xka`k0=*sAbm;uV@Hs;ggw+_)(OOon`H>h5_yd1QWKz146n>UTEnUL|{>1VnkJIAl0*BNdr7pUbHu9^GV-x&fz&QV%$7myi@xe^j{|Op+X#mEzAW~%7UAiLoVDpJ2bt25pkxNcm_!MV5ABAmpdx_`^JAxpMmBxLt}=L zqq74iB$AbVSMD6SZk#S_^{VD$Nkp~J@`K9-e}1JH<_~w+JZqk=26;x#Y6(M^EnYw+ z=U^Xf&g)VZIH6=ssDSO@l%#))NFXa7b|F;Q`RFB@A=s4HFPXi;F(OR-W@{@s72_FW z(jj0Az+Ixv`V8&^H!GD#rK*xkPW{V@|wFK{}4MM1G-hd@8_5aVpQ0cMSH4UnP)>bBOr4QUij{aE9~P?35rNtML5JH{nHi7 z&!r1s|Igz_{g*c*kaY!}=$f6k&;0WhpRzqjiAsNlOrv5K<&`**_y1$ah*Pm6?dGF!A#U_Q~84*re%>*7cf0(c=jA_&GD1DC1Id+^FI^hh|F?4F?-0>)^?pp09yQ2d1b z6>rvf%KX=aRZZL)>5QkjXt#WD>Z>t)zzGDh7@^X?xoABGo%-^`XC|EE_X8chzfS1G z;&;bkn~f3KvXKe-OGr6MPwqm6XVBz~%3#a%aJqgjxpuQ;xEGV6Eme7j+k^A)&z+6_ zCdtkD`MlZfNAvSDWxCiLK-Ns00EQ7F_%$uTpp_Mn0{nR-kQed4_Ew!jFfZ7avuSl00F2ql8F*Lc$>7VIUI%f@W zuy>C^Vgrq#GQpT*IY>VS0ZkcnJ&Cr4MwWum$)dF9z|wDali3_b7rO+sS(?5yA76## zptus?jJE@Nl$P|9m*QL$BBa%3N-gQ5uQnpZ1{W+iif(o@RnB&TRydbvVliC2t<+}D(?j)y`o8y;=8yg$%pS3)s80#vO=TVBT5mLie1Ps1KK zrVYGaSoc|2@wm55ONmFf5=#?qR4&@TlyR&o)eOOZa*H31_cH|GFATWjE+m6pK+P6; zW0Kon4!BvjQgYY#k|82iOV9^@{xM2w+-1>YP&fGW^ZPtIiNWZrm!D@ePgk~wbz`hQ zGsekF;-j*a@WK2NOp%#Af9OkEDSQXo6$l4JHZyXTA2WFBf$M|dGvTxndg8489wmsp zP&~;+mrxw6k7HD5F@V`FITRK+=`)S0!vg~p8@h>uKQKNtuHTy+Iij z^Yam-q`Nr-iL#nJc4BxoL~-?gW>R2*!q>s7VB~CiQXpe3mBYkgu;`Y|Ko;MX&4epk zFH}(TA+97FRhg}#518=xY&{d6)VJWptXNqS&LW8rc`%HUx`s>V2d{yR`n*216&3(z z1+x0QHsNG~kw!0kWW(##qKz`X^}mf}Gbh#^tvH;gX+4qd`uE{ZB_0j(_W42NRy{>~ z@`tZBrkFt+qy=TO)E#3+r-#J)?j9PT+%0mZ^;mN*Y%*_(>y_|@n!xMq^PhsSqgEza zu=qL%LuCs09DAov>v<~_w*=Hul#9wzUhJ)Ug!8Ze*7Bvfz75fatf?%Vip-N zjP?%XJCKp&>*YAp8lfyrAZTxzELh;2Qai~5?|XJ!K0&W==tG{2 zY!O@ZfSTT{gn^i$d0jkr9C}Fr6pniOfFe|qM!QQ}`lx{s?L2YR&eAW>x3O=hRf*3O zOmVW=`dvsKk5F8_oJ_Y2s(5S3dDh%>E(}Xrvm`&m9OQ}wpy6#zo+X~Y?-T&`{;JwX zKjK7a+VsTzz~*URy?eZ?V5cTgh}p1ZT+cBAd2J2&|asYhMpN9jPnK=r9&?<(VzRN_=?JY6-2gMbEU=^l*;O z+M}{V5)mumx$qB-fVST>f!Q+8v$Q(FSnRVvt-x{p*Jd^@IT+6YTTC|A0e0zB+rUp2 zXQ2|F%r_{z|54<8-DALU@(Q9^bdW&Oo(4X_Z{#p~QSEeID0nb@jY(eyIyx$$`w+Gr zsFDIfD;~19F5@p?7B1fkX94y#`6UavHR#({Mm4^7AEB+j6`EuWT)`z-+XEaoefi%> zhA?$tI6YcbFe?enyPBto=L)ou!6jgM(#ZCEzRwKfY@3IS4XFDrEoW>Uahd!vuv}vAu3}_rS@JPPwQc5lQDO#B6zA-%J)KP2 zMaI6G+W*$e?NKJ3TeDDTYBKlRcS8S7X%Iu4kfM)lu$P&zTNyLq&up5E68Oo zQKOjQ^?ADNM)mH}d_?W;=8+k@TPh^OP9+gp?!9tt3^T(wR7ir|Rd4ouboY^qAK1KP zp+a)|cFAg1bOPJ=!GVE-Gx3Dt{1VT(`lzgA4E0jZj%a*y3N<+Cop&{&*~zNr^;Kym zFV%3-^26_bQwTT&&B}Cc)^(8&aMPJg6GwYHCSLb-viC~X(9@np0`E#BmE4d#zVXibivieU-l28KWON6^ayYtcldojnWf!$E~+Jp zVDE|L8AiJ7X{1%jR5YJkgFB6lz(nI);rvamZRg122j$Fd!wX&(?-@vBWQi=4NL{OF zh`b^5ZQvoRrctV>>aoXpJ~;wqdxpL`w#sXo>a{WW_pD~Vb4|R&rYXpO$crJySZ?)@ zL$~^ui`q%LHgnDeR7;)eQI7~z`lZuebd+n540kQxuD@7?G)mkUVBqYLjMAW?!$wVa zLzZNy%Q0O=^P7m^423`kVI`Z5qPEw5?Zu~I=FflmhaSk`HT92PhF_|$wyjPxH7O*K z*X0zD3v^Ihu~|O&`$L{>UnuT}O{Ai$YwVHPbPzqMVdEN${!urdNd720Keg~5aI8a|`L*}YbUvaz*J?6NPz-$hET^e?tziC{dDFtvk;?X; z+}t-h+s4k?98>R{vVO8yk1%IgkM2#28mH(S6v`hZ|7P39Fv1%Bdi=rZW-FL!%i{}| z4EK|>%=r6|d!1YxkQHwF@V3XPzBo9$8m|jpej0XMy}Dje7b(Q*l)!u3VLDv& ziCo%Rg`NYo3G==9C3I*D4;HE>{enL9+ZTwr`uVTO!s7I+SMc0GVqfqsUu1JBpji^+ zmyoWU8aTUr`>eUjR)U(*i0)0NLEXeHw{Y{5bR!~kYJK!V(;6gt`6q!IaxV3K(d5;P zDaal3VR|ciCX4LDi|c%`gh1pYBEk9HD;{awXOC%fH|Qw|-*;V8qr*C3jXwTkw@~`? zphmgTy^kI?S|hxp=h!0O93W;QWm}eberoxULzA^x$1*(w<68ZT7X#TdUp{^HHCdTv zQ&QX{NuBSY;SsdviTMzCL*wa4R}wFD?{T-NxOpyQ_Hf!27&4(8lOBs_z9LF1r1wK9 zMh(|0R_)s?JIAWu*;Gn4HMUj-49t~|2_3SPB}p|$-WV4&PfxOVIZlsQi$9PhaV;`) z9)FlEnqE<#vuP|IT~;%kv@wzYHvc!nY3yq+96S9++K) z1~XfmOBKr~8zFb_wI4;+q3>hYms2dI`fi3r(~maw7ZnSY^bDtPRc*)Sttr3-< zk+Hl(>$ryKuM1D7(*k|!G+!6cIKEelDKa05y+W6l=XGq3#7Z6C{eZZ`qqSaNa@}a| z?H06g@ysm9qiKz;cn*f(W*f@~_?~_+WzB6R+ zG1GP%Z_y#w)=tjQ-dc#*t0cN zR&wFb+RWC%aM?qDAHmH~NujPH!}_sM2fL=S3eG3Q72f!)9}ukt<1>=MQ-& zJAWol5fLvcA3T%4l9teFu`Wfku$M<2<_AR=yFAh8+Wua{?&isha1$esnwA4yl z(jOIcDZ^x*m+1!g;b(H!wd4U&+)Q%KnQ1tI&1l^tEP8iFi_^0&>PajS`##5s}@c^MV9BZr7b>`Tx%^cG%7>_#4VZz zAG-Pq48$)FY3;8H<}Xfh+3%Z^X3gUTD{s&)?)61CxDe|VvD;UX(XRQC$@}DONAnJM z#}v&1>~EcAc6M{kKhFlZ8IK0q?GMc1c0$Jl(;t+>?QF9@NOR~#_q+v-ll$uw%^z>z zU&Uv6_Tqc$bm>ZC^5^7c+tWzZb&^|zXi>TYt|k7mU_gizrTbHgO_8Z}{mdvuB3WZ( z)(V!U^iQz~9(T&rEQlh)=#%TLx#q{w$N7rSYE4)wO;Qz?;L~A-iEpQRFJTXNq%A~r zCf#e2&ejZ+v260V%xP1Rs`b=`sv;FOBt2K3nPwq$Fei5gsCI%*^y&M^+Fj^J__WOH zCeMk(Xb^Nb;GuflBweE^cn*Fvv?X~oNjGS6p|8?U^m63xbUbgN$jh1gw~^Q+X$() zjhJ>XBu$mJCMG{qs3Aouu083}S7{_ps|_Vr4RcM-QFaYrI41fxbF^+-Q{BvgZ)oSb zX0CaBl>HiZBQ{4X-kK^FcSFxy^VBH2UUGoZoG$6CZnE`xTJ6i7^%u3S>d;E1Jh*t^ z!z}xaJaiSDcPnEWIm<)z;U`x5t_%j0`74i?&({P>0DvqI`u{0%uLGqio? z1W7Zr+dBC=(kcy}zI?f~dqoeX=AT=^=zeg?Ic{jP-vy=#Yc`d?b=-hnobd#Q548)O zrPv49$Kn2ZER_a4bscJYf<~8@ezPx`sh2(jDjz{QPTowXA2z4DneKhqng7a{PPo_X zfd0lv7#iLiWnaRk85&mE|DQL~&>PMZxK@c+t3+DQ8EG9ultB`JR4@KHHL%u=brqw0FB6y@nc zZ{TxW+Rl8P4@~i2`htBPGpmc;>vV$`E7ixUWL6J(pLF@$Q26&wgzu{iiNolpn`Db3 zzBc?<{3wy$A9*sX;h%4%Q@t!XG|PX^7AQcwx>laCM0&C<*0s^pVN32j;|aOlD|=7Z zb)YYRZa9c2Ng0OCWs77jUz=;=CeXh`q+v8gwwO|V(_k<|+jBLl%?qg`DE)FP-47_@ z%d_dp?#$oq-S{`PFgZUS&(KETRp(2jbu`%O7^l8|eYJA%AZh>n%wq8uB}=ia<6nm9 z&Q+w+JnnD|oE7_231pmO|6=5X4|%RT@DcN=LycGI>F$vNm1)tx7#W`kz9D*0yY8b3 zL9El7Ggl|omtg)Bn#ZPFTwCWak#v`%&qKSN=O>8Sk?{BF>TXjvfU}A0^1|Nk6`n}1mIZBlRPS(x4P5?zmUGR8lPNx%$Haz)#o6%8#xSq+j7r}r;BGZ}>q z`mdI2>cF8U+m5(iu6dlUjVE*L9aK_>VX+1dvESDJWzLs&h^fgl<9Al3DJv`UHIH=k z3t^+<-e^F-*qLk^)t*+-aRU{~^f0mmrALh&by{5}xx?S*B>xda4uTqkJu$R5GT_(k z=9hutee<&O+4ktPV)_Q`!yBT9Ki9_|;}~ApovKgLO~wda8x(ts_P&xqXZ5$-?6oA* zsLT)8?4#<62L2INB|7{H;kw$ner(>jfflwvIbwg|SsuN3*fF`?kpz2kY50pzIrFRf zQP#z}O?mhx=8SceZ7fzp5NX=e5Lwxn>PJ@U{kOM1HzBLt+naN5wpVAHto)bqwy9ri zY~+;{Pl`2dZ%(KplH1w~3&_U8M7reWOt<7F^szNj9c{RE;@NaGvNqn4hd4SJ4@Z+r zZf^9CM$fNq?+OhR-9<}MAzx%p9ol3|cpP~rO#6`S?l#eY_^$cL836X z{@_w^BR{z7uI`JGvYDL20iDmD28L5dd@iV7Hi+)jdAKQ0GZjgDTRAJoZzLft@Kmg) zuxRRH**5u|CuzZSU#Wy+7cIDR}&>0`pQ`I@|6H$ z?YCuO)lN>gl-`}OJ#o74^y;bDyHvF4R@BYj(A3tCd6WzM5WeX_bF%a zBOybxQ&)52uWpF`M(wB* zdH;{FU1ZFs$*^Nf`_p;eDw$R-zbN4Ei;0Zgoe_Ls&*6y!*~!uY?IF9RmN-n)iO>7L zy~9=WkoallQR#0!iaCtgXLk>!TxPaic{uQl=F6vm&Z4l>5l{C&bRo)Ut86JwCKW3^ z-ucOZ*^!c!0mhLLGZ`rs%hewr>xyMLvliyYTrb z{|8AC+n$v%%2TrY=qq||t0A_0k7t`1uX*>`an8I{+kHN2FtMAyeFbeIv;4H6{_WP- zy)4_&bM8JS^`EXRSm-XIPc2lvLK`sfKz6ncgyl)9U$mH<(kw|o1>J{TyWBeV-C=7p zS;-$GDv!KKVkY&8wy7t!tB`n?+uaHSg`}$p(OZSI>gFqCm%6XM-A$~_FA-;5DrGBy zHszeTB`R_Ez)I}u2{j^dzS^yTx^36yZCdCzl1NwS?RK>0+e|6LY^k_EpZaDbTEl)K z2X}EZEXXhnMfj(Rd?Sk7=Xc;O{{_RY>n9>UE{oRuj(Fff;71=C!z&U)*cQD@_*id> zqwnKFV*8?f-Ls<|YnxwFzSwd!Q6If0E38_=l;m%?_(-h!*qrET6)P<>vh#EA=(07{ zqe~jj7pI$krP7lSz0geVcR8;}VB?YuI|(QEizUra`y4`Z}ODHJeupI zPEQ={XU+O!z7!>&{Fu;}RC0~9S6e$;hoN_*H#Y3V$Amk5X8SUz3e%}bCx`^E$7nXQ zPFN-AjJz0*y(CzFC9Cp~zsTIg?iiK%r25u7&b>)W#fSU(`oCQ`$f%<|DtIZfgS7Bg zIe-X7s@f8ZZ&Ira4}PaFl_5JzQ|-25=@}Q}ohyX#LND_swS658mBi zEY~jf+LoLDA>v7=m6a*n%Q<#HHTsO~SJ!sVZ%q-bmG5Ul>Z%#O7__}e=krUB^NZ0J zTwUSKYq!0KEIrlB9MCQeDI$KMFZw$F)+EW8<2;k-#^w1bm5Q&A`%F^bPx!y`rVQHm z<)bv^XX6wC-amJP3%XKF zk>Iv+yJ2*gjM#XsyC?FzWk9M<^0n9Gz8MaubUvs{*L%aJ`MZqzgVVZU zQO?hzcnj>`Q4LBVDTR;ACp}4(pBuS93ct(z^HGD}ksLP7*P(?R_s)IzEx*p9y6LAG zJ-d-O*dXD^cn^uGBy*ek&ZEJcZ)F*iy~lbq>w{2ru)^F0*YltFdLDQx-V+u})uU1ZGUTvWum&=qUm`sY3`Twz1C;d zeMXVFNlZt1Kc*EGj~>o{tUG;yQ`Iv}!bZ1^C-i8&ZKApKW@}n)$kxS`bLk$M-!5OR zD?g~$;e0eL^~RP^YMvNW>c&uby{G*Vr>>8ll@do*uuRJ z9-tI<@yk z`R~@^5Nm;)DUq@-bV*Gsy9HJfhGH*JC)~W>!SqC3{ba0nSJa?~{nI@H*Qvg9OL{0g zt!%WvHC)`quAt>XUGTkF`CZ-n=yqR<>{x;vtB0?cUNDh2nO;J?3`!hSWUR~04eA7b zn$Kr)BIir@31!eQ4HF&v>B@Xe=p)OF-{cG7pqG{uu1c>~8&*?>l-p&$<|!wb?2!s4 zPZ07&ZiTIppX!+kZ~9&4d;OA8mEhFssnJ&y7v09CY@DCQkmrepcm)Nsn_Yj-eZgTW z^F4ibPSHcUUA@UN*MFHdH{3ayGx6eUQaroR3eUbtgxDvzGd(^-=zBX$axrtsIhVcm z$6igB@M%$zQp_`YBv-oK<~vh3+h##D{e?X%+v44_c!mqlx37zCpUKQr6k^m;LT?@O zR6h3Ho2LH!{08UqBifrXR{ZM4+PxMPYu;sgUL8SOIfk59H~Uc z(C@0XKYN5yJ-Eun+k)Vpjq-SW;mY=@?>l^<(5OB= zl3?4@%k}My*A3yL{NGG2IvD1*k^3lj(5;;gYWE>thBthGc*b$k(ea!xycoX4Updcgnb9JiKm0mUtGF7Uv+-?N3lxqRlkMz97N;6w?sUV1_Afonjp?FH92YHP44FNny+*9s-))q`Max>1^mvJ*H}tn5 zGs`aq&86>A7vhtj40wjKexhysqoUp>*07$d@%5Kc)9*C9c!ij`iWJi~*PUbTdp}>~ z7R)-OBl7Jda~_iSXwr=Gvb!H=eMs}%KzZ(y)L$F^C)V#S#+}+@aa8lOPMOcL%DyO_ zpVapgi@T7p@Xsp_dI9%?CmkMg<>{HxC!Y6}OqMH5j--m1x7mAHbLDKVTii%LgU|8v zWi?_a?ddayRUh2oDj(<}-xwa)5L04q(s{&|Q)2jSpu`5wSX8T)xNUfw4_bhJN1t ztdoDrHG;^mRybc@q(7AI7I<1hoRR51dl??yb0le z#i`%Fa|NZJ-&8si+ibai;wN#P!CzZAV`CzoH&8R1;Ms480K>%ZJL=_PFCmN@A7 zWc~ZsmKP3No4wl`Y?5EBj;NjULb?hRf{@jHP0`ganH)wcn<@&J9$VAN3LGnsZeE;s zWG(o5w$!TEctnzIb1^+Vs)?Dm^T5jo2RJ3Cd}Y(A45qzger{$wkQ}>XX*fMIQ@nm= zsc-Xj@%m5BX}g0wh-*~w`fPz~LiEhm)}q4J58fxCm8+g?Uxd^nnERUMJj#m7Jpa*1i7dubK@Hu4=??Ui0;?pGFksq=xWiP97U7b zO42}H8WFwSTOgq$vKnGS>>haHSJX)>)!>6JHic9&KNSP)YN$4v>Oa9_X*}4+oKAl?K12SQeu0_(?=yycQw90A`tEeulxL5+-EAW2Wu-jys;3-~4<^*vi_%BJkcJ|2JzQ(Pj(J#if68o0+mF=f&+#|b> z->sSCGP`5ofrH20mlduU%BQDY%~GX3@lpPDVHx~?1cmojO=0qnLh{BeoQnV9a$lba$nFWBFX zQL#QiA4{iwVn(-TVGlPUk&HjP;x`rzv~zYLH_{%s_Cwl&Slx|PTIR;v*HqRVdyW^n z^M?AoAY?tn@V{;sg!;Z9WMK^bANSL7k8A(0+xW*j{>Obw+~Y$3>o)FjB=7&cAM1Xr zdcKz9vG0wDUB3P$KfguyAADaB^yk-c>$LgzWZr+OiuhHEXn!qq3dgEO_p3|EmEWa( zLp--aN?I0Yo6xlPjC?fHhE@|FJqM3w?t}b`wCwKM=ux)OgoSmH5 zM%K#&=FiNIwVp9hx_-%Oz)N_me8N$Ac9*}x{_r<)mD=nXCk&pEIT`YoZoaA!;J(^< zwp?sbS?RT>xA$ZJh-VeY>JOM6ck;dv65z?j{N%}iE|)5s>2cRhPU$Gh2gHXIEk?(w z^^%AD!cR(HtnEFmbHT#wJRwn4j^Z@+-Q#}Rh&8EPNC1_23}`}sS)3jp*XI?^Rs67=yM{%UXJ}}s)~)Z2v6 zFe^qgQ7T5i6h77op9Y+YW$@B^P_mftIu(uocZMd_M#D!}RD}FxV zR!*5iB-G~Xe9w$#u~Xyd*!(Z?EcRPb(E&}WweJ~5zAu*w*j1H2{^0eJ?+HutnKvfs zu4Kpjc)yOSd@5O8Eb$+2dr?)kQrquw#{6E;-gb+iy}K=g42MYWz1+xry^-{Kqww`c z0`hv}oN7BI^A9I6YI|1mk3^!K(qtdgeSWwY`iGQT>Nh8PCca^^Ol!a;^$+w$!Pfj~pa^90?>et!T@`Ud0AO}aF1kY&_W`f7W&*O_6(j=bEbGoUQ1yElq z+kM?d$ePo;a(zg@e=@R3-+|lKDRU`jhI5^uX8DyKjUmN$rsGVd^2OnY&$mLzC-k;s zYn+ETYsngs=}9N$h%rh3ZF6IZFTJ}KbDfn-c-t3a9gjq9x-KbCdiN|GZSYp4V{YSd zRLlG6Q%GXi&a;waQQl!kQJQ%DPpZxX*Fo0H93#x)n^9+&!(Hzm5o_#KI=*Fb$=AzEPzj}sq7)Q2TD z@=?z3`K2EG;xEC744T>o1y|wM))Z>wLl4OPmuhksDg|RV;eD8j1h*CKS7+@i!%(4Z zPCc4)tNlsTcGRLPVTKiS1gp>(5YmS-r3XGLJ}AYA*(CQ4vSpUPiX$=x@mYsYao%x; z*ekwobS1yPcI_EC3?J{{lRaL6Lsr!jY_2;syy)B?o`d?V{CP0UwY1m?`HnQ*kn|if zf!y3?z;%0g*o+Ym33WDajEvqRHnC@Nu4%Wf;daWlYwR}rg5hxM-nzzf>FD-lQ|G1^ zop?l@QQR1z0&#++K4t%i$2Fa$0KynnZiG5{InAF+HvfJ2Fdd&|kvp5E^fzwd(qHAO zrS2kbO46ppgH(?i$HvpNo00$~k`5inP?BC4UB2UfeRruNUce(6ix6BEE0RA(I=XV> zgk@a~?a&3fNSL+(f%c@KF><^5pSzr6BAxYYg%yE5BKJZwn!yW&w6hH6Wc z#ZS6Z(J((Zz%(HjvZ=~XdmTK7?Ji7J(&0`#hhKs=JI&v3@-?)hLNiapC`EcI8fm0= zXJx%zYrMF>a7pgvfpQ4OD%1lTdfLxsR^{5_(?O-Vyus|fA*FQExjotl#^i!#@2o|& zJX+iH%u|H-#Vf*jr|(i#++j2dAuEa5KVLP7AIh{5VgBK&6-(RYYUI#pt0>tOZzD3g z{ahO~VGEnZ_8?wG#s_;K-G-&Q5adaxXgqXVA{}S_m#eW=x(zS7rF7*_R+1+jb+G0q zo0{)mONM-4A5>m=-<7Q&kxba4%j|J&^DW6zNeru)kdvUml|Q}N4A&@G3FW_7+uqK? z$F2HMI8&+8WKL+swVP*;xcvGTH@hvA31J1-OE%=ql$J2{;x+$=-9L+9(naeJMMoO&Gx*KaB}A*Wztz%uJZqG zYd=i3)l2<8C#0(HrRY55kEPnv*CX7`xpYdH{boG-H^0*aMY>Sma4SZ?C<9?3QeEp4 ztsymijGiC~%J`|kSG98nB8Rp354hXKyAa2XMd=jf^yM`N%7+^z5`{6VsKw2_>6z+q z%Ju&G#3IWfMTs)xBLjz+oFcK*f?{YK*{!hh#v`G?piPI6=VoHuBM ze#AfIt;hpS^FTr`9oPFf6fMp;wzVbn|)8e?|ow;kAjLPmt??T z@1vH!b|u`XoE|fXIum7A?MCY~D{S_G|2tN}khX4K9FB{Wx=bna516f2l1STMjEK5m z)!VKHJ@s5GSGELu#%-4;Y{UB`PVQ&r3S&J#{t-cixAWBb&_Vy^1u_z>@n7s($cy*s zFHZKpH+e@p7Jw83xbBLnJeMY{_$QiDCw zqPa@v`^*u?xqH?a+K1tx#Pl7ruaKlNe~IgNDLPQz^88x?ekmi8C_z~5tb}p+?3Wch`v z;u;z!Y5BxF!AmPLWm<-nQrWmsG!->9rMwlM>LJK+C^SuJ&?_k25WObTkV$Q-kr#}< z_KEe7rXgCzze;Yz`LaXlJ8}MuxF+V>YzEsEU-q!n5xxg;hZPG)X94+pY{O(pDE2S) z?@Fhl#G#ao_&O3XjGr&%l_0T!;wed6lh`EL3`s94sD{CJI1019tW={@LeJ!&^TCI5 zBEg53`@O}^7*If@OZi?bVM0tSh*~*mNyPdk8M4tD+8ZRJhCc0+L*XqfT{$7@KeUuZ zMKpOf99zGX;4hW;kWAAW-LEVRlefs0dl9AVHK`bSti$TyLQ78K*J~lY;54F;A71}- zdNqR=xNTXi$~l%57N^~ScZ0znv-TO|+tS!rHuu$)zJKq+ zKjU*Hrz267!xb74ola4KNs>KenV(H+ddSg4<0>a;e3`3?OlIx9SdfsCwz0xP$MASF zY0*fP7j{OJaZ8sVn=mJm$3j;TegWkar(}%IHdkE>NNn=T?aaZ`HHj=b6FcHYE9VXN zibV!2C7QWpA2AeIx@ak^Nxa+p*~jXswETMHwu{6=5Z_H5^Xqc$Ycy=8yNgR`kiZx?9KfHEvT6u;^!{6KU^b3AZ@ZMtj^Zg zENxi3OMz-DX8x7w#Vd5Y_)hgV4wd#N?@H);usSoPk15xC2dEL?nxN>YCTQhNwryY$ zw5LMnl+hfatgUWdXTLL?p`dk1V;Ahdt#jE??scJ|w)XqjR`ALv_X>D3UZiUeJ@_0@jj*U^^B|@Qfp;#|BQCr(BPpjb^}Mst7K#4J%tzv3sE_} zI}z31ijTpFOOItJ^oD-LnRmv)I2Ru!WSe8NXS z$CVwjo#36|L?FwKWFVlB(xVY6^-cTEkdb}&5dHNL?@YBZOQsXg+h*`OxB_9_1@&_U z{wERNoR^ZnTLfwhW)%;#q71EKmh{%Mcp=K4zS|{PiJ4#j&R@Um6?tI?t4aEr3yY;z zuyu@c2<5@ok;*%glB?iTm3(%hKQ-N63J)vEAGVQ6b*8tjPk7vX-iEswfmKBpB?!Z6 zBBFh#)Z|zRnkXMu|AYxr(7+qD$H<;FgZ8?s)PP!KB{q}j1?~n-c zAr$76{k_z0k*?{@Po->AuoeE;A!cYK;U)Bi=89AuDo`CxR8eoPgng%#Me!EpYDEum z&O^XYQfAwEKX~ABT+d#jdDJ$33{+f+<9i#}7CKba8U?FD##r_k-PJG-3-`L1{1si@ zR={cp@AtA$c|NK+Ji@=IF=x3~57>uVyuWO6>iy_-{mi(%WP z{B`n&QQWm1Ygh<6Vr$X`L|bStQTq1lKNkvAYjRl=^L9;DL{E^yU>)gn7F@b0^9xM4 zQF;#RjCl3W_9pxYRSi1P;)5P=GHM-GM^ttn6lLe)6ZwP!r^@ivBz%-r%LolZ4smUK z-#5kcRtDET&$U4bNs`NZWKxrw(Kmtn!+4sw+PWX2SK;L+x>7bDc1f<7E~98MT5EGw zyxf;E0Ru)@uWC6)kiTpRBR$6ajq?#MqwZ^*#wmdH(b+Y-fgIbx@zE<-9>LXFMFk5J zV;9^|*whw3nyTmEb6zq)Gic-4R6~60SVbz}-fUB+FM(1xf^ul=NG9=xa9Q&g(`W-O31xUSwD zPD|Hb>9UN3RjBW>jIOhFQd9pzd0SUKA>X>WW9DL>{cTJJ=`lYi>+WDhqzKRobK>U9{+1EXrlzn=CM_)#PSa)Os$t}jk?4xGV-Q%{i&9FF7;%D{z;`>>a5q;&FQip!Oh$=8BvxO z?{qGC`Y_^6ReJ_HJ#P{JaKfjGA+^4r}xJb46uFW%d`} z@Rn)5F70~@?2sAo24E`Jqop+OX>ba~!)T9_pWD%tX+u<$(8rs_Mx@wWt+9FLMDQK9 zKC}2}zao66^nyQWO3g~t2TR>*!23K;nG~-k%C?!PmKoP18z!b7Yk{GJXp!2xLZYIe z7t8yrf87a+`MZM%`FEb^8J&M-^bqP8E2w<*GL~U)`|jWdO40A*J1kEoq=tnmX>)@7 z*?)h~#6g9?$Nf~lr6)}=s}KCP89KcZEh#}?B5dSO+dX|%y1JarU$$CZX>;$tO^#~^ zl@fIqC|1wi&-{VlC@?H2It56B_H-qe4E^2L%dU6e}kCe zp-|^^FPb_=s3t*Wtl}@JdCvau7{BaFv0L}EvaLQt^xR@T?(v*|%o`M!pFNd@{w2@M zwmSG>8|(eKJ`TKzUic==+B!a7naFJV$BjHS(>9l~(pB$V$8U6os7b|oJ<;kvqrJO? z|0dn-(?rX4{gTQ00iy<=+bmvth&rVc#GKy#N78;ZNMF+6DsG_9oU#9nR5CSwt7>Y% zcw>e?8dGdTkw#6Cgzc0ycXshi@QYb(=aY^D8m?Fh|h3tvU6{A=MS(b^MPa z{HnTaO0=H40aUId^G9k=;`u70Q?}$}7lWy+xFF)e~8iJ@57UXkNy4{!c!cFx*@hwW&VQcg(;H1gV&E4QEFRt5sB|QPv1`|5TFE9 z8BIJ8{MTf$sns=oJ~)zRB|zA29)wlPr0Y?SCFn?R-Z|u+psO`D`pU#TGOUXnxp%~c zBE=pSAb7LTIa8jzT^3fjEkL1T78w?Ly{FycQAS2)Dm-j-PiAgQS<<5*QZ<#rJb{pt zmK1!EO1t<;1#2iaPF$5OW(_gYdFi~BwGmbfsf7H|eVcf0M{A@7@jw8PQ? zN^nj`12?LnJOzP7jkFkKaMJ0KokL7u*ppwG^XHErfi>7dtrL5kNlU9E@>1Lv7_zEE zbsiC{4{fyYaT#&^QErv*@(?Z%*@)1xbksvSyA>9K@ITlc(Fm*W;+xCAVQ{XvA{xqK zrgfHo%Jg7m*T2ihWL)^pHeYG@$%GnMV(;zxKwD5k!mbO&~x4*}hcW;TF@ybT)=#~=gub-95uQzuA z)S(+KCb&4`TExAB7n&^MzVfPhE(k8EyLb7DvG8h|u#EGKpp~0>XpPgH9r*&x^fD9iqS&6#HxO8vAprKX_ z`p9#+{6^Er>w9&!=1O&%DuwH0DCxI*7Z)k~!nQ`c$yY^JTV+Z_P2BLe{MgpiV8GUl zMb2rljy)X{ah(Fo7O`jkTgIOOWztL$qc3YCmz6xeBYpW^(+LTH)08^yO;nq7_<+CB zrA^{(b~kiSR|bDhN1rV(u3o-k5l(QO&^iQ#L z&{cx}?+Eh$!2Tz)n7#e~QTKn=_`hHKcl;Gk$(&Gpnia_N8n3RK*2;%Gmr3vC# z5)J7P`VzlbTo$0_8)YD{(4G&BDRbOGlmZniW&LomZqGZpC%Qh{VY6iLyvglt`j4wX zMuWOgR=Mhfa_`Tvd|sX(KQEO&!z<%uf5`az&Npjbk%L&tI27SqVGL5Rh3u4(TpTD} zFjm{-9Zua%Q$UUw%C$W(UBMdW&=VAMJ(A0<8X!4Nw!s1C98_dqoU?nc{<1#Q7kjoh>w?@uFpF-XNxQ5Jm^P364o^U=tdN zK>(r(X-ou(vf?@|RZok6sNsO!(j33~Bh!Y>ZI!eWU0G}R;$A;A^E7PVH49Rh)vva< z>E9miFOGx)bw`APGuj}YH=hZgJSf8bu&_jP9{eHixlCmX--x=@}@xa@Ct>&`}r zk=p`eA_6KSuW!^sg}%i?L+~;lSp{(b556Mq0l$jKM2r$~Ea}O4-B)*Y*VikImmc1q z4}0E3Oym3Qbob@MVFgP-5vQCi%1_t6z!am)18RJU?TNOg0Laz$MAb$=S4Q|ie*O1s z9f5bV%z{Gs>2HbAwY!?SC(bOZN*%KvWmke^k|Jb=CED;J!bz~V-)oZ;jde@uWjj&i zwA>Dwan_hDr1*Wr`}&&3qHRpe58s171fXGO3odSAxITHm7!ksr= z6MJeJ`)99K8uUE#*NW8EHCL+#l>vxquFDiwnwi7&FN*dgAw-=>HwVUxu=K+8Te0w0 z%Tr{X)w+wK=9P+nd)O^o5K@dgVsF(0j@t+2P3k1yNz7OE?nqL!Nn+#jZv?+0Ei4^O;cONRHe2-0X9z!b2e&*XDwvtLM)k z!vobNce0hYdsWVfPDujuMZ?L-)c1W@1PqB1+@yu}U0PpN4PV ztwhf|O44MapCN=OTHEOB4-PX~okTk#YA$n*-fx(R9zs4(IXV~yT@9q=cK_fEag#Y@ zpg=woY-m#A?jDg^iyYlW+76u44^LzO7lz@9pSJ^-jR$86tSQrD?xZgSmlz!KdC2OL z-6Z!pBsNVjh&WtRvTeIvFtmTQxo`Gd$5QcTIrv;iekSyh=dcgGK=4yEZBf9;S8DrP zta^G-0BO=G_-AGplC1*Mpm|?%A^A3E@C$`*ty@bpq{$96bCo(jjH=gZy#jt#>-@+m z)R(d-RXt@WXwjj8Rx)VmTvyU8D`(!CrUP@^!>VnzZmE3Jr?VmWQPATp+w;3ysIkzK z*Zu7Jq*{Vbm+6yHWI}u9nG<|Wvh9#N*5f<>jc$`*uZF>8FS@FwIEen=q6A8s?{Pw< z^XZ!#a@&^CFadvp&C}BSg6H4{$pk71U~f6S$Et%1eROLO8j?vg#k93&s=bp3-xCsP|M`&3h<8W3Hc|yuT@$1b`lX3OqaAjMom#H*K)NAW$SOvA}YygOk`irn!H< z0td=o(=eYe9UyUCZ2!-(6gPtd`7ahYa&A=h3b$GGHiZL`_%0}L| ztX|(m`#^Q@`^GspgZ;?Vd_F!WKOdjLeiQw3P}hTBqDB3Kt_RPMW5$T&w>?e)d7ruG zHYDuzUc^i9gR_f<4I!HIB?CT(^EB1Qd3Kc`-ao4T$A8qv|0qM074?kJWZu1)3iHEa zS@F+l7X!1oF4I)mc_X(*`@ebjFd7IJg$zwTqbByO;;~tVbN}<#L?Q(ytaCe9m11V@ zpE!gNOt@d;K0aRto=GqFzy8$tXTeQ!yMWD6UL~8PYLr zlq?r3uBP>+hUvb>UaCL1aR`l*XcivG6^4DD$#Zk&?vGDyx=p8_a_P4)WSS)?V&HJ? zv5=}Es+^zAy6m-(8rH6uSFjE!=5!fp0m@OexK?R_6jBt1^v$-oc5)G`h~YWAk@|y6 zMbqLicq-n4=!{`bF2WotAf^;(k>ArRI15qixTJIbA6CodastVb=g{iEqR_A7a) z-QRpZs%%hMlS$f+Yxc`?og>6Nj5Yrk=AmAsnRt%*M%RsW7cyBgZxw_Y=PB6CFnQ0mT|2&rnYGNN&g^1{|J`ug05|pw&TdD*^}G z!)sa8qIc0j2t`dPIXCsIb!2RD?-^_BVzGrd%Pv9(Z~r5@mXIFj9`0u zv*WjsY(RhL?_fs2!;6F%(MB>%ju@K9pmHB}P)b2Z@bUBV^GKLfBO(=G;jl6U{PQ1a z_69h+M3hk>-(A!>C6dO(YhO#xO)!yVW07rtj!b6>#m|v1i)-VB=(ert35P{FTw3h^ zEq9(p9b%eqz@q~@R@9F-z>GhTGD$mb)w&ersynL!x-g%`$s))vHA^eA--!(b{*88i4B{jJ5uAU&H@7(H0pJ*8gjODlwQGjgn zKiS!TvJ3ypa{ZI-{3k0uqB(MWP~~WR7`7G|WSV3Dbumn~WL0|IkqmW90)|bB{DGSV z>N+Um%}SWjJ0aq=GbpUd!-D#j6H2bmpp72Hmt*TmK58DI3MD~?*Bb3fr_JVIW(bNP zrp~H(&`w}ce^SHXs=}Lr8png+1l@Wld`SB-KB8^q2_CMF&)R2B!B<_D%*_M6JF+8o zX&Q%z;~ytuwo(n@u8iPw;m}Of?0dE7SGm!@<(+?~I)axkAK)96`$;4qb&^}D*?;ADc0PK= zcwOLu^R05+^h9HQ6yOOyqHSeHCU~LA;~i#T$|EDV=HaAC}Gl|jK=)Ue|l zDo~z0z=b~h>OW5_5BXyIUQ@kPtv3``sn`{;1tyiRFWbShjKDtw((&zY)vOB|cB%sf z$`d>qplBiQs6Ze-`Kwe&eZw(cWu28)h%4p_H%1w0vQx(5+pL9$GfEzh=4<1*y4iwl z0#=%qg;Z1j{zC}uFqf!JY}E0dHeRseiWs(rd2>MGEw8pY6W-mI-yR|=Re~HVk;bHb z2c)#S<=b~B?)xow@{d9TpCs}vTS>e0GLmik-5}$2+XQ5X$d-b<*k_RkRkFieM#O(L z&yarSzz$0Q-H{gH4X1IN|=`0}eFyuQ=7 zY6;;@P@f>vYaO{QD5_nd3qDd`!ELHF4|_#9(Ncgj%vE2VKO^5_)_O3sKl5AJviD$w zV`X)`)z1V4K#&4AM}759y+D06ie;;W#u*ah0a$1-0M`B=){*;d`&|%$0JwQi!!t~I z1$GFu=I^FGe5CF&Z(tHG`(`{6oSMP?Z0s3rSpHYmHg5Y4U4~Hi-C79&JXO8Uwah!0 zY-anMONV=^4|rU%OLQw~{SqXNf`KbhpU6a6;Z^CqWB`jMUK8j>gJz zJ^olZQA8Vh)63fBuNRvh_xrYWgM~)`f{=%6BXHjNMoA)J z<;DfW?gSZ%M z8lEwrlaVTOpeg#M`Rxk-JB5aeF@nA}=lF_xr=Au9zjfMBr5UmP;bZFpCTfQbzl`qD zZl?Z$b&9`4S0hOfcP|{R{ET%U_z`?VQ8x(|3xlI2?K7#qyP|5{Jp?~e@x#ia>IVy2oAN;>E zNY=VvqO6rg7EA+bS}cBIyeSq&a?ba!Wt!=GF2NQ&|6GD+5|mIBSx9g*)SMc-RHwEs z!~fgOx!abH-*|ONxn}hi#^yy=1f4Nmw5SZKB{}RYrg8226l{?hc{m@^wWbwq-TNcv zK-*48|AP>e2|Cq|?(ynhNg?;F_i^gcl_c|{x>FZRFUUvSR*;ypY_EX4HUZMx;8`j; z0SQI@EQ{@)>A|6gv&kWN)n#D(1@?^9Job7ih<^t?&-CR_<_K?V1B)>iLU9GzpikV+ zXS`c;GZ}rO-LQXZL~v~(TLmHQJ|!7;t$gWa<%(bH2Es62mlB6)o4?)xC$X`_ZL5Vx zkidGy{1NY#{bL7vXZ{wEs0sVhpq#=tN}peXU}F+{RL+yP=|fVM^cP=Nu_U`E<6zdc zy&+8F&WZ$@L0=pu#aQ?R?L2CX#|G)&3TvTsL892{r5}?ejeliYLKxy+dNXR!W`p0d zQu6g|G<$`dfUx&@MuYa6S35Rp%?Dk>d)E@w)&&J`HS)}ST3N~D^Hju9LBG3AT7Em5 zPH}SVQ9|dnp@+12II(1i{x8?7guAcT+Z*?UBCWi%Pk&$D{M|lx+~PaaM5+CC687fE zOG8nO260GB1p(5vtpnSMeGFb`FPF4mK0^c|q!#vl(|Jhb4=N!Bios0hh} z@?Y+sH?tM^=oQs5ZhlT84{c71!W#3|bKx1rpT*7VCj}?>o9DWyQLa-uXcQ2|8-K*$ zDVanLNi9WR!`dZ*AzzS>?JT##lhRk)UQob|huqX+`Wv@0_~|Fv{)hbwS(6!xBWK`S zHcH|eV@Pl&R;Bc-<+jES>#I&CR1VAqGY^^&(REU%$Q1d%9XdD15Kw{ds=Ttu>Z7gc zsyws$*X5DT^QBK5%K<{zf;Hjldc67eYsK5+^Y^iy&TWfD`4An}hMV`l(v#l@MpNRR z5tde9KPvG;>2?yi(ysCzt;)GKb_Z2+b>s{{C3q{7>MJosvf|^|{9a(?hS0;+!u#GsG_NQOgzc}Nd)486BHkRaHVT&u{RrQ6uP;iB^{bs-U zYx{V6g(!otqU)#$nV!{LiBO2ePRl9WxDVevBqE{tvD#pzA>z?id^&a^@t;n- zCJ8IXpSOh5p${G}FL?4+YGyCe8%EO$*}BisdiftN({2{8j!p6ZY={?TA+_hy=G%p# zsRW0Vc$R3GM$;dEtCrunXJX@OfX`pg&+vV`IDqU6g{ogk7c4j%^C!5#xIcy!1QZst z1O_SS^%^Qi7_dJ+y*$RG4mr#cf}2f7R8%c#MS z(Gv*6c6R|?C=D*H0ak$txRD|11B7fXHHfB*_E>pNSOR1!o=OHe*20z9AI~f9Gf4Kt{8jRCB zIr__umCfr1R(yUff(ZfL^08sO55jFW0i?YR2)J4Qr}k$)L>A6ty+ChpP1ub*BGiBC z4w$>S8(>8+|0{Ns5y2EHw&;$|P_7ZN$!pa$?OO9)Q+FPVVSAGdfdkj7Vy3*+j85LC zgXk;Lo+XzQQnpHiXlb#=7P_j)S1kxxf?bJ2kd{r&AVsPFWxZ(W9vEqWv5b?_LOQSy z(%J_D4*Juy3HA8%8|V#CR&i3B7A4Az_8irH6b|aMv2n zBG-0{$bGU1w!%4!9PQ)~vGSL1X~K|>KXzDsml!mA#jl`6uo@M;@FD_p9mXw(KVy?) zC+Jn(kW#EQo9kR>PEI_7bg(fHh(I7{0pSz}hyoCcv49LzxWhJkatB7foak?mY4OXk zhhMbB=!S+X#V`t_u7_QIxb?W~t}hPIuqqN)IEBnZQBhPe*eN(HKs`NermZ*_az$_J zZuwGu5y3KS3dnhE%(fI!u528#G-t1Dw7TkXk;A00myWUsE{y(bad?ThZ9!~!gW2hoiK!ivTm0( zxFqSwdpL2Eqq^ks;zWL3hwuAO1Rdx5ip8xLo$5<=$&DiqPR4cu+IWj9BcTi@&<$LF zHqa{n%+7Yv4d|)_a0ICLbu!Jkx$P@crN#wc3Y`%Je=WucC&ru44BzVdaAPm(lYNer z(Kb+r)+RmyzaxWqN9zflg%R$6J0Gaqwd*^9=FgesrRa$wI28HxwR^*q3e#%hSWBTi zB!QqGiYOto9|{&e^wRQehECMna)N9h6d6reJxr5HcTEx6jH)&pV`DkmjNVLW2%}Xu z$1GC*5K{eUr?{5S^GHH_9~4OfYCjY;tiOg2jH9(-f_5JiPC{!x)EhK=q|0CRX0lsZ z0?##G(hVf&_d^jRX!k?m!c5|`Ct4CD==VWkJeyHqbV-t zHTH&9My{HC;<4RyJIA4pB-J!l1>mLLG?VL_dtH&!GaTFa=0Y!rlvih}Xifam&`GEm z05c*Ugo1tj`OM5cfp!q;9ZSQKONe^4XG906zzixpK!XZRdY}R}s4(IUDyWuMw>Kfg zV^0RtrHc_HFb+b!MX~5fQkSDEb;GtU=4N|i@m!0DfwYvn&enz{WcmmjRBC|&l@y;V z!GlVSUZ4^=sKoag>@cK#Jb`==iU!7_2WvDdEFo$D3P+Z$DpMsj3A$$e7kxJt72m28 z>E^gpJy+P3`H&bll5K5M$?;TT=YuzB!hAqO!JoPY|MY89H?zv%qZUmki@#jYN zxlvOOOW+-XqKBQ#<2eeM&X>D z2O)%mAbd0(log(^;ucg+M(UIJShW_ZH2KZq^7c1X5C)vsTg>Pne(HDV?s6Z=PBSCl zZwiyT_xpTUkA(HhAw>b7-QxSHQ3*Ptp!4a&TTFCc;D!ZmMBv5*Zc^Z89YZdRhXWmW z(18N(7|2^pnR|DL9QW>y@S1N1Am0Ev$IIA|NjwXYx4&f)7o(I54bI8L#kvt@p;hoR zP%=X5`T3C~SUyV1D0_N57yw)VI010Q%qD}T5f|fB2o3Je!NuZ{WT738vzpY{2H;&D zC?O3>q<{nuNVtK-9Y`S2Ld3Is&(oD3kVNiP`@A=pK!#G6 z=7Yw?NnSLf4CQ&04Iqz()_Si^d;nS)`@1&Ht};T*Cz3T`N+sq0Y8`r*<~ zq0*c!7iRu9`H0I%eG?sKo*CSqS{eMeUcvU1dmLxt#-os6cAX0Q8mI|I${`NHVg&2o zeE+~gPps7MUm{fgjBo&YAp(#QHOL`>T=@@><9^NsfZTB;k|yN%8A0AZvp~R5{#pcq+w=hty$Yu8e(47N@gOKD`OjfFHxX*Wfdoj zr&p9S_(IcI1$s8@9EdG7;QbA}bMe620KCh<8_fi~UU+(aH5;W!3A@EFz*&tUAnN-I zM2$g$gRNcVCJ7|QK_buOd&xM*tNnVHO{C{;_Qf@=U(|^AQya<$Tnunmz7c^b zLIvayk6c3RPf|SetO*WkIZRvS{rZFYQT?%9WGOTOVv;c^nnRWVECSF4K(Zooh*mx! zHoPnkePudG2!aIUR3BpbNe#VD`z> zf#t2rgdnCjfl%nlLir|G zRlhRR?S|q_@QgMP9YCmR01*UvMk+wb=VB>6SV&@HGG!YHpWJ=|A{B_>XAuVk{<8=N zqOgC|-Guvk0XI7l%L$F z4a)luG-o5m3`pQnvPJU$`hu_EKcJO^7z6(a&m{G1X+Kr>oJui(;5)jNh#29yJJj$3PR%sJ<<3wr8LFS}|MFz)|uHAjfQUjDbX3H~k zXMsamek}$Ud`#T;Z$~*$QbzyFZRQv@F?K92&e)u@(cz5 zhy@86kWd1N607o!`Q5jW!{*u!lTu}W?a>BM<145ETh(F0XyP-R`U@tdAqhm-3BWVq zm!6uce%o!UD-N7a&0|hJk8K;5>t8GT$4OmtYito!U8ant0izxx$U>zh;gj)1f@h5m z_g`!PyB|T$;7JF7AB4Vu&=m-sfzVM^R|I5F>M)+`=gOBy)x#&K44zEjdk=ixzz2J9 zoP;sI#>Q0LWolyV%uU1oF8wIv>VB>$bxq`Jg0EK4a^k*D-0dWLi z3xGbb6agUe2$o`T7(`M)q}F{rSx3+o%=XX(%xoCUEEViAH`rqbu*W-KW)om$WpsUI zJ1zhm0k8qUC`gn(ug@q*WPpSqNO*2tUqJ4k$-icOU*Ed82lc-v9&vBib|^5gw^rPk z7P>v<#@&#pOSzmV2NOhJj))$li)W-ocls!d_int2^`nuKapcGKL6WGtIAJp7A)jJn zQvmt_@QD-dEnqAoiWMfCp!E@TP=*QeC{#y8r%}RtSDDA(uaTt$6SVjf5q(z&JHj#*zJwAUO{rDKtJtP>w2&Y$B9iG~Px~imwM==fOq8OQXHRNF@76$t)Hrtrtv^ z)Q&04>NVh9OqF0g4c<=s&!~Fj#ecK+b59w=o3{P$cvL$fd+WEk^qyj($D=3bi@PG6 zp~*kWJLQ&oC^X?O8BYmcE!NW;)%3o=!HamwIR5sP)}|m#{m1W!c2Uq+tJ4ak0Ehq( zjA*yf7?}$pdZm>k0aM=}1q{@9t7Mw2?P7yU-!+F)0N@9}2LOEI?;%=)FL2=FUNTnF zf`kf8ee-*#gfAFk+ZItof=onnYiGRCM1rTq-}pRq^eek|wkU!43WOgu5OK79Wx83Q zcR>q!&6QmettN81HFaJPy!A8u1ns9|?*t-GEnSBcKmDg;1+|8!i#-FE>*kN(PDEz{ zga;6o=0KDKQDo(EZU1c`3^EGVJ=14j^wnTJo~6g@QcFQnmMDo2GWr_J`H1=05Ue_mOeMRAd^_jxsD&Z zz!v(qIo)!;TmEZ^zdhkE9_tOgWngK@2bK&_)(2$XT3C{o3ODE*3f+7jlYVOvFiJRy zoN<#+BV5`~mdfArb**tYRK8+WZ?l2(rP$LJYXTIo-c7fQuZsgi`AohRI{d!M>z} zIX65nLI~J7HUO5N!SfUX}T4qm_9{qw@flbxsN-+wUcmMneaNYv4mr8-TUz>(sfT7pbnr=;vX>RtCS zm6~>?tnDuyha^nhJE&61VyoLu zs9H!FZH*yZ$QZdgGKq4Vy}FS9#+2*mBY9OZu2e24x<1FH3{I9vz)x+G6)`+ zwL@bJQ=Gc_BO@+)bNPc{(8OEi^XLOa_wx$R(uDrgUzDl4p*7K1+p@m3wTC5QnMGHO zq6zyaE4Q;;vrrq_8`JBnh2KrBS|jYbdaXB?&TfSoe9klFT!^s|y{mpy%SCfpuAPyr z&5qf}VQ%DN7=BL>vz%YB?(BryKJ5Nya3d9X~A6yG4x;(zc+;8Sr&=h5O~ewem5aj-AaMn`jFHEp*UgjA!O@6(R^L7 zUG=!xdlJ7ZO1W6IcEc^5KQ%AGdnVUY7ZadT5WcrN+%MY*QU2!NK%67gP)~Ga+Lkat z`0Jhqondv-iZab7pReB^R=` zc^eB29zQOs^nQ-gBoh7%vAx%GV@Xe!EQ`p2-6p?@aKv%rPds^F5EgEO`VaxRyGjZE zJtGd^wS__o59y{zEU&bM{#&Xxc5NQdV^U2+K2;pzUu(=E=^ZNk&7!qe@-(=GGLmrqmN`DN!@fd-jQ zBy^i-yAa=ncd=Ea6&Yy{D4YCnU(Yvr;kiE6f9hmFw}Hgi!TN5DCYt|}*s`_9`}NkO zQuZt{`^Rsom^7b8;SH~0qfq>Sv{!#Gz$T58EKbyb>4P4t^~bnzjNO9hvfuA*LwWk{ zhl!uA^)igbF>eTx7}>*;9qwM-qY`X(n&iFtoPD@P*--w8(dwTFu}#z)&CO1i=YhvH zPDn%fXU2V_#xZWo{m3_btDRJTv+m;@XMYGe2o}Uue)A&{gV68^tqTRFvOj+PQ+~I1 z-OSF}D;Pq&TJ^DGXSreAH_*&SE1o4$w)00;o*fiJ8C(mxJzW=y~ zb^CU5PXxe+t6pS?Aqd(&@CrhhKEqXvuESo_D;&Gu&78QK!vuZ97HT(*@*d@D3m=tI zl-aMkekmA&>2WxgJd@9pyL3B3V(CuxZTW{^y-3ja?X)MzxT2$d2_D+&cPO`w*zeH#*pbJs@7C82!#~|$Y ziAIisz;CGhV>UH@mvOfPH8p}_p`DwW*oO*T13Dc%*SFtw1^C+HXI1wTW}(_d5j;y4 zZfd&A4cfY~uPGFcExSg_D6p~aC~Di8qP%reTs#?Aa%Y(;pgn^y@8>JeEQ64GJcAgH zrE*qhYSVP3La8pLth^w)WYBFc`}Z0K9N=o++@qWC&)9b9CO@X%SvOnUh8)zL6z4RY`k)3X&EQ8(=jx!b~8wf_)0;@}DQtS`Mb(knt!=2RF5c%E6ULRb|FUaD$A9KUa>)P51>Hq1dA~Azxw>VQ}X%}j{z8bT1pm)}Dd|5tC{0oByjZX2@c zRYgDuO^WoQsB{7NtJ z-*fJL?~Qx!8_$ukve&ofoL^aA!ZIO*?^4OB?J(cCg=m*=Nyyt3J7LRsU)Rxb;|B8GG#tiHKko9A~#KQdPd9f{V! zSK5A3d^ET|u0A-PPaWkY#O8dYmGD*VY}C025i38t)^4s&fH^;yzrXZHm(06*&U4W` zipA6ted#w=u6s+PmhFON3cYOD7u+L5D_z9Bc?#IbAf5mj@0|G}f2NmPCbt5yPjIFr z;(&KA&btU#oqurbA$){NK3~XQgkkyGvFats<-zYfgGm;zLU^Ox7zMR`p;Qhq5s!TJ;wEs2=&eURFa@yhRmG}1Ck7ugfIUR?Qa(J zhJ1cB3F>(A{aM$QLiwuj93LJNR$0R{);`^-z15T~Aj7(kE5mL7-mj0%KNCLf_~FdD z%KasJT=|Yl13ux^P!-jzXhxi!?OAmKJ;oQ3w#E;nEHZohaUQ8p#+E2zSAY9bx}(y@ zxgMYT$9eXTM3S17jZdb!r8}};tM7DgPRN4cy)c{z!wE1v>Qed~0{6Z5cx71zxb~Ru z?Z;+CV@oQf%EbI=9&VZM33g>GouG0+oS1Xux!jAs@qx*cD(OmfiTUd3-C6MOG!DSB zLWL`zza1=2l@BU}+M8(@8WIe(>7IbcG}IU7ikhJR<(H~s@}bKp5&MCfRZ)3`1p zmGZ`~>7MS7%W$kIWA(kY(R5F;GQKTWPCgZZxxD%oSHXMzkMmQ+m6T_H#KI<*J&~?l=6kQdKB?s8YG3VM%!iEUOb5oY zKK+f!F$yzx+hGm+q5jn8&N4;t%L_pywH(q5*_Ab>-UBUl3(evrvAfYM&O^r1TasKK zbZU!pbyn`uE@=@Ch0hqxOyZsv78EBRw48lX)EOYbP;^8u*g@I2>&fC9wXQETE;swz zKTXg%ww!Q9TlPwOW^I{bJam&$T_<&|9Li=Wt(b)>K1m?(@?UVU7sl(j{=y%H@#&l} zKJ74cB;@DC6^5@?PngG^2XK1N6CJn%TFWK3yFP5>_>ybveqrVaL5#Os%RN_}s|U&_ zat{%i^{l_%M zz|p{B8NcPo5xW`Dd*cmhGWz^NefC?@n0S$2-Jlacpp}O8ld+YUV%F0At&Ck5kg>2p)?{pCKy@rd-T91T!`kiBk_!whuyvnr|8v<+ z=tt+Drt0UiC*cokxVbuKeyb@B`If|5ntQf%I408nv^vZ?Gmtm+Kw^d=!mh5{ef6-alb1Oe$|KBHg4a8LEs&6?`Qf>V{Lsv;l53;i5$lAXWf>H zaqnhk;?rMTmnD<(^K$l)gve6QXKXM6Ar3 zcNM7MFIOwP{@l*fzx9Rx3yYx@;<;ul}%6RG|+TCt~;QEqm z<~y3(z0awBOwTzUcf}4i5*q`2&SyQiO5rM?b9qJN-Nh~GP{O?mOVmW-SW)o=_JVj{ z`EHPW-Fodtgiyn&4!q)eUlt*&8(-XwUt9z)H`@-=mD%U|i*}ut-9_nKQrdZJw@t_S zrM!ZSh;HB(p%Dq58>1Nd43LZ4>t=!-Vecyv)vS`NX@|#J8`4 z-$)y=*X4DNDfEGQwgS~ZPE(33aE9q&U7iN*^DO!(>8X1Gd%XMpHerZhN+d4V-h9uz z_V%Uk1*Jj#aR;&vrY<54SSP#Pbd9X1!H^bY8NqQ zLN{I8iM9T*!Zk~Q7pq$rT}#;R8qp7a0#9%fRbe}|#$m|_=#mNpf8$R(O&sO2*)eZ%5cZZb=L#C=Y~F>V!ZW(N5;=HXfSlJHHSV(OvYr1 zF#0WDp?tAoQTXh`65jxgj0+b7R8JFiykYrN=e==TwBKIF!j4my=z zeyk~a+PN+GBtb*P(M=_#-bK*3%F#z9nW2C3;^h@zm7;j854Xzfv7~yoH{4$K;l2uc zF9r-J9SNPz3W%@4&S6ailf;G%hfU$@qx!PT)FgO~iAJ}rtUe@cs7-*^T_p3!=pIG{clMUZuuZyQp1 zeB!Ax-!vibQszXDgc>6VPra6P)2aYS?j{ z%LaUszJ7y2T+sf8U1x>Sy;D33i>G<+#TXs`#I);yO&Xw2?>hGA!y3ITvKw|*i$2Q+TBybZaV(NY8y#qHI7=Oa>UwiYdS0XMbPGt5rX~h zIcrrVOv-?@<+tNp5JxPa08?~-4C7@u|N z8Df0VzxBPebYB+rGI%-qbJZy8Ez;;9iI{$Q^^;*$T(iz}R;2Kifq~FD$vFEQ9idm_ zG&|>nmSmn*Gz%2DiX!8ZCFlF@2e+8}ZP}$(IEySM{rvbng~bMrP4BGXZJqPqZ}45% z=us}+a`;(f8n)}sM{0h&i4`2#O}HyX#K+{O(grIEW6^H*a}n+6lDdm>MM*E(6j_gTQ- zm^U&)_a^W4a_071^>wBOV|_Go0eNPVOVz2zPO&@Jt~~bKIBB7fq;yAF?vDRlT2qis zzwgAx6+9t#3k-a_G#bA2h&HG`j5Vajq4wzeWU<1S$~DL1)CAEN_!+6FA9SRfef^ z%9Q0?FUptQvh}XD=c&Vk?-any^t=cK_l&SH!t!Ltb<&~n%a_uz+=JLoLPn+(w=`7B zL})UiU^{lJKt_Ox+4m!6!?Y)lkx==@^y4M(V}VlDJ$9)@yQ@%4tLB0}(La-!8wA1+ZAc9l+zU65;=1Pg1PwE7U1M#^y857&NN&|hB=(mXn5ZUnA69kPB>TF9;4+#Zf! z_c_$j9Fa3788aKbp{t}~goWP_8B3wL3(oJ)dUs+eRD4C;-`ClZxBkB36~OSbxMytd z_kyQSKQ~mBw(1%;kByx4)RJ^E#(v9fNlw{p7<>0xXeBmjn~z6+<^fN1^wn3&PY#sG zm2p%?j?U_x5pS3v=M$S0*Vt#VUqgQ&Psq84nKCxqbTv#ZXrUa(O(vj)HN3UsqYwpZ z2>9+aR|hE>M(#vx5U1F@MtXbHcUXIt4Qr^>aoOi1u=hfoYpcD76W>1-y?}CInkx`` zSQ?d(Z{e$W);BUSKQ2Mm!dK?3Z)l=yTtb(HukzW#+WJy~aY-@n_yomweTQu!)CDxL z$Ew7AA7mL*JAPoywbgg4>=wZGE^HFKk}Mm)wRFnslC9qM+zk%-7I8~;;Sj~IyQ2%0 zN%5L?NyMh>XEd9ec(biyzZ%Nh&qZn-<`YsUFUY$FDqy}XO!dsSJiYs{L4QZ`fy=&2 z+LF(u#%s!3x39Y*rNMF$)b1Knri4=6ba5F+K|iH zqVP7|1gA6)u2;$lUWPx_UY`k(*D|_`mWg?JfMSB@tRU@ol{oE#kNlmb*R(_pZAM~E zo>zS2hhb;gbbOio<>U$4ofTJKjJC3eOM9Hsj>~!)Y9?(0<~NQ=usY}Ygx1W8FXR?9 zj4*= z8^k)B<*0A9B34lyo6My6$iar6y(R+-(UVSHB64@!>K9)4MAjsU57;a#MEZ*_H`RaLeoeo4q<5~AeM zx^DC}?<{-b^`Dxr4<1z#;}_R@6{aRSDyH=+SWWZ=e7B@3YPi%wYjpP(m1&IjL8W)M zOr8&^vA~sLdad-_$cwvVWceUGi%#cF6!sB+@an{Ad!=grclV{f$)5#9$F=Grj6^iF zRT8vCj8>kRd}Yxt3p@wU4l127S{eRuY`_?{YWTx|dS^8ld-s+mj1Dk;o;G&+^_kd* z0W&;GR~_s?Cim!<7dPjQXv-QDMYVBj7Yom)nLJMmVR{Ac88^IV9GeEBhAkC{0%aLd z`MWZ_h2SH9fkff!L$Hz>z;m|xv4C&R(6H($58HO{14n{&HQhKW$`cRdP!Lt=<_B+n z_)qF;Y>n*PV`S&Xk03ku6xq(8dyfw6?VKU9b7w8)s-7KJ&n>#R-9v$4n$6jr$&*RR z?@0l7%HCr}+Y-OD9Ts@#A(-nyeOJ)xtT@-H%V*6FG%V`Cq8Va$t>luk1-yn`isHJ% ztEaX1jB`O-I4ZZ=f6ezmym~+Tyf0GRcoUb!rI57Le^NW&py+NJLqhh8j}dK>XPayD z`FoB9SF@dn<=k9(&b&)qs;#@+*W(DSA;Wum;X}n#wd52l`xCHtt>_fwplaFb2 zS5Bja=ngmypHZt~NEXoQuBJhU9qzdBor1h16pv~`%TW!{2ajT-NOJ3=-=arVqPFEG zM(;$ADo3r$b&hI9k19p2$bF4>p{w=g?00pnjpeHK+;>~tKLE_jzQ!B5=IcJJsA*aj zH_BA)I__Pyn^Z#OD;QBpDckDc>c%%>Gu71AAE2ab7)Wfc#hE#{0lD!x^Cg>4`>Mr? z=gizJH+~p5T%EF+G&o5yisiu5R}|78!$dh1juthb+-688~`E(35srx0^k>MhHu#CuM)%BPp2CdstEI++2Kf9U1 za^VS?D3r90mS=h*Fl6-XrXcH2(+kgDv8O?!>u3e0vq9o4Kd-^a^j}Ev4Yd5eCp!T; z;h$s8uVd`PA6^Tlg*;&^(~;6*lk2m0!#}5(Ubm;rgi1Hi3gCeqqi1Ue=(3 z!hd->(rfh0lbJ3n>6c8=Z<+t=6odn5`2+pD$mIIdFQ;Z-?q%~)Z!gpT$~5@Y#iD}h zn~@E+LK&p^PtiF7xS&_?fkR5b+mFYYENWr*!O2`j%l=F5iYn(=*TI*Dk{9cQAugMQ zhOZL!w&g72dAj%9diu{4I%?nQTNHe5x&G6z$#siCHXvnmrT5~dQth~G{E}}}gL8ic zKB$&roD&)xteBLSEKdqq{i!c@TDJ??I1~9Yc0K(K^Mwo19#N}=eLo=cLAtGC@i%9JX-hr8< zMM(q+j#uDG(aZ_3L7xmUe8IqiN{uzJ3w_aH-)0J!=sOV(Gg2mp@SKnx%d$3JXCsFA zE0N~PJ= z_ZX6H3Oynu1T2*ZL89B}T#z>?Xu7Ed7f&CIPobZyoeTspLzL5cPWx0U7}}oo@!k){ zywoXFlOvPW$}r3kDIc|A5LDG?Fh5Px5)X75pjTIek1Jt^COVeastNc^D^ikEKs9qF{VI_SNDuodjjAgt!f!cC)k?2XLUfV%@{;MhN^9;Jp}RP zy9eb#jLg)C!ogd|l_K_h@gYY1p7Go*#1{nnI)eE6L4zQ}_KdIg1Vpu}KhPqsO7@H& z5F^+up$dHFn(@N0vOQHeu;S93P)SLye!zz^Tcg1K5XN%%a_A^~_s}*QhO@bXva7s% z$cOS|0r{=l6*BK(FXb9v477tupWtr+MX%=6y}x|`eswVXIJ!9)1;F@mHhLxCL;_BF ziN4(+sIo%F;Pe&+(2RPp$A+zt91(p;XAcAuR2c*-5DX2x(n75Sz{&sJ*lvJ^v9Npv z<-d`?jBxUZFeFVx^D6vZ@G?Vp>n4K_O`FhJ zTSpg10AtCacG?EheLjtR%Iw4;ZJL&x8%RNL9Z00*Z`3$KZmI@{!1xt9%FiJj^-_nr zDQ^gu+t^?-pY7ZVxf!ehv(w1;tYip68%C$WZ>rf~()K5+0KDK|)68f8LXp9$HlYaS z592TD|52}-@}%%ToaAa$F5H#x4fa9zR;V+i^^XPlh4Gi`@{a!A=M%!$0rr0Vh|BS+$!l{km z$OS&jRsRZg@BNb7%0thKso98!t1rWMWG)KhPeZ`L}_rcAZudJ+w}%@b3Y- zLjkx;)Z~taPfEQMQdV0UfN^<*_TWev1I?g~+!MkvZu3mjol8tz`@-p;* z65y01E`@d7h@`-YmV{mupQ2tIVx?24QY@%JM@g_+l2=Hudi*&+Zj^v47sZCJ`D@f!wRq5`g;p;fT< z*|*Y2C@!upCSrtyz<|w#(MIBYZ9Eeb590=w5ORm+Gj8d&2F^@!yU4AzD>1Sx+j7-& z{CSQTTcB0p6cZyWBtiomQ7lP8t81d*k)n2;4lZoRL1DPEzsB?EzMx8omZx=|&Bd{N zh;K)>fOsovX>e#AE)y6E$2&<_HVy9R7d=74aPjisu-lOarj}D=2miPDN`U$rZW{x_zsKk*fg$|8b|L+}X(I z%7qWW+qL^#%Z0px6v+qoJwfUo@)&Su^H>dOg6wI5OGnhPPW} zZFEj=L`1Fk;-Yg3laM}7Y6=sN3Sn#u->l;6x4UIW1e;UKm9xs>pL|(tB{{7Syo2v7 zS8d0iOTjy6Q8?95uZ}a76@dQY-_NS!~D?*(?R}MCM0U+le$wCmq}?{~Dlk^ne=(KMaMGxqP$y$b#hq zhQX<^c__JyU#MyJbLymXFT8A(>Jsw8D|8z(m$&}6BKi#~H}z;aDhU}{#412<^t z{_~cfd!q&2)MO^b^9;^TB;0l za*~7IIRqz#1orVuE-5@hmpzBHp}54X4-7qs*#6>fZ5D&ymU@gYx|Q4o)+KkbjFpgd zCQ4M;AHj$|OZSO5So5w9tjQ4U=dKF`2XUa_tSMDX3)9IAAX-Mi6r3$dVpy9{SiE++ zw6LkTM-|Hu?C$>5^TV?NOS=#U4iv7|@&^h|<~V99gA7i^9@S1D{+8gJ#rX^@%`l*_ z%g0dzm`r`jNlyy-oWJgre$A97*Xk+){`BmOs3gJSt3MzXM&L4}#spx%rlKA=-w#eF zTlS*Q=y!zO+RI|#dU6z`lW~?e(M6M6my!ivWn^C(P*r|5QNo?&V$C!ppF<^<+%@Xm zG@DC1xwiBa?{_0?D_H`mKpvcTV<8&ZOj=|!MS_E(4#HW;8^ASqL$>7CWREV38qAT` zQ3XrkyR#@Fr@&BOYPGxu44BwQ25&Y$IUFnFK2_`_l^iU=jqH{eqFYA>>rPUprCtHx z-C|@wcIy~It3biDQFKeQJy}!Z2|EhJ^Ff5BhtNdGrY2*Mec(qU!qfC~KqKrm(v~r!h-5IDH4@MMr=^$!=BU5#_M3Q%sML4;OVyxs=9KI+x+04Mr znuq>7)W-}6V9ff_Lu;w%imqkC2@2G<2r8N2E=LjU2Qp?r510WT;pjl>C2fjda_oPX zLx=xE?#K~1l=ID~%^+Q}irI5yNNq&m7WhjM1xGJ}YSD*oG6VMKqt>wN>=j}xsGSNc zR8XxV;9Rw%@I9w$=h%0tsvV{8%~d-IcuCaA%%a9hpCz$Tt260sIa{5d`&vGqg>$wf zs%^uY)yFBDBo+>@@Q|51XO{s`Bnuz`p8%3%gDtR2xPkHB=)lIIRw zrnG^@u7juI(d9S~)GgLAsn8kC(>M;fzFRfF+eHuVyk{nr@EaViL-G+5kVi5L7nlT*BxA-(R1QA+-+OuMOq|_5 zw~0q~VAFVU1BtdA_dg44uO6qd;D0~i-77@8d=gG(XSrHMsSNZhz;4a=4_6P9w#KkL zP6NtZM0`ZYzA_S#El4hgwaeZ$krlFcjb)v*cYVm3VQq3=D^k`T+>e@-SA)-benv6y z@i~PBIqWsrX!ak~ibR=zIxLU2VTphbdFQ#{bDyd2`xie?Uw{vWOvu4d4Z$+T!n6xv zT<7`Q_)w;?T2UzT^L#KX@h-v=n#)u{j*}dF$H{{T>-_KIBugZGoIDRoAi9MJZ4IHZ z&?~;V^im!5E^1F#1387VBQ*PN!}I*`Su*hfqAQEAhGABLTC+bn!#8!ntu@&4I4|43 zFIh3G@bRKZECxPabOwgNEKfUL*h4?&{gqJe;JsA_Kgb6I1Vc|T0Nc?5o~7yI?2;TY zkxgoUANNHv_(>{E6;cNiFv?tHF5rs{e$;|9RD1}Cf^eL`f$KbqDJeYV#et-SWtWv5 zANO4kZ~P8vm^8647TMcd-9PL~8hlZ_oq<;rAWdd)?i}u4*my2^kL^5TNoM4TdLke- z^W4X9ydu)C>(e8*A;f?lN&w*hll?i!r$Y`LKq^gNT5VuxA>9%cM8p8>WC~C;C!qY0 z9XN{wBdJGvGbq1T5w&KdF8>}c=fc;hwR!4byyajNayj0eMm0pK%myEk z(lYo+RYfK-Q7C|iFAJM9pyXBs}pa)EupE#^SdidYl$S7^0wl9 zE01-pCCd&>xJOKrH49f+OWe8yE^NF#fQ6C1JTU1alb`$fPGg)Q&&0%=G-UFfs#&NT;u^~wtbcC}k@RaxddsH_tA*$Vj{81JdfTQ1 zPb|1$X#t3oRJ=G)uIRh5Oq!@B^u{~$FzM@qYx{7^jk}+=KUr@OW*16pySQ<_0n^Lj zwUgYbz5#Ds!#~%4dHwD46FHV{Q|643pEpKK%yq0R=8w9HzRo(LH~z8X%j*PqIkDBq z?2P}pWZLU*@4DM2Yr`LjbQMj45rQAuS-x{KXI$>NQKraJ4~y{iz#_alR=#sbT|vrOmtqo&PIX=xG5H49ht>kF55f|? z`YJnS?U5Wy9>Rm`^LzQV*i~ilFCtREz4ia8Zj|B9wTtC%Z%fJ3;apkEhQtF(EjHag zEOlHPj%=*zdIEoa@U~UQjM%UG)9q~lQvc!~kTf4~4XKK>?7hLzy~^TvS<6(!1ANUl zXWlQ>TpD($u7YmE3h)-LJHOz>`2`Fw7uMQwr{3s0dN1`QqnKN#u5FbEJ`>)yvXL*^z;^f z7l2|F$qwd!J8opWdWWK{Y=|-@0Fo-F!OX^ILYm%xpYO{i%bd zcYj(udd5Y5TuNV`w#Q{!Nxa0NLX+XJjsT{>@!EB+E7eCC-5B6+pK87(FSz>scrQg2Rt(EbP z9$9|Jkm#V#RPWU9cu#lgFw9&wvzBu>an)Kjl#qXgTB79hev>+CLHWlMju(#B*M-Tf zTMntnJ~B#l+A3qp6u&u47!O^MD=T@EZP=VNmSB3{wT+K?QM0W7Gu4waLiw4894X@- zM*FL#6Fw~OcSR*wO)oCK-XY(sI&{GtV9dX*4GaS`hb~=iB42ljF1l=*g1Q=w1_d??f*)Sv$}y!RNd5k^?h-u0qB zz=FA&J^-X2K%uaK|72W(cnkn_v~uAd*xvwP;W8>a`_q9Eg(|}Q6Raai79YZV5OS6z zqkz5|0Q)d6!wh@5}?C|01NO`@fTYco^U;w+rM@VCh~Kk zQ0#xEfNE0x1&cQXSh-HIUf!04Vc9(YggI#bf~9JbQ9?t8z&n zvPbt9_OKDa%2}mV>~H|Cb>qH&O7?j`!!QD}Hv(8V^};8+EdUgXkM5r^LEm4n_b?38 z{%~IYAq=~~@K4w$XvhfAK;H`fg;p_!(YYe8u9d^SwcwOt!XN)mK~Ba1FK15Oy!Y56 z6e`G+5_Ry8WfV$05_)3{r~;=1fW18+GXbOlq7VSZ2muEnEfYW#@Rb6f{YL=~DB1)# z4){y|o(& 3.0 (higher for higher-order wave kinemetics); the ">" designation is accounted for by checking if ( Omega > OmegaCutOff ). REAL(SiKi) :: Omega ! Wave frequency (rad/s) !UNUSED: !REAL(SiKi) :: OmegaCutOff ! Cut-off frequency or upper frequency limit of the wave spectrum beyond which the wave spectrum is zeroed (rad/s) - REAL(SiKi) :: PCurrVxiPz0 ! Partial derivative of CurrVxi with respect to zi at zi = 0 (1/s ) - REAL(SiKi) :: PCurrVyiPz0 ! Partial derivative of CurrVyi with respect to zi at zi = 0 (1/s ) +!UNUSED: ! REAL(SiKi) :: PCurrVxiPz0 ! Partial derivative of CurrVxi with respect to zi at zi = 0 (1/s ) +!UNUSED: ! REAL(SiKi) :: PCurrVyiPz0 ! Partial derivative of CurrVyi with respect to zi at zi = 0 (1/s ) !REAL(SiKi), ALLOCATABLE :: PWaveAcc0HxiPz0(:,:) ! Partial derivative of WaveAcc0Hxi(:) with respect to zi at zi = 0 (1/s^2) !REAL(SiKi), ALLOCATABLE :: PWaveAcc0HyiPz0(:,:) ! Partial derivative of WaveAcc0Hyi(:) with respect to zi at zi = 0 (1/s^2) !REAL(SiKi), ALLOCATABLE :: PWaveAcc0VPz0 (:,:) ! Partial derivative of WaveAcc0V (:) with respect to zi at zi = 0 (1/s^2) diff --git a/modules/openfoam/src/OpenFOAM.f90 b/modules/openfoam/src/OpenFOAM.f90 index 2e004a541f..807f2644ba 100644 --- a/modules/openfoam/src/OpenFOAM.f90 +++ b/modules/openfoam/src/OpenFOAM.f90 @@ -59,9 +59,7 @@ SUBROUTINE Init_OpFM( InitInp, p_FAST, AirDens, u_AD14, u_AD, initOut_AD, y_AD, CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: NMappings ! number of blades INTEGER(IntKi) :: k ! blade loop counter - INTEGER(IntKi) :: j ! node counter INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None @@ -457,7 +455,6 @@ SUBROUTINE SetOpFMForces(p_FAST, p_AD14, u_AD14, y_AD14, u_AD, y_AD, y_ED, OpFM, ! Local variables: - REAL(ReKi ) :: factor ! scaling factor to get normalized forces for OpenFOAM REAL(ReKi) :: dRforceNodes ! Uniform distance between two consecutive blade force nodes REAL(ReKi) :: dHforceNodes ! Uniform distance between two consecutive tower force nodes @@ -1018,7 +1015,7 @@ SUBROUTINE CalcForceActuatorPositionsBlade(InitIn_OpFM, p_OpFM, structPositions, !Local variables INTEGER(IntKi) :: nStructNodes ! Number of velocity nodes REAL(ReKi), DIMENSION(:), ALLOCATABLE :: rStructNodes ! Distance of velocity nodes from the first node - Used as a parameter for curve fitting - INTEGER(IntKI) :: i,j,k ! Loop variables + INTEGER(IntKI) :: i ! Loop variables INTEGER(IntKI) :: jLower ! Index of the struct node just smaller than the force node REAL(ReKi) :: rInterp ! The location of this force node in (0,1) co-ordinates between the jLower and jLower+1 nodes @@ -1049,25 +1046,33 @@ SUBROUTINE CalcForceActuatorPositionsBlade(InitIn_OpFM, p_OpFM, structPositions, END SUBROUTINE CalcForceActuatorPositionsBlade !---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE CalcForceActuatorPositionsTower(InitIn_OpFM, p_OpFM, structPositions, forceNodePositions, ErrStat2, ErrMsg2) +SUBROUTINE CalcForceActuatorPositionsTower(InitIn_OpFM, p_OpFM, structPositions, forceNodePositions, ErrStat, ErrMsg) TYPE(OpFM_InitInputType), INTENT(IN ) :: InitIn_OpFM ! data for the OpenFOAM integration module TYPE(OpFM_ParameterType), INTENT(IN ) :: p_OpFM ! data for the OpenFOAM integration module REAL(ReKi), POINTER :: structPositions(:,:) ! structural model positions REAL(ReKi), INTENT(INOUT) :: forceNodePositions(:,:) ! Array to store the newly created positions - INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation - CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None + INTEGER(IntKi) , intent(out) :: ErrStat ! temporary Error status of the operation + CHARACTER(ErrMsgLen) , intent(out) :: ErrMsg ! temporary Error message if ErrStat /= ErrID_None !Local variables INTEGER(IntKi) :: nStructNodes ! Number of velocity nodes REAL(ReKi), DIMENSION(:), ALLOCATABLE :: hStructNodes ! Distance of velocity nodes from the first node - Used as a parameter for curve fitting - INTEGER(IntKI) :: i,j,k ! Loop variables + INTEGER(IntKI) :: i ! Loop variables INTEGER(IntKI) :: jLower ! Index of the struct node just smaller than the force node REAL(ReKi) :: hInterp ! The location of this force node in (0,1) co-ordinates between the jLower and jLower+1 nodes nStructNodes = SIZE(structPositions,2) - ALLOCATE(hStructNodes(nStructNodes), STAT=ErrStat2) + ALLOCATE(hStructNodes(nStructNodes), STAT=ErrStat) + IF (ErrStat /= 0) then + ErrStat=ErrID_Fatal + ErrMsg = "error allocating hStructNodes" + return + ELSE + ErrStat = ErrID_None + ErrMsg = "" + END IF ! Store the distance of the structural model nodes from the root into an array hStructNodes(1) = 0.0 ! First node @@ -1103,9 +1108,10 @@ SUBROUTINE OpFM_CreateActForceBladeTowerNodes(p_OpFM, ErrStat, ErrMsg) REAL(ReKi) :: dRforceNodes ! Uniform distance between two consecutive force nodes INTEGER(IntKI) :: i ! Loop variables INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation - CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None - + ErrStat = ErrID_None + ErrMsg = "" + ! Line2 to Line2 mapping expects the destination mesh to be smaller than the source mesh for deformation mapping and larger than the source mesh for load mapping. This forces me to create nodes at the very ends of the blade. !Do the blade first @@ -1142,14 +1148,15 @@ SUBROUTINE OpFM_InterpolateForceNodesChord(InitOut_AD, p_OpFM, u_OpFM, ErrStat, CHARACTER(ErrMsgLen) :: ErrMsg ! temporary Error message if ErrStat /= ErrID_None !Local variables - INTEGER(IntKI) :: i,j,k,node ! Loop variables + INTEGER(IntKI) :: i,k,node ! Loop variables INTEGER(IntKI) :: nNodesBladeProps ! Number of nodes in the blade properties for a given blade INTEGER(IntKI) :: nNodesTowerProps ! Number of nodes in the tower properties INTEGER(IntKI) :: jLower ! Index of the blade properties node just smaller than the force node - INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation - CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None REAL(ReKi) :: rInterp ! The location of this force node in (0,1) co-ordinates between the jLower and jLower+1 nodes + ErrStat = ErrID_None + ErrMsg = "" + ! Set the chord for the hub node to be zero. Ideally, I'd like this to be the hub radius. Will figure this out later. Node = 1 u_OpFM%forceNodesChord(Node) = 0.0_ReKi diff --git a/modules/servodyn/src/ServoDyn.f90 b/modules/servodyn/src/ServoDyn.f90 index d17daaef82..dfdd75f723 100644 --- a/modules/servodyn/src/ServoDyn.f90 +++ b/modules/servodyn/src/ServoDyn.f90 @@ -762,8 +762,6 @@ SUBROUTINE SrvD_UpdateStates( t, n, Inputs, InputTimes, p, x, xd, z, OtherState, INTEGER(IntKi) :: order TYPE(SrvD_InputType) :: u_interp ! interpolated input ! Local variables: - REAL(ReKi) :: GenTrq !< generator torque - REAL(ReKi) :: ElecPwr !< electrical power INTEGER(IntKi) :: ErrStat2 ! Error status of the operation (occurs after initial error) @@ -1312,7 +1310,6 @@ SUBROUTINE SrvD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, Er REAL(R8Ki) :: AllOuts(3,1:MaxOutPts) ! All the the available output channels REAL(R8Ki) :: GenTrq_du, ElecPwr_du ! derivatives of generator torque and electrical power w.r.t. u%HSS_SPD INTEGER(IntKi) :: I ! Generic loop index - INTEGER(IntKi) :: K ! Blade index INTEGER(IntKi) :: ErrStat2 ! Error status of the operation CHARACTER(ErrMsgLen) :: ErrMsg2 ! Error message if ErrStat /= ErrID_None CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_JacobianPInput' @@ -4040,7 +4037,6 @@ SUBROUTINE CalculateTorqueJacobian( t, u, p, m, GenTrq_du, ElecPwr_du, ErrStat, REAL(R8Ki) :: Current2_i, Current2_i_du ! Current passing through the rotor (amps) and its derivative w.r.t. u%HSS_Spd REAL(R8Ki) :: GenTrq ! generator torque - REAL(R8Ki) :: PwrMech ! Mechanical power in generator REAL(R8Ki) :: ComDenom, ComDenom_du ! temporary variable (common denominator) REAL(R8Ki) :: PwrLossS_du ! Power loss in the stator (watts) and its derivative w.r.t. u%HSS_Spd diff --git a/modules/subdyn/src/SubDyn.f90 b/modules/subdyn/src/SubDyn.f90 index a116c6db84..e93577dff6 100644 --- a/modules/subdyn/src/SubDyn.f90 +++ b/modules/subdyn/src/SubDyn.f90 @@ -712,7 +712,6 @@ SUBROUTINE SD_Input(SDInputFile, Init, p, ErrStat,ErrMsg) ! local variable for input and output CHARACTER(1024) :: PriPath ! The path to the primary input file CHARACTER(1024) :: Line ! String to temporarially hold value of read line -INTEGER :: Sttus LOGICAL :: Echo INTEGER(IntKi) :: UnIn diff --git a/vs-build/FASTlib/FASTlib.vfproj b/vs-build/FASTlib/FASTlib.vfproj index 4c1b507418..2d069cb191 100644 --- a/vs-build/FASTlib/FASTlib.vfproj +++ b/vs-build/FASTlib/FASTlib.vfproj @@ -113,7 +113,8 @@ - + + From d4254d65d6494f3aad158003873115d425a7408e Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Tue, 12 May 2020 17:52:19 -0600 Subject: [PATCH 46/72] ED linear: fix issue with rotations on blade mesh with TrimSolution --- modules/elastodyn/src/ElastoDyn.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/modules/elastodyn/src/ElastoDyn.f90 b/modules/elastodyn/src/ElastoDyn.f90 index 52bf05911f..ef68ff2685 100644 --- a/modules/elastodyn/src/ElastoDyn.f90 +++ b/modules/elastodyn/src/ElastoDyn.f90 @@ -11770,7 +11770,7 @@ SUBROUTINE ED_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, index = 1 if (allocated(y%BladeLn2Mesh)) then do k=1,p%NumBl - call PackMotionMesh(y%BladeLn2Mesh(k), y_op, index) + call PackMotionMesh(y%BladeLn2Mesh(k), y_op, index, UseLogMaps=ReturnLogMap) end do end if call PackMotionMesh(y%PlatformPtMesh, y_op, index, UseLogMaps=ReturnLogMap) From 862d753d17e529ab4da6343b106ab395dc525817 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Thu, 14 May 2020 11:19:28 -0600 Subject: [PATCH 47/72] update r-test --- 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 9fff694eb7..3cdfafa4fd 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 9fff694eb70f267a1cc1f3e7783ae08e3514d5ce +Subproject commit 3cdfafa4fdbcd275e317f8bf86b974ef55c76ae5 From 3ad48d2b4882ef58ff7aeb0238e54cde6baca456 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Mon, 18 May 2020 20:04:19 -0600 Subject: [PATCH 48/72] fix typos --- modules/openfast-library/src/FAST_Registry.txt | 6 +++--- modules/openfast-library/src/FAST_Solver.f90 | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/modules/openfast-library/src/FAST_Registry.txt b/modules/openfast-library/src/FAST_Registry.txt index 8ff39812ab..fed0ebc216 100644 --- a/modules/openfast-library/src/FAST_Registry.txt +++ b/modules/openfast-library/src/FAST_Registry.txt @@ -191,7 +191,7 @@ typedef ^ ^ BD_DiscreteStateType xd_BD typedef ^ ^ BD_ConstraintStateType z_BD {:}{:} - - "Constraint states" typedef ^ ^ BD_OtherStateType OtherSt_BD {:}{:} - - "Other states" typedef ^ ^ BD_InputType u_BD {:}{:} - - "System inputs" -# ..... ElatoDyn OP data ....................................................................................................... +# ..... 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" @@ -203,7 +203,7 @@ typedef ^ ^ SrvD_DiscreteStateType xd_Sr typedef ^ ^ SrvD_ConstraintStateType z_SrvD {:} - - "Constraint states" typedef ^ ^ SrvD_OtherStateType OtherSt_SrvD {:} - - "Other states" typedef ^ ^ SrvD_InputType u_SrvD {:} - - "System inputs" -# ..... No AeroDyn14 data ....................................................................................................... +# ..... No AeroDyn14 data ..................................................................................................... # ..... AeroDyn OP data ....................................................................................................... typedef FAST FAST_LinStateSave AD_ContinuousStateType x_AD {:} - - "Continuous states" typedef ^ ^ AD_DiscreteStateType xd_AD {:} - - "Discrete states" @@ -307,7 +307,7 @@ typedef ^ FAST_LinFileType ReKi WindSpeed - - - "Wind speed at reference height" # ..... FAST_MiscLinType data ....................................................................................................... typedef ^ FAST_MiscLinType DbKi LinTimes {:} - - "List of times at which to linearize" s -typedef ^ FAST_MiscLinType IntKi CopyOP_CtrlCode - - - "if we are mesh control code for copy type" - +typedef ^ FAST_MiscLinType IntKi CopyOP_CtrlCode - - - "mesh control code for copy type (new on first call; update otherwise)" - typedef ^ FAST_MiscLinType DbKi AzimTarget {:} - - "target azimuth positions in CalcSteady algorithm" rad typedef ^ FAST_MiscLinType logical IsConverged - - - "whether the error calculation in the CalcSteady algorithm is converged" - typedef ^ FAST_MiscLinType logical FoundSteady - - - "whether the CalcSteady algorithm found a steady-state solution" - diff --git a/modules/openfast-library/src/FAST_Solver.f90 b/modules/openfast-library/src/FAST_Solver.f90 index 0791672cb3..81c35893b6 100644 --- a/modules/openfast-library/src/FAST_Solver.f90 +++ b/modules/openfast-library/src/FAST_Solver.f90 @@ -4403,7 +4403,7 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M ! Temporary meshes for transfering inputs to ED and BD CALL MeshCopy ( ED%Input(1)%HubPtLoad, MeshMapData%u_ED_HubPtLoad_2, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':u_ED_PlatformPtMesh' ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':u_ED_HubPtLoad_2' ) allocate( MeshMapData%u_BD_RootMotion( p_FAST%nBeams ), STAT = ErrStat2 ) if (ErrStat2 /= 0) then From 89f4cd32e5ab6d314f5ad1da07236c8d6b2f332d Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Tue, 26 May 2020 08:00:23 -0600 Subject: [PATCH 49/72] AD bug fix: return DTAero to glue code AD was not telling the glue code what time step it is requesting, so if the value "DTAero" in the AD input file was not "default" or the value of the glue-code time step, there could be inconsistencies in the results. --- modules/aerodyn/src/AeroDyn.f90 | 9 ++++++++- modules/aerodyn/src/BEMT.f90 | 21 +-------------------- modules/aerodyn/src/DBEMT.f90 | 4 ++-- modules/aerodyn/src/UnsteadyAero.f90 | 8 ++++---- 4 files changed, 15 insertions(+), 27 deletions(-) diff --git a/modules/aerodyn/src/AeroDyn.f90 b/modules/aerodyn/src/AeroDyn.f90 index 66ebb3d179..9237803707 100644 --- a/modules/aerodyn/src/AeroDyn.f90 +++ b/modules/aerodyn/src/AeroDyn.f90 @@ -436,7 +436,14 @@ subroutine AD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) 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: + !............................................................................................ + + Interval = p%DT + + call Cleanup() contains diff --git a/modules/aerodyn/src/BEMT.f90 b/modules/aerodyn/src/BEMT.f90 index 44ac61f8c0..5ae4ffcf9d 100644 --- a/modules/aerodyn/src/BEMT.f90 +++ b/modules/aerodyn/src/BEMT.f90 @@ -449,7 +449,7 @@ subroutine BEMT_Init( InitInp, u, p, x, xd, z, OtherState, AFInfo, y, misc, Inte type(AFI_ParameterType), intent(in ) :: AFInfo(:) ! The airfoil parameter data type(BEMT_OutputType), intent( out) :: y ! Initial system outputs (outputs are not calculated; ! only the output mesh is initialized) - real(DbKi), intent(inout) :: interval ! Coupling interval in seconds: the rate that + real(DbKi), intent(in ) :: interval ! Coupling interval in seconds: the rate that ! (1) BEMT_UpdateStates() is called in loose coupling & ! (2) BEMT_UpdateDiscState() is called in tight coupling. ! Input is the suggested time from the glue code; @@ -632,25 +632,6 @@ subroutine BEMT_Init( InitInp, u, p, x, xd, z, OtherState, AFInfo, y, misc, Inte call AllocAry(misc%TanInduction,p%numBladeNodes,p%numBlades,'misc%TanInduction', errStat2,errMsg2); call SetErrStat(errStat2,errMsg2,errStat,errMsg,RoutineName) call AllocAry(misc%Rtip,p%numBlades,'misc%Rtip', errStat2,errMsg2); call SetErrStat(errStat2,errMsg2,errStat,errMsg,RoutineName) - !............................................................................................ - ! 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: - !............................................................................................ - - Interval = p%DT - - - ! Print the summary file if requested: - !IF (InputFileData%SumPrint) THEN - ! CALL BEMT_PrintSum( p, OtherState, GetAdamsVals, ErrStat2, ErrMsg2 ) - ! call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - !END IF - - ! Destroy the InputFileData structure (deallocate arrays) - - !CALL BEMT_DestroyInputFile(InputFileData, ErrStat2, ErrMsg2 ) - ! call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - CONTAINS !............................................................................................................................... SUBROUTINE Cleanup() diff --git a/modules/aerodyn/src/DBEMT.f90 b/modules/aerodyn/src/DBEMT.f90 index 6117d04b34..a9f63471bd 100644 --- a/modules/aerodyn/src/DBEMT.f90 +++ b/modules/aerodyn/src/DBEMT.f90 @@ -38,7 +38,7 @@ module DBEMT subroutine DBEMT_ValidateInitInp(interval, InitInp, errStat, errMsg) - real(DbKi), intent(inout) :: interval !< Coupling interval in seconds: the rate that + real(DbKi), intent(in ) :: interval !< Coupling interval in seconds type(DBEMT_InitInputType), intent(in ) :: InitInp !< Input data for initialization routine integer(IntKi), intent( out) :: errStat !< Error status of the operation character(*), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None @@ -98,7 +98,7 @@ subroutine DBEMT_Init( InitInp, u, p, x, OtherState, m, Interval, InitOut, ErrSt type(DBEMT_ContinuousStateType), intent( out) :: x !< Initial continuous states type(DBEMT_OtherStateType), intent( out) :: OtherState !< Initial other/logical states type(DBEMT_MiscVarType), intent( out) :: m !< Initial misc/optimization variables - real(DbKi), intent(inout) :: interval !< Coupling interval in seconds: the rate that + real(DbKi), intent(in ) :: interval !< Coupling interval in seconds: the rate that !! (1) DBEMT_UpdateStates() is called in loose coupling & !! (2) DBEMT_UpdateDiscState() is called in tight coupling. !! Input is the suggested time from the glue code; diff --git a/modules/aerodyn/src/UnsteadyAero.f90 b/modules/aerodyn/src/UnsteadyAero.f90 index 44754c8121..c85b2ceeda 100644 --- a/modules/aerodyn/src/UnsteadyAero.f90 +++ b/modules/aerodyn/src/UnsteadyAero.f90 @@ -698,11 +698,11 @@ subroutine UA_SetParameters( dt, InitInp, p, ErrStat, ErrMsg ) ! Calls to : NONE !.............................................................................. - real(DbKi), intent(inout) :: dt ! time step length (s) + real(DbKi), intent(in ) :: dt ! time step length (s) type(UA_InitInputType), intent(inout) :: InitInp ! input data for initialization routine, needs to be inout because there is a copy of some data in InitInp in BEMT_SetParameters() type(UA_ParameterType), intent(inout) :: p ! parameters - integer(IntKi), intent( out) :: ErrStat ! error status of the operation - character(*), intent( out) :: ErrMsg ! error message if ErrStat /= ErrID_None + integer(IntKi), intent( out) :: ErrStat ! error status of the operation + character(*), intent( out) :: ErrMsg ! error message if ErrStat /= ErrID_None integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'UA_SetParameters' @@ -886,7 +886,7 @@ subroutine UA_Init( InitInp, u, p, xd, OtherState, y, m, Interval, & type(UA_OutputType), intent( out) :: y ! Initial system outputs (outputs are not calculated; ! only the output mesh is initialized) type(UA_MiscVarType), intent( out) :: m ! Initial misc/optimization variables - real(DbKi), intent(inout) :: interval ! Coupling interval in seconds: the rate that + real(DbKi), intent(in ) :: interval ! Coupling interval in seconds: the rate that ! (1) BEMT_UpdateStates() is called in loose coupling & ! (2) BEMT_UpdateDiscState() is called in tight coupling. ! Input is the suggested time from the glue code; From 87f9162ec0f0e1165855b4bbf0d3fc2e96efd087 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Tue, 26 May 2020 15:49:01 -0600 Subject: [PATCH 50/72] FAST: put all modules' initialization data in a type This is part of a reorg for the next Envision-NREL collaboration: replaced individual module initInput/InitOutput types in FAST_Subs.f90/FAST_InitializeAll() with a type defined in FAST_Registry.txt. --- .../openfast-library/src/FAST_Registry.txt | 39 + modules/openfast-library/src/FAST_Subs.f90 | 799 ++- modules/openfast-library/src/FAST_Types.f90 | 4361 ++++++++++++++--- 3 files changed, 4162 insertions(+), 1037 deletions(-) diff --git a/modules/openfast-library/src/FAST_Registry.txt b/modules/openfast-library/src/FAST_Registry.txt index fed0ebc216..d599f93262 100644 --- a/modules/openfast-library/src/FAST_Registry.txt +++ b/modules/openfast-library/src/FAST_Registry.txt @@ -625,6 +625,44 @@ typedef ^ FAST_ExternInputType ReKi BlPitchCom 3 - 2pi "blade pitch commands fro typedef ^ FAST_ExternInputType ReKi HSSBrFrac - - - "Fraction of full braking torque: 0 (off) <= HSSBrFrac <= 1 (full) from Simulink or LabVIEW" typedef ^ FAST_ExternInputType ReKi LidarFocus 3 - - "lidar focus (relative to lidar location)" m + +# ..... 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 BD_InitInputType InData_BD - - - "BD Initialization input data" +typedef ^ FAST_InitData BD_InitOutputType OutData_BD : - - "BD Initialization output data" +typedef ^ FAST_InitData SrvD_InitInputType InData_SrvD - - - "SrvD Initialization input data" +typedef ^ FAST_InitData SrvD_InitOutputType OutData_SrvD - - - "SrvD Initialization output data" +typedef ^ FAST_InitData AD14_InitInputType InData_AD14 - - - "AD14 Initialization input data" +typedef ^ FAST_InitData AD14_InitOutputType OutData_AD14 - - - "AD14 Initialization output data" +typedef ^ FAST_InitData AD_InitInputType InData_AD - - - "AD Initialization input data" +typedef ^ FAST_InitData AD_InitOutputType OutData_AD - - - "AD Initialization output data" +typedef ^ FAST_InitData InflowWind_InitInputType InData_IfW - - - "IfW Initialization input data" +typedef ^ FAST_InitData InflowWind_InitOutputType OutData_IfW - - - "IfW Initialization output data" +typedef ^ FAST_InitData OpFM_InitInputType InData_OpFM - - - "OpFM Initialization input data" +typedef ^ FAST_InitData OpFM_InitOutputType OutData_OpFM - - - "OpFM Initialization output data" +typedef ^ FAST_InitData HydroDyn_InitInputType InData_HD - - - "HD Initialization input data" +typedef ^ FAST_InitData HydroDyn_InitOutputType OutData_HD - - - "HD Initialization output data" +typedef ^ FAST_InitData SD_InitInputType InData_SD - - - "SD Initialization input data" +typedef ^ FAST_InitData SD_InitOutputType OutData_SD - - - "SD Initialization output data" +typedef ^ FAST_InitData ExtPtfm_InitInputType InData_ExtPtfm - - - "ExtPtfm Initialization input data" +typedef ^ FAST_InitData ExtPtfm_InitOutputType OutData_ExtPtfm - - - "ExtPtfm Initialization output data" +typedef ^ FAST_InitData MAP_InitInputType InData_MAP - - - "MAP Initialization input data" +typedef ^ FAST_InitData MAP_InitOutputType OutData_MAP - - - "MAP Initialization output data" +typedef ^ FAST_InitData FEAM_InitInputType InData_FEAM - - - "FEAM Initialization input data" +typedef ^ FAST_InitData FEAM_InitOutputType OutData_FEAM - - - "FEAM Initialization output data" +typedef ^ FAST_InitData MD_InitInputType InData_MD - - - "MD Initialization input data" +typedef ^ FAST_InitData MD_InitOutputType OutData_MD - - - "MD Initialization output data" +typedef ^ FAST_InitData Orca_InitInputType InData_Orca - - - "Orca Initialization input data" +typedef ^ FAST_InitData Orca_InitOutputType OutData_Orca - - - "Orca Initialization output data" +typedef ^ FAST_InitData IceFloe_InitInputType InData_IceF - - - "IceF Initialization input data" +typedef ^ FAST_InitData IceFloe_InitOutputType OutData_IceF - - - "IceF Initialization output data" +typedef ^ FAST_InitData IceD_InitInputType InData_IceD - - - "IceD Initialization input data" +typedef ^ FAST_InitData IceD_InitOutputType OutData_IceD - - - "IceD Initialization output data (each instance will have the same output channels)" +typedef ^ FAST_InitData SC_InitInputType InData_SC - - - "SC Initialization input data" +typedef ^ FAST_InitData SC_InitOutputType OutData_SC - - - "SC Initialization output data" + + # ..... FAST_MiscVarType data ....................................................................................................... typedef FAST FAST_MiscVarType DbKi TiLstPrn - - - "The simulation time of the last print (to file)" (s) typedef ^ FAST_MiscVarType DbKi t_global - - - "Current simulation time (for global/FAST simulation)" (s) @@ -679,3 +717,4 @@ typedef ^ FAST_TurbineType OrcaFlex_Data Orca - - - "Data for the OrcaFlex inter typedef ^ FAST_TurbineType IceFloe_Data IceF - - - "Data for the IceFloe module" - typedef ^ FAST_TurbineType IceDyn_Data IceD - - - "Data for the IceDyn module" - typedef ^ FAST_TurbineType ExtPtfm_Data ExtPtfm - - - "Data for the ExtPtfm (external platform loading) module" - +#typedef ^ FAST_TurbineType FAST_InitData Init - - - "Data for all modules at initialization" - diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index e3c5b6239e..dc90e01a65 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -106,57 +106,8 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! local variables CHARACTER(1024) :: InputFile !< A CHARACTER string containing the name of the primary FAST input file + TYPE(FAST_InitData) :: Init !< Initialization data for all modules - TYPE(ED_InitInputType) :: InitInData_ED ! Initialization input data - TYPE(ED_InitOutputType) :: InitOutData_ED ! Initialization output data - - TYPE(BD_InitInputType) :: InitInData_BD ! Initialization input data - TYPE(BD_InitOutputType), ALLOCATABLE :: InitOutData_BD(:) ! Initialization output data - - TYPE(SrvD_InitInputType) :: InitInData_SrvD ! Initialization input data - TYPE(SrvD_InitOutputType) :: InitOutData_SrvD ! Initialization output data - - TYPE(AD14_InitInputType) :: InitInData_AD14 ! Initialization input data - TYPE(AD14_InitOutputType) :: InitOutData_AD14 ! Initialization output data - - TYPE(AD_InitInputType) :: InitInData_AD ! Initialization input data - TYPE(AD_InitOutputType) :: InitOutData_AD ! Initialization output data - - TYPE(InflowWind_InitInputType) :: InitInData_IfW ! Initialization input data - TYPE(InflowWind_InitOutputType) :: InitOutData_IfW ! Initialization output data - - TYPE(OpFM_InitInputType) :: InitInData_OpFM ! Initialization input data - TYPE(OpFM_InitOutputType) :: InitOutData_OpFM ! Initialization output data - - TYPE(SC_InitInputType) :: InitInData_SC ! Initialization input data - TYPE(SC_InitOutputType) :: InitOutData_SC ! Initialization output data - - TYPE(HydroDyn_InitInputType) :: InitInData_HD ! Initialization input data - TYPE(HydroDyn_InitOutputType) :: InitOutData_HD ! Initialization output data - - TYPE(SD_InitInputType) :: InitInData_SD ! Initialization input data - TYPE(SD_InitOutputType) :: InitOutData_SD ! Initialization output data - - TYPE(ExtPtfm_InitInputType) :: InitInData_ExtPtfm ! Initialization input data - TYPE(ExtPtfm_InitOutputType) :: InitOutData_ExtPtfm ! Initialization output data - - TYPE(MAP_InitInputType) :: InitInData_MAP ! Initialization input data - TYPE(MAP_InitOutputType) :: InitOutData_MAP ! Initialization output data - - TYPE(FEAM_InitInputType) :: InitInData_FEAM ! Initialization input data - TYPE(FEAM_InitOutputType) :: InitOutData_FEAM ! Initialization output data - - TYPE(MD_InitInputType) :: InitInData_MD ! Initialization input data - TYPE(MD_InitOutputType) :: InitOutData_MD ! Initialization output data - - TYPE(Orca_InitInputType) :: InitInData_Orca ! Initialization input data - TYPE(Orca_InitOutputType) :: InitOutData_Orca ! Initialization output data - - TYPE(IceFloe_InitInputType) :: InitInData_IceF ! Initialization input data - TYPE(IceFloe_InitOutputType) :: InitOutData_IceF ! Initialization output data - - TYPE(IceD_InitInputType) :: InitInData_IceD ! Initialization input data - TYPE(IceD_InitOutputType) :: InitOutData_IceD ! Initialization output data (each instance will have the same output channels) REAL(ReKi) :: AirDens ! air density for initialization/normalization of OpenFOAM data REAL(DbKi) :: dt_IceD ! tmp dt variable to ensure IceDyn doesn't specify different dt values for different legs (IceDyn instances) @@ -271,19 +222,19 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, RETURN END IF - InitInData_ED%Linearize = p_FAST%Linearize - InitInData_ED%InputFile = p_FAST%EDFile + Init%InData_ED%Linearize = p_FAST%Linearize + Init%InData_ED%InputFile = p_FAST%EDFile IF ( p_FAST%CompAero == Module_AD14 ) THEN - InitInData_ED%ADInputFile = p_FAST%AeroFile + Init%InData_ED%ADInputFile = p_FAST%AeroFile ELSE - InitInData_ED%ADInputFile = "" + Init%InData_ED%ADInputFile = "" END IF - InitInData_ED%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_ED)) - InitInData_ED%CompElast = p_FAST%CompElast == Module_ED + Init%InData_ED%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_ED)) + Init%InData_ED%CompElast = p_FAST%CompElast == Module_ED - CALL ED_Init( InitInData_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 ), InitOutData_ED, ErrStat2, ErrMsg2 ) + 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. @@ -302,16 +253,16 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(ED).", ErrStat, ErrMsg, RoutineName ) else - if (allocated(InitOutData_ED%LinNames_y)) call move_alloc(InitOutData_ED%LinNames_y,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%Names_y) - if (allocated(InitOutData_ED%LinNames_x)) call move_alloc(InitOutData_ED%LinNames_x,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%Names_x) - if (allocated(InitOutData_ED%LinNames_u)) call move_alloc(InitOutData_ED%LinNames_u,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%Names_u) - if (allocated(InitOutData_ED%RotFrame_y)) call move_alloc(InitOutData_ED%RotFrame_y,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%RotFrame_y) - if (allocated(InitOutData_ED%RotFrame_x)) call move_alloc(InitOutData_ED%RotFrame_x,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%RotFrame_x) - if (allocated(InitOutData_ED%DerivOrder_x)) call move_alloc(InitOutData_ED%DerivOrder_x,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%DerivOrder_x) - if (allocated(InitOutData_ED%RotFrame_u)) call move_alloc(InitOutData_ED%RotFrame_u,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%RotFrame_u) - if (allocated(InitOutData_ED%IsLoad_u )) call move_alloc(InitOutData_ED%IsLoad_u ,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%IsLoad_u ) + 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(InitOutData_ED%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%NumOutputs = size(InitOutData_ED%WriteOutputHdr) + 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 @@ -320,11 +271,11 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, END IF if (p_FAST%CalcSteady) then - if ( EqualRealNos(InitOutData_ED%RotSpeed, 0.0_ReKi) ) 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 ( InitOutData_ED%isFixed_GenDOF ) then + elseif ( Init%OutData_ED%isFixed_GenDOF ) then p_FAST%TrimCase = TrimCase_none end if end if @@ -334,7 +285,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! initialize BeamDyn ! ........................ IF ( p_FAST%CompElast == Module_BD ) THEN - p_FAST%nBeams = InitOutData_ED%NumBl ! initialize number of BeamDyn instances = number of blades + p_FAST%nBeams = Init%OutData_ED%NumBl ! initialize number of BeamDyn instances = number of blades ELSE p_FAST%nBeams = 0 END IF @@ -354,7 +305,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, BD%u( p_FAST%nBeams ), & BD%y( p_FAST%nBeams ), & BD%m( p_FAST%nBeams ), & - InitOutData_BD( 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) @@ -364,16 +315,16 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, IF (p_FAST%CompElast == Module_BD) THEN - InitInData_BD%DynamicSolve = .TRUE. ! FAST can only couple to BeamDyn when dynamic solve is used. + Init%InData_BD%DynamicSolve = .TRUE. ! FAST can only couple to BeamDyn when dynamic solve is used. - InitInData_BD%Linearize = p_FAST%Linearize - InitInData_BD%gravity = (/ 0.0_ReKi, 0.0_ReKi, -InitOutData_ED%Gravity /) ! "Gravitational acceleration" m/s^2 + Init%InData_BD%Linearize = p_FAST%Linearize + Init%InData_BD%gravity = (/ 0.0_ReKi, 0.0_ReKi, -Init%OutData_ED%Gravity /) ! "Gravitational acceleration" m/s^2 ! now initialize BeamDyn for all beams dt_BD = p_FAST%dt_module( MODULE_BD ) - InitInData_BD%HubPos = ED%y%HubPtMotion%Position(:,1) - InitInData_BD%HubRot = ED%y%HubPtMotion%RefOrientation(:,:,1) + Init%InData_BD%HubPos = ED%y%HubPtMotion%Position(:,1) + Init%InData_BD%HubRot = ED%y%HubPtMotion%RefOrientation(:,:,1) p_FAST%BD_OutputSibling = .true. @@ -385,21 +336,21 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, end if DO k=1,p_FAST%nBeams - InitInData_BD%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_BD))//TRIM( Num2LStr(k) ) + Init%InData_BD%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_BD))//TRIM( Num2LStr(k) ) - InitInData_BD%InputFile = p_FAST%BDBldFile(k) + Init%InData_BD%InputFile = p_FAST%BDBldFile(k) - InitInData_BD%GlbPos = ED%y%BladeRootMotion(k)%Position(:,1) ! {:} - - "Initial Position Vector of the local blade coordinate system" - InitInData_BD%GlbRot = ED%y%BladeRootMotion(k)%RefOrientation(:,:,1) ! {:}{:} - - "Initial direction cosine matrix of the local blade coordinate system" + 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" - InitInData_BD%RootDisp = ED%y%BladeRootMotion(k)%TranslationDisp(:,1) ! {:} - - "Initial root displacement" - InitInData_BD%RootOri = ED%y%BladeRootMotion(k)%Orientation(:,:,1) ! {:}{:} - - "Initial root orientation" - InitInData_BD%RootVel(1:3) = ED%y%BladeRootMotion(k)%TranslationVel(:,1) ! {:} - - "Initial root velocities and angular veolcities" - InitInData_BD%RootVel(4:6) = ED%y%BladeRootMotion(k)%RotationVel(:,1) ! {:} - - "Initial root velocities and angular veolcities" + Init%InData_BD%RootDisp = ED%y%BladeRootMotion(k)%TranslationDisp(:,1) ! {:} - - "Initial root displacement" + Init%InData_BD%RootOri = ED%y%BladeRootMotion(k)%Orientation(:,:,1) ! {:}{:} - - "Initial root orientation" + Init%InData_BD%RootVel(1:3) = ED%y%BladeRootMotion(k)%TranslationVel(:,1) ! {:} - - "Initial root velocities and angular veolcities" + Init%InData_BD%RootVel(4:6) = ED%y%BladeRootMotion(k)%RotationVel(:,1) ! {:} - - "Initial root velocities and angular veolcities" - CALL BD_Init( InitInData_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, InitOutData_BD(k), ErrStat2, ErrMsg2 ) + CALL BD_Init( Init%InData_BD, BD%Input(1,k), BD%p(k), BD%x(k,STATE_CURR), BD%xd(k,STATE_CURR), BD%z(k,STATE_CURR), & + BD%OtherSt(k,STATE_CURR), BD%y(k), BD%m(k), dt_BD, Init%OutData_BD(k), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) !bjj: we're going to force this to have the same timestep because I don't want to have to deal with n BD modules with n timesteps. @@ -418,16 +369,16 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, if (ErrStat>=AbortErrLev) exit !exit this loop so we don't get p_FAST%nBeams of the same errors - if (allocated(InitOutData_BD(k)%LinNames_y)) call move_alloc(InitOutData_BD(k)%LinNames_y, y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%Names_y ) - if (allocated(InitOutData_BD(k)%LinNames_x)) call move_alloc(InitOutData_BD(k)%LinNames_x, y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%Names_x ) - if (allocated(InitOutData_BD(k)%LinNames_u)) call move_alloc(InitOutData_BD(k)%LinNames_u, y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%Names_u ) - if (allocated(InitOutData_BD(k)%RotFrame_y)) call move_alloc(InitOutData_BD(k)%RotFrame_y, y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%RotFrame_y ) - if (allocated(InitOutData_BD(k)%RotFrame_x)) call move_alloc(InitOutData_BD(k)%RotFrame_x, y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%RotFrame_x ) - if (allocated(InitOutData_BD(k)%RotFrame_u)) call move_alloc(InitOutData_BD(k)%RotFrame_u, y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%RotFrame_u ) - if (allocated(InitOutData_BD(k)%IsLoad_u )) call move_alloc(InitOutData_BD(k)%IsLoad_u , y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%IsLoad_u ) - if (allocated(InitOutData_BD(k)%DerivOrder_x )) call move_alloc(InitOutData_BD(k)%DerivOrder_x , y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%DerivOrder_x ) + 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(InitOutData_BD(k)%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%NumOutputs = size(InitOutData_BD(k)%WriteOutputHdr) + if (allocated(Init%OutData_BD(k)%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%NumOutputs = size(Init%OutData_BD(k)%WriteOutputHdr) END DO @@ -459,11 +410,11 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, IF ( p_FAST%CompAero == Module_AD14 ) THEN - CALL AD_SetInitInput(InitInData_AD14, InitOutData_ED, ED%y, p_FAST, ErrStat2, ErrMsg2) ! set the values in InitInData_AD14 + CALL AD_SetInitInput(Init%InData_AD14, Init%OutData_ED, ED%y, p_FAST, ErrStat2, ErrMsg2) ! set the values in Init%InData_AD14 CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL AD14_Init( InitInData_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 ), InitOutData_AD14, ErrStat2, ErrMsg2 ) + CALL AD14_Init( Init%InData_AD14, AD14%Input(1), AD14%p, AD14%x(STATE_CURR), AD14%xd(STATE_CURR), AD14%z(STATE_CURR), & + AD14%OtherSt(STATE_CURR), AD14%y, AD14%m, p_FAST%dt_module( MODULE_AD14 ), Init%OutData_AD14, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) p_FAST%ModuleInitialized(Module_AD14) = .TRUE. @@ -476,7 +427,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, CALL SetErrStat(ErrID_Fatal,'AeroDyn v14 tower influence model "NEWTOWER" is invalid for models of floating offshore turbines.',ErrStat,ErrMsg,RoutineName) END IF - AirDens = InitOutData_AD14%AirDens + AirDens = Init%OutData_AD14%AirDens IF (ErrStat >= AbortErrLev) THEN CALL Cleanup() @@ -487,30 +438,30 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! set initialization data for AD - CALL AllocAry( InitInData_AD%BladeRootPosition, 3, InitOutData_ED%NumBl, 'InitInData_AD%BladeRootPosition', errStat2, ErrMsg2) + CALL AllocAry( Init%InData_AD%BladeRootPosition, 3, Init%OutData_ED%NumBl, 'Init%InData_AD%BladeRootPosition', errStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL AllocAry( InitInData_AD%BladeRootOrientation,3, 3, InitOutData_ED%NumBl, 'InitInData_AD%BladeRootOrientation', errStat2, ErrMsg2) + CALL AllocAry( Init%InData_AD%BladeRootOrientation,3, 3, Init%OutData_ED%NumBl, 'Init%InData_AD%BladeRootOrientation', errStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF (ErrStat >= AbortErrLev) THEN CALL Cleanup() RETURN END IF - InitInData_AD%Gravity = InitOutData_ED%Gravity - InitInData_AD%Linearize = p_FAST%Linearize - InitInData_AD%InputFile = p_FAST%AeroFile - InitInData_AD%NumBlades = InitOutData_ED%NumBl - InitInData_AD%RootName = p_FAST%OutFileRoot - InitInData_AD%HubPosition = ED%y%HubPtMotion%Position(:,1) - InitInData_AD%HubOrientation = ED%y%HubPtMotion%RefOrientation(:,:,1) - - do k=1,InitOutData_ED%NumBl - InitInData_AD%BladeRootPosition(:,k) = ED%y%BladeRootMotion(k)%Position(:,1) - InitInData_AD%BladeRootOrientation(:,:,k) = ED%y%BladeRootMotion(k)%RefOrientation(:,:,1) + Init%InData_AD%Gravity = Init%OutData_ED%Gravity + Init%InData_AD%Linearize = p_FAST%Linearize + Init%InData_AD%InputFile = p_FAST%AeroFile + Init%InData_AD%NumBlades = Init%OutData_ED%NumBl + Init%InData_AD%RootName = p_FAST%OutFileRoot + Init%InData_AD%HubPosition = ED%y%HubPtMotion%Position(:,1) + Init%InData_AD%HubOrientation = ED%y%HubPtMotion%RefOrientation(:,:,1) + + do k=1,Init%OutData_ED%NumBl + Init%InData_AD%BladeRootPosition(:,k) = ED%y%BladeRootMotion(k)%Position(:,1) + Init%InData_AD%BladeRootOrientation(:,:,k) = ED%y%BladeRootMotion(k)%RefOrientation(:,:,1) end do - CALL AD_Init( InitInData_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 ), InitOutData_AD, ErrStat2, ErrMsg2 ) + CALL AD_Init( Init%InData_AD, AD%Input(1), AD%p, AD%x(STATE_CURR), AD%xd(STATE_CURR), AD%z(STATE_CURR), & + AD%OtherSt(STATE_CURR), AD%y, AD%m, p_FAST%dt_module( MODULE_AD ), Init%OutData_AD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) p_FAST%ModuleInitialized(Module_AD) = .TRUE. @@ -521,15 +472,15 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, if (ErrStat2 /= 0 ) then call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(AD).", ErrStat, ErrMsg, RoutineName ) else - if (allocated(InitOutData_AD%LinNames_u)) call move_alloc(InitOutData_AD%LinNames_u,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%Names_u ) - if (allocated(InitOutData_AD%LinNames_y)) call move_alloc(InitOutData_AD%LinNames_y,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%Names_y ) - if (allocated(InitOutData_AD%LinNames_z)) call move_alloc(InitOutData_AD%LinNames_z,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%Names_z ) - if (allocated(InitOutData_AD%RotFrame_u)) call move_alloc(InitOutData_AD%RotFrame_u,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%RotFrame_u ) - if (allocated(InitOutData_AD%RotFrame_y)) call move_alloc(InitOutData_AD%RotFrame_y,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%RotFrame_y ) - if (allocated(InitOutData_AD%RotFrame_z)) call move_alloc(InitOutData_AD%RotFrame_z,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%RotFrame_z ) - if (allocated(InitOutData_AD%IsLoad_u )) call move_alloc(InitOutData_AD%IsLoad_u ,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%IsLoad_u ) + if (allocated(Init%OutData_AD%LinNames_u)) call move_alloc(Init%OutData_AD%LinNames_u,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%Names_u ) + if (allocated(Init%OutData_AD%LinNames_y)) call move_alloc(Init%OutData_AD%LinNames_y,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%Names_y ) + if (allocated(Init%OutData_AD%LinNames_z)) call move_alloc(Init%OutData_AD%LinNames_z,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%Names_z ) + if (allocated(Init%OutData_AD%RotFrame_u)) call move_alloc(Init%OutData_AD%RotFrame_u,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%RotFrame_u ) + if (allocated(Init%OutData_AD%RotFrame_y)) call move_alloc(Init%OutData_AD%RotFrame_y,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%RotFrame_y ) + if (allocated(Init%OutData_AD%RotFrame_z)) call move_alloc(Init%OutData_AD%RotFrame_z,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%RotFrame_z ) + if (allocated(Init%OutData_AD%IsLoad_u )) call move_alloc(Init%OutData_AD%IsLoad_u ,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%IsLoad_u ) - if (allocated(InitOutData_AD%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%NumOutputs = size(InitOutData_AD%WriteOutputHdr) + if (allocated(Init%OutData_AD%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%NumOutputs = size(Init%OutData_AD%WriteOutputHdr) end if IF (ErrStat >= AbortErrLev) THEN @@ -537,7 +488,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, RETURN END IF - AirDens = InitOutData_AD%AirDens + AirDens = Init%OutData_AD%AirDens ELSE AirDens = 0.0_ReKi @@ -556,47 +507,47 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, IF ( p_FAST%CompInflow == Module_IfW ) THEN - InitInData_IfW%Linearize = p_FAST%Linearize - InitInData_IfW%InputFileName = p_FAST%InflowFile - InitInData_IfW%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_IfW)) - InitInData_IfW%UseInputFile = .TRUE. + 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. - InitInData_IfW%NumWindPoints = 0 - IF ( p_FAST%CompServo == Module_SrvD ) InitInData_IfW%NumWindPoints = InitInData_IfW%NumWindPoints + 1 + Init%InData_IfW%NumWindPoints = 0 + IF ( p_FAST%CompServo == Module_SrvD ) Init%InData_IfW%NumWindPoints = Init%InData_IfW%NumWindPoints + 1 IF ( p_FAST%CompAero == Module_AD14 ) THEN - InitInData_IfW%NumWindPoints = InitInData_IfW%NumWindPoints + InitOutData_ED%NumBl * AD14%Input(1)%InputMarkers(1)%NNodes + AD14%Input(1)%Twr_InputMarkers%NNodes + Init%InData_IfW%NumWindPoints = Init%InData_IfW%NumWindPoints + Init%OutData_ED%NumBl * AD14%Input(1)%InputMarkers(1)%NNodes + AD14%Input(1)%Twr_InputMarkers%NNodes ELSEIF ( p_FAST%CompAero == Module_AD ) THEN - InitInData_IfW%NumWindPoints = InitInData_IfW%NumWindPoints + AD%Input(1)%TowerMotion%NNodes - DO k=1,InitOutData_ED%NumBl - InitInData_IfW%NumWindPoints = InitInData_IfW%NumWindPoints + AD%Input(1)%BladeMotion(k)%NNodes + Init%InData_IfW%NumWindPoints = Init%InData_IfW%NumWindPoints + AD%Input(1)%TowerMotion%NNodes + DO k=1,Init%OutData_ED%NumBl + Init%InData_IfW%NumWindPoints = Init%InData_IfW%NumWindPoints + AD%Input(1)%BladeMotion(k)%NNodes END DO END IF ! lidar - InitInData_IfW%lidar%Tmax = p_FAST%TMax - InitInData_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) IF ( PRESENT(ExternInitData) ) THEN - InitInData_IfW%Use4Dext = ExternInitData%FarmIntegration + Init%InData_IfW%Use4Dext = ExternInitData%FarmIntegration - if (InitInData_IfW%Use4Dext) then - InitInData_IfW%FDext%n = ExternInitData%windGrid_n - InitInData_IfW%FDext%delta = ExternInitData%windGrid_delta - InitInData_IfW%FDext%pZero = ExternInitData%windGrid_pZero + if (Init%InData_IfW%Use4Dext) then + Init%InData_IfW%FDext%n = ExternInitData%windGrid_n + Init%InData_IfW%FDext%delta = ExternInitData%windGrid_delta + Init%InData_IfW%FDext%pZero = ExternInitData%windGrid_pZero end if ! bjj: these lidar inputs should come from an InflowWind input file; I'm hard coding them here for now - InitInData_IfW%lidar%SensorType = ExternInitData%SensorType - InitInData_IfW%lidar%LidRadialVel = ExternInitData%LidRadialVel - InitInData_IfW%lidar%RotorApexOffsetPos = 0.0 - InitInData_IfW%lidar%NumPulseGate = 0 + Init%InData_IfW%lidar%SensorType = ExternInitData%SensorType + Init%InData_IfW%lidar%LidRadialVel = ExternInitData%LidRadialVel + Init%InData_IfW%lidar%RotorApexOffsetPos = 0.0 + Init%InData_IfW%lidar%NumPulseGate = 0 ELSE - InitInData_IfW%lidar%SensorType = SensorType_None - InitInData_IfW%Use4Dext = .false. + Init%InData_IfW%lidar%SensorType = SensorType_None + Init%InData_IfW%Use4Dext = .false. END IF - CALL InflowWind_Init( InitInData_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 ), InitOutData_IfW, ErrStat2, ErrMsg2 ) + CALL InflowWind_Init( Init%InData_IfW, IfW%Input(1), IfW%p, IfW%x(STATE_CURR), IfW%xd(STATE_CURR), IfW%z(STATE_CURR), & + IfW%OtherSt(STATE_CURR), IfW%y, IfW%m, p_FAST%dt_module( MODULE_IfW ), Init%OutData_IfW, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) p_FAST%ModuleInitialized(Module_IfW) = .TRUE. @@ -607,14 +558,14 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, if (ErrStat2 /= 0 ) then call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(IfW).", ErrStat, ErrMsg, RoutineName ) else - if (allocated(InitOutData_IfW%LinNames_y)) call move_alloc(InitOutData_IfW%LinNames_y,y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%Names_y ) - if (allocated(InitOutData_IfW%LinNames_u)) call move_alloc(InitOutData_IfW%LinNames_u,y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%Names_u ) - if (allocated(InitOutData_IfW%RotFrame_y)) call move_alloc(InitOutData_IfW%RotFrame_y,y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%RotFrame_y ) - if (allocated(InitOutData_IfW%RotFrame_u)) call move_alloc(InitOutData_IfW%RotFrame_u,y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%RotFrame_u ) - if (allocated(InitOutData_IfW%IsLoad_u )) call move_alloc(InitOutData_IfW%IsLoad_u ,y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%IsLoad_u ) - - if (allocated(InitOutData_IfW%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%NumOutputs = size(InitOutData_IfW%WriteOutputHdr) - y_FAST%Lin%WindSpeed = InitOutData_IfW%WindFileInfo%MWS + if (allocated(Init%OutData_IfW%LinNames_y)) call move_alloc(Init%OutData_IfW%LinNames_y,y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%Names_y ) + if (allocated(Init%OutData_IfW%LinNames_u)) call move_alloc(Init%OutData_IfW%LinNames_u,y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%Names_u ) + if (allocated(Init%OutData_IfW%RotFrame_y)) call move_alloc(Init%OutData_IfW%RotFrame_y,y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%RotFrame_y ) + if (allocated(Init%OutData_IfW%RotFrame_u)) call move_alloc(Init%OutData_IfW%RotFrame_u,y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%RotFrame_u ) + if (allocated(Init%OutData_IfW%IsLoad_u )) call move_alloc(Init%OutData_IfW%IsLoad_u ,y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%IsLoad_u ) + + if (allocated(Init%OutData_IfW%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%NumOutputs = size(Init%OutData_IfW%WriteOutputHdr) + y_FAST%Lin%WindSpeed = Init%OutData_IfW%WindFileInfo%MWS end if IF (ErrStat >= AbortErrLev) THEN @@ -625,29 +576,29 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ELSEIF ( p_FAST%CompInflow == Module_OpFM ) THEN IF ( PRESENT(ExternInitData) ) THEN - InitInData_OpFM%NumSC2Ctrl = ExternInitData%NumSC2Ctrl - InitInData_OpFM%NumCtrl2SC = ExternInitData%NumCtrl2SC - InitInData_OpFM%NumActForcePtsBlade = ExternInitData%NumActForcePtsBlade - InitInData_OpFM%NumActForcePtsTower = ExternInitData%NumActForcePtsTower + Init%InData_OpFM%NumSC2Ctrl = ExternInitData%NumSC2Ctrl + Init%InData_OpFM%NumCtrl2SC = ExternInitData%NumCtrl2SC + Init%InData_OpFM%NumActForcePtsBlade = ExternInitData%NumActForcePtsBlade + Init%InData_OpFM%NumActForcePtsTower = ExternInitData%NumActForcePtsTower ELSE CALL SetErrStat( ErrID_Fatal, 'OpenFOAM integration can be used only with external input data (not the stand-alone executable).', ErrStat, ErrMsg, RoutineName ) CALL Cleanup() RETURN END IF - InitInData_OpFM%BladeLength = InitOutData_ED%BladeLength - InitInData_OpFM%TowerHeight = InitOutData_ED%TowerHeight - InitInData_OpFM%TowerBaseHeight = InitOutData_ED%TowerBaseHeight - ALLOCATE(InitInData_OpFM%StructBldRNodes( SIZE(InitOutData_ED%BldRNodes)), STAT=ErrStat2) - InitInData_OpFM%StructBldRNodes(:) = InitOutData_ED%BldRNodes(:) - ALLOCATE(InitInData_OpFM%StructTwrHNodes( SIZE(InitOutData_ED%TwrHNodes)), STAT=ErrStat2) - InitInData_OpFM%StructTwrHNodes(:) = InitOutData_ED%TwrHNodes(:) + Init%InData_OpFM%BladeLength = Init%OutData_ED%BladeLength + Init%InData_OpFM%TowerHeight = Init%OutData_ED%TowerHeight + Init%InData_OpFM%TowerBaseHeight = Init%OutData_ED%TowerBaseHeight + ALLOCATE(Init%InData_OpFM%StructBldRNodes( SIZE(Init%OutData_ED%BldRNodes)), STAT=ErrStat2) + Init%InData_OpFM%StructBldRNodes(:) = Init%OutData_ED%BldRNodes(:) + ALLOCATE(Init%InData_OpFM%StructTwrHNodes( SIZE(Init%OutData_ED%TwrHNodes)), STAT=ErrStat2) + Init%InData_OpFM%StructTwrHNodes(:) = Init%OutData_ED%TwrHNodes(:) IF (ErrStat2 /= 0) THEN CALL SetErrStat(ErrID_Fatal,"Error allocating OpFM%InitInput.",ErrStat,ErrMsg,RoutineName) CALL Cleanup() RETURN END IF ! set up the data structures for integration with OpenFOAM - CALL Init_OpFM( InitInData_OpFM, p_FAST, AirDens, AD14%Input(1), AD%Input(1), InitOutData_AD, AD%y, ED%y, OpFM, InitOutData_OpFM, ErrStat2, ErrMsg2 ) + CALL Init_OpFM( Init%InData_OpFM, p_FAST, AirDens, AD14%Input(1), AD%Input(1), Init%OutData_AD, AD%y, ED%y, OpFM, Init%OutData_OpFM, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF (ErrStat >= AbortErrLev) THEN @@ -656,25 +607,25 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, END IF !bjj: fix me!!! to do - InitOutData_IfW%WindFileInfo%MWS = 0.0_ReKi + Init%OutData_IfW%WindFileInfo%MWS = 0.0_ReKi ELSE - InitOutData_IfW%WindFileInfo%MWS = 0.0_ReKi + Init%OutData_IfW%WindFileInfo%MWS = 0.0_ReKi END IF ! CompInflow ! ........................ ! initialize SuperController ! ........................ IF ( PRESENT(ExternInitData) ) THEN - InitInData_SC%NumSC2Ctrl = ExternInitData%NumSC2Ctrl - InitInData_SC%NumCtrl2SC = ExternInitData%NumCtrl2SC + Init%InData_SC%NumSC2Ctrl = ExternInitData%NumSC2Ctrl + Init%InData_SC%NumCtrl2SC = ExternInitData%NumCtrl2SC ELSE - InitInData_SC%NumSC2Ctrl = 0 - InitInData_SC%NumCtrl2SC = 0 + Init%InData_SC%NumSC2Ctrl = 0 + Init%InData_SC%NumCtrl2SC = 0 END IF ! set up the data structures for integration with supercontroller - CALL Init_SC( InitInData_SC, SC, ErrStat2, ErrMsg2 ) + CALL Init_SC( Init%InData_SC, SC, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF (ErrStat >= AbortErrLev) THEN @@ -690,7 +641,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, IF ( p_FAST%CompAero == Module_AD14 ) THEN IF (AD14%p%DynInfl) THEN - IF ( InitOutData_IfW%WindFileInfo%MWS < 8.0 ) 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 @@ -709,29 +660,29 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, END IF IF ( p_FAST%CompServo == Module_SrvD ) THEN - InitInData_SrvD%InputFile = p_FAST%ServoFile - InitInData_SrvD%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_SrvD)) - InitInData_SrvD%NumBl = InitOutData_ED%NumBl - InitInData_SrvD%gravity = InitOutData_ED%gravity - InitInData_SrvD%r_N_O_G = ED%Input(1)%NacelleLoads%Position(:,1) - InitInData_SrvD%r_TwrBase = InitOutData_ED%TwrBasePos - InitInData_SrvD%TMax = p_FAST%TMax - InitInData_SrvD%AirDens = AirDens - InitInData_SrvD%AvgWindSpeed = InitOutData_IfW%WindFileInfo%MWS - InitInData_SrvD%Linearize = p_FAST%Linearize - InitInData_SrvD%TrimCase = p_FAST%TrimCase - InitInData_SrvD%TrimGain = p_FAST%TrimGain - InitInData_SrvD%RotSpeedRef = InitOutData_ED%RotSpeed + Init%InData_SrvD%InputFile = p_FAST%ServoFile + Init%InData_SrvD%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_SrvD)) + Init%InData_SrvD%NumBl = Init%OutData_ED%NumBl + Init%InData_SrvD%gravity = Init%OutData_ED%gravity + Init%InData_SrvD%r_N_O_G = ED%Input(1)%NacelleLoads%Position(:,1) + Init%InData_SrvD%r_TwrBase = Init%OutData_ED%TwrBasePos + Init%InData_SrvD%TMax = p_FAST%TMax + Init%InData_SrvD%AirDens = AirDens + Init%InData_SrvD%AvgWindSpeed = Init%OutData_IfW%WindFileInfo%MWS + Init%InData_SrvD%Linearize = p_FAST%Linearize + Init%InData_SrvD%TrimCase = p_FAST%TrimCase + Init%InData_SrvD%TrimGain = p_FAST%TrimGain + Init%InData_SrvD%RotSpeedRef = Init%OutData_ED%RotSpeed IF ( PRESENT(ExternInitData) ) THEN - InitInData_SrvD%NumSC2Ctrl = ExternInitData%NumSC2Ctrl - InitInData_SrvD%NumCtrl2SC = ExternInitData%NumCtrl2SC + Init%InData_SrvD%NumSC2Ctrl = ExternInitData%NumSC2Ctrl + Init%InData_SrvD%NumCtrl2SC = ExternInitData%NumCtrl2SC ELSE - InitInData_SrvD%NumSC2Ctrl = 0 - InitInData_SrvD%NumCtrl2SC = 0 + Init%InData_SrvD%NumSC2Ctrl = 0 + Init%InData_SrvD%NumCtrl2SC = 0 END IF - CALL AllocAry(InitInData_SrvD%BlPitchInit, InitOutData_ED%NumBl, 'BlPitchInit', ErrStat2, ErrMsg2) + 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 @@ -739,13 +690,13 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, RETURN end if - InitInData_SrvD%BlPitchInit = InitOutData_ED%BlPitch - CALL SrvD_Init( InitInData_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 ), InitOutData_SrvD, ErrStat2, ErrMsg2 ) + Init%InData_SrvD%BlPitchInit = Init%OutData_ED%BlPitch + CALL SrvD_Init( Init%InData_SrvD, SrvD%Input(1), SrvD%p, SrvD%x(STATE_CURR), SrvD%xd(STATE_CURR), SrvD%z(STATE_CURR), & + SrvD%OtherSt(STATE_CURR), SrvD%y, SrvD%m, p_FAST%dt_module( MODULE_SrvD ), Init%OutData_SrvD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) p_FAST%ModuleInitialized(Module_SrvD) = .TRUE. - !IF ( InitOutData_SrvD%CouplingScheme == ExplicitLoose ) THEN ... bjj: abort if we're doing anything else! + !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) @@ -756,13 +707,13 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, if (ErrStat2 /= 0 ) then call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(SrvD).", ErrStat, ErrMsg, RoutineName ) else - if (allocated(InitOutData_SrvD%LinNames_y)) call move_alloc(InitOutData_SrvD%LinNames_y,y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%Names_y ) - if (allocated(InitOutData_SrvD%LinNames_u)) call move_alloc(InitOutData_SrvD%LinNames_u,y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%Names_u ) - if (allocated(InitOutData_SrvD%RotFrame_y)) call move_alloc(InitOutData_SrvD%RotFrame_y,y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%RotFrame_y ) - if (allocated(InitOutData_SrvD%RotFrame_u)) call move_alloc(InitOutData_SrvD%RotFrame_u,y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%RotFrame_u ) - if (allocated(InitOutData_SrvD%IsLoad_u )) call move_alloc(InitOutData_SrvD%IsLoad_u ,y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%IsLoad_u ) + 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%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%IsLoad_u )) call move_alloc(Init%OutData_SrvD%IsLoad_u ,y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%IsLoad_u ) - if (allocated(InitOutData_SrvD%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%NumOutputs = size(InitOutData_SrvD%WriteOutputHdr) + 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 @@ -776,7 +727,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! ........................ ! bjj: this is a hack to get high-speed shaft braking in FAST v8 - IF ( InitOutData_SrvD%UseHSSBrake ) THEN + IF ( Init%OutData_SrvD%UseHSSBrake ) THEN IF ( p_FAST%CompAero == Module_AD14 ) THEN IF ( AD14%p%DYNINFL ) THEN CALL SetErrStat(ErrID_Fatal,'AeroDyn v14 "DYNINFL" InfModel is invalid for models with high-speed shaft braking.',ErrStat,ErrMsg,RoutineName) @@ -787,7 +738,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, IF ( ED%p%method == Method_RK4 ) THEN ! bjj: should be using ElastoDyn's Method_ABM4 Method_AB4 parameters CALL SetErrStat(ErrID_Fatal,'ElastoDyn must use the AB4 or ABM4 integration method to implement high-speed shaft braking.',ErrStat,ErrMsg,RoutineName) ENDIF - END IF ! InitOutData_SrvD%UseHSSBrake + END IF ! Init%OutData_SrvD%UseHSSBrake END IF @@ -798,7 +749,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! get wave elevation data for visualization if ( p_FAST%WrVTK > VTK_None ) then - call SetVTKParameters_B4HD(p_FAST, InitOutData_ED, InitInData_HD, BD, ErrStat2, ErrMsg2) + call SetVTKParameters_B4HD(p_FAST, Init%OutData_ED, Init%InData_HD, BD, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF (ErrStat >= AbortErrLev) THEN CALL Cleanup() @@ -819,20 +770,20 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, IF ( p_FAST%CompHydro == Module_HD ) THEN - InitInData_HD%Gravity = InitOutData_ED%Gravity - InitInData_HD%UseInputFile = .TRUE. - InitInData_HD%InputFile = p_FAST%HydroFile - InitInData_HD%OutRootName = p_FAST%OutFileRoot - InitInData_HD%TMax = p_FAST%TMax - InitInData_HD%hasIce = p_FAST%CompIce /= Module_None - InitInData_HD%Linearize = p_FAST%Linearize + Init%InData_HD%Gravity = Init%OutData_ED%Gravity + Init%InData_HD%UseInputFile = .TRUE. + Init%InData_HD%InputFile = p_FAST%HydroFile + Init%InData_HD%OutRootName = p_FAST%OutFileRoot + Init%InData_HD%TMax = p_FAST%TMax + Init%InData_HD%hasIce = p_FAST%CompIce /= Module_None + Init%InData_HD%Linearize = p_FAST%Linearize ! if wave field needs an offset, modify these values (added at request of SOWFA developers): - InitInData_HD%PtfmLocationX = p_FAST%TurbinePos(1) - InitInData_HD%PtfmLocationY = p_FAST%TurbinePos(2) + Init%InData_HD%PtfmLocationX = p_FAST%TurbinePos(1) + Init%InData_HD%PtfmLocationY = p_FAST%TurbinePos(2) - CALL HydroDyn_Init( InitInData_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 ), InitOutData_HD, ErrStat2, ErrMsg2 ) + 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. @@ -843,16 +794,16 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, if (ErrStat2 /= 0 ) then call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(HD).", ErrStat, ErrMsg, RoutineName ) else - if (allocated(InitOutData_HD%LinNames_y)) call move_alloc(InitOutData_HD%LinNames_y,y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%Names_y ) - if (allocated(InitOutData_HD%LinNames_u)) call move_alloc(InitOutData_HD%LinNames_u,y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%Names_u ) - if (allocated(InitOutData_HD%LinNames_x)) call move_alloc(InitOutData_HD%LinNames_x, y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%Names_x ) + 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 ) ! LIN-TODO: Determine if we need to create this data even though we don't have rotating frames in HD - !if (allocated(InitOutData_HD%RotFrame_y)) call move_alloc(InitOutData_HD%RotFrame_y,y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%RotFrame_y ) - !if (allocated(InitOutData_HD%RotFrame_u)) call move_alloc(InitOutData_HD%RotFrame_u,y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%RotFrame_u ) - if (allocated(InitOutData_HD%DerivOrder_x)) call move_alloc(InitOutData_HD%DerivOrder_x,y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%DerivOrder_x) - if (allocated(InitOutData_HD%IsLoad_u )) call move_alloc(InitOutData_HD%IsLoad_u ,y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%IsLoad_u ) + !if (allocated(Init%OutData_HD%RotFrame_y)) call move_alloc(Init%OutData_HD%RotFrame_y,y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%RotFrame_y ) + !if (allocated(Init%OutData_HD%RotFrame_u)) call move_alloc(Init%OutData_HD%RotFrame_u,y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%RotFrame_u ) + 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(InitOutData_HD%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%NumOutputs = size(InitOutData_HD%WriteOutputHdr) + if (allocated(Init%OutData_HD%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%NumOutputs = size(Init%OutData_HD%WriteOutputHdr) end if IF (ErrStat >= AbortErrLev) THEN @@ -881,21 +832,21 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, IF ( p_FAST%CompSub == Module_SD ) THEN IF ( p_FAST%CompHydro == Module_HD ) THEN - InitInData_SD%WtrDpth = InitOutData_HD%WtrDpth + Init%InData_SD%WtrDpth = Init%OutData_HD%WtrDpth ELSE - InitInData_SD%WtrDpth = 0.0_ReKi + Init%InData_SD%WtrDpth = 0.0_ReKi END IF - InitInData_SD%g = InitOutData_ED%Gravity - !InitInData_SD%UseInputFile = .TRUE. - InitInData_SD%SDInputFile = p_FAST%SubFile - InitInData_SD%RootName = p_FAST%OutFileRoot - InitInData_SD%TP_RefPoint = ED%y%PlatformPtMesh%Position(:,1) ! bjj: not sure what this is supposed to be - InitInData_SD%SubRotateZ = 0.0 ! bjj: not sure what this is supposed to be + Init%InData_SD%g = Init%OutData_ED%Gravity + !Init%InData_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) ! bjj: not sure what this is supposed to be + Init%InData_SD%SubRotateZ = 0.0 ! bjj: not sure what this is supposed to be - CALL SD_Init( InitInData_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 ), InitOutData_SD, ErrStat2, ErrMsg2 ) + CALL SD_Init( Init%InData_SD, SD%Input(1), SD%p, SD%x(STATE_CURR), SD%xd(STATE_CURR), SD%z(STATE_CURR), & + SD%OtherSt(STATE_CURR), SD%y, SD%m, p_FAST%dt_module( MODULE_SD ), Init%OutData_SD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) p_FAST%ModuleInitialized(Module_SD) = .TRUE. @@ -908,14 +859,14 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, END IF ELSE IF ( p_FAST%CompSub == Module_ExtPtfm ) THEN - InitInData_ExtPtfm%InputFile = p_FAST%SubFile -! InitInData_ExtPtfm%RootName = trim(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_ExtPtfm)) - InitInData_ExtPtfm%Linearize = p_FAST%Linearize + Init%InData_ExtPtfm%InputFile = p_FAST%SubFile +! Init%InData_ExtPtfm%RootName = trim(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_ExtPtfm)) + Init%InData_ExtPtfm%Linearize = p_FAST%Linearize - CALL ExtPtfm_Init( InitInData_ExtPtfm, ExtPtfm%Input(1), ExtPtfm%p, & + 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 ), InitOutData_ExtPtfm, ErrStat2, ErrMsg2 ) + ExtPtfm%y, ExtPtfm%m, p_FAST%dt_module( MODULE_ExtPtfm ), Init%OutData_ExtPtfm, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) p_FAST%ModuleInitialized(MODULE_ExtPtfm) = .TRUE. @@ -966,20 +917,20 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, CALL WrScr(NewLine) !bjj: I'm printing two blank lines here because MAP seems to be writing over the last line on the screen. -! InitInData_MAP%rootname = p_FAST%OutFileRoot ! Output file name - InitInData_MAP%gravity = InitOutData_ED%Gravity ! This need to be according to g used in ElastoDyn - InitInData_MAP%sea_density = InitOutData_HD%WtrDens ! This needs to be set according to seawater density in HydroDyn - InitInData_MAP%depth = InitOutData_HD%WtrDpth ! This need to be set according to the water depth in HydroDyn +! Init%InData_MAP%rootname = p_FAST%OutFileRoot ! Output file name + Init%InData_MAP%gravity = Init%OutData_ED%Gravity ! This need to be according to g used in ElastoDyn + Init%InData_MAP%sea_density = Init%OutData_HD%WtrDens ! This needs to be set according to seawater density in HydroDyn + Init%InData_MAP%depth = Init%OutData_HD%WtrDpth ! This need to be set according to the water depth in HydroDyn ! differences for MAP++ - InitInData_MAP%file_name = p_FAST%MooringFile ! This needs to be set according to what is in the FAST input file. - InitInData_MAP%summary_file_name = TRIM(p_FAST%OutFileRoot)//'.MAP.sum' ! Output file name - InitInData_MAP%depth = -InitOutData_HD%WtrDpth ! This need to be set according to the water depth in HydroDyn + 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_HD%WtrDpth ! This need to be set according to the water depth in HydroDyn - InitInData_MAP%LinInitInp%Linearize = p_FAST%Linearize + Init%InData_MAP%LinInitInp%Linearize = p_FAST%Linearize - CALL MAP_Init( InitInData_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 ), InitOutData_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, p_FAST%dt_module( MODULE_MAP ), Init%OutData_MAP, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) p_FAST%ModuleInitialized(Module_MAP) = .TRUE. @@ -990,14 +941,14 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, if (ErrStat2 /= 0 ) then call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(MAP).", ErrStat, ErrMsg, RoutineName ) else - if (allocated(InitOutData_MAP%LinInitOut%LinNames_y)) call move_alloc(InitOutData_MAP%LinInitOut%LinNames_y,y_FAST%Lin%Modules(Module_MAP)%Instance(1)%Names_y ) - if (allocated(InitOutData_MAP%LinInitOut%LinNames_u)) call move_alloc(InitOutData_MAP%LinInitOut%LinNames_u,y_FAST%Lin%Modules(Module_MAP)%Instance(1)%Names_u ) + 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 ) ! LIN-TODO: Determine if we need to create this data even though we don't have rotating frames in MAP - !if (allocated(InitOutData_MAP%LinInitOut%RotFrame_y)) call move_alloc(InitOutData_MAP%LinInitOut%RotFrame_y,y_FAST%Lin%Modules(Module_MAP)%Instance(1)%RotFrame_y ) - !if (allocated(InitOutData_MAP%LinInitOut%RotFrame_u)) call move_alloc(InitOutData_MAP%LinInitOut%RotFrame_u,y_FAST%Lin%Modules(Module_MAP)%Instance(1)%RotFrame_u ) - if (allocated(InitOutData_MAP%LinInitOut%IsLoad_u )) call move_alloc(InitOutData_MAP%LinInitOut%IsLoad_u ,y_FAST%Lin%Modules(Module_MAP)%Instance(1)%IsLoad_u ) + !if (allocated(Init%OutData_MAP%LinInitOut%RotFrame_y)) call move_alloc(Init%OutData_MAP%LinInitOut%RotFrame_y,y_FAST%Lin%Modules(Module_MAP)%Instance(1)%RotFrame_y ) + !if (allocated(Init%OutData_MAP%LinInitOut%RotFrame_u)) call move_alloc(Init%OutData_MAP%LinInitOut%RotFrame_u,y_FAST%Lin%Modules(Module_MAP)%Instance(1)%RotFrame_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(InitOutData_MAP%WriteOutputHdr)) y_FAST%Lin%Modules(Module_MAP)%Instance(1)%NumOutputs = size(InitOutData_MAP%WriteOutputHdr) + if (allocated(Init%OutData_MAP%WriteOutputHdr)) y_FAST%Lin%Modules(Module_MAP)%Instance(1)%NumOutputs = size(Init%OutData_MAP%WriteOutputHdr) end if IF (ErrStat >= AbortErrLev) THEN @@ -1009,16 +960,16 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! ........................ ELSEIF (p_FAST%CompMooring == Module_MD) THEN - InitInData_MD%FileName = p_FAST%MooringFile ! This needs to be set according to what is in the FAST input file. - InitInData_MD%RootName = p_FAST%OutFileRoot + 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 - InitInData_MD%PtfmInit = InitOutData_ED%PlatformPos !ED%x(STATE_CURR)%QT(1:6) ! initial position of the platform !bjj: this should come from InitOutData_ED, not x_ED - InitInData_MD%g = InitOutData_ED%Gravity ! This need to be according to g used in ElastoDyn - InitInData_MD%rhoW = InitOutData_HD%WtrDens ! This needs to be set according to seawater density in HydroDyn - InitInData_MD%WtrDepth = InitOutData_HD%WtrDpth ! This need to be set according to the water depth in HydroDyn + Init%InData_MD%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_MD%g = Init%OutData_ED%Gravity ! This need to be according to g used in ElastoDyn + Init%InData_MD%rhoW = Init%OutData_HD%WtrDens ! This needs to be set according to seawater density in HydroDyn + Init%InData_MD%WtrDepth = Init%OutData_HD%WtrDpth ! This need to be set according to the water depth in HydroDyn - CALL MD_Init( InitInData_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 ), InitOutData_MD, ErrStat2, ErrMsg2 ) + CALL MD_Init( Init%InData_MD, MD%Input(1), MD%p, MD%x(STATE_CURR), MD%xd(STATE_CURR), MD%z(STATE_CURR), & + MD%OtherSt(STATE_CURR), MD%y, MD%m, p_FAST%dt_module( MODULE_MD ), Init%OutData_MD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) p_FAST%ModuleInitialized(Module_MD) = .TRUE. @@ -1034,17 +985,17 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! ........................ ELSEIF (p_FAST%CompMooring == Module_FEAM) THEN - InitInData_FEAM%InputFile = p_FAST%MooringFile ! This needs to be set according to what is in the FAST input file. - InitInData_FEAM%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_FEAM)) - - InitInData_FEAM%PtfmInit = InitOutData_ED%PlatformPos !ED%x(STATE_CURR)%QT(1:6) ! initial position of the platform !bjj: this should come from InitOutData_ED, not x_ED - InitInData_FEAM%NStepWave = 1 ! an arbitrary number > 0 (to set the size of the wave data, which currently contains all zero values) - InitInData_FEAM%gravity = InitOutData_ED%Gravity ! This need to be according to g used in ElastoDyn - InitInData_FEAM%WtrDens = InitOutData_HD%WtrDens ! This needs to be set according to seawater density in HydroDyn -! InitInData_FEAM%depth = InitOutData_HD%WtrDpth ! This need to be set according to the water depth in HydroDyn + 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 = Init%OutData_ED%Gravity ! This need to be according to g used in ElastoDyn + Init%InData_FEAM%WtrDens = Init%OutData_HD%WtrDens ! This needs to be set according to seawater density in HydroDyn +! Init%InData_FEAM%depth = Init%OutData_HD%WtrDpth ! This need to be set according to the water depth in HydroDyn - CALL FEAM_Init( InitInData_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 ), InitOutData_FEAM, ErrStat2, ErrMsg2 ) + CALL FEAM_Init( Init%InData_FEAM, FEAM%Input(1), FEAM%p, FEAM%x(STATE_CURR), FEAM%xd(STATE_CURR), FEAM%z(STATE_CURR), & + FEAM%OtherSt(STATE_CURR), FEAM%y, FEAM%m, p_FAST%dt_module( MODULE_FEAM ), Init%OutData_FEAM, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) p_FAST%ModuleInitialized(Module_FEAM) = .TRUE. @@ -1060,12 +1011,12 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! ........................ ELSEIF (p_FAST%CompMooring == Module_Orca) THEN - InitInData_Orca%InputFile = p_FAST%MooringFile - InitInData_Orca%RootName = p_FAST%OutFileRoot - InitInData_Orca%TMax = p_FAST%TMax + Init%InData_Orca%InputFile = p_FAST%MooringFile + Init%InData_Orca%RootName = p_FAST%OutFileRoot + Init%InData_Orca%TMax = p_FAST%TMax - CALL Orca_Init( InitInData_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 ), InitOutData_Orca, ErrStat2, ErrMsg2 ) + CALL Orca_Init( Init%InData_Orca, Orca%Input(1), Orca%p, Orca%x(STATE_CURR), Orca%xd(STATE_CURR), Orca%z(STATE_CURR), Orca%OtherSt(STATE_CURR), & + Orca%y, Orca%m, p_FAST%dt_module( MODULE_Orca ), Init%OutData_Orca, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) p_FAST%ModuleInitialized(MODULE_Orca) = .TRUE. @@ -1126,14 +1077,14 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! ........................ IF ( p_FAST%CompIce == Module_IceF ) THEN - InitInData_IceF%InputFile = p_FAST%IceFile - InitInData_IceF%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_IceF)) - InitInData_IceF%simLength = p_FAST%TMax !bjj: IceFloe stores this as single-precision (ReKi) TMax is DbKi - InitInData_IceF%MSL2SWL = InitOutData_HD%MSL2SWL - InitInData_IceF%gravity = InitOutData_ED%Gravity - - CALL IceFloe_Init( InitInData_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 ), InitOutData_IceF, ErrStat2, ErrMsg2 ) + Init%InData_IceF%InputFile = p_FAST%IceFile + Init%InData_IceF%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_IceF)) + Init%InData_IceF%simLength = p_FAST%TMax !bjj: IceFloe stores this as single-precision (ReKi) TMax is DbKi + Init%InData_IceF%MSL2SWL = Init%OutData_HD%MSL2SWL + Init%InData_IceF%gravity = Init%OutData_ED%Gravity + + CALL IceFloe_Init( Init%InData_IceF, IceF%Input(1), IceF%p, IceF%x(STATE_CURR), IceF%xd(STATE_CURR), IceF%z(STATE_CURR), & + IceF%OtherSt(STATE_CURR), IceF%y, IceF%m, p_FAST%dt_module( MODULE_IceF ), Init%OutData_IceF, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) p_FAST%ModuleInitialized(Module_IceF) = .TRUE. @@ -1149,16 +1100,16 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! ........................ ELSEIF ( p_FAST%CompIce == Module_IceD ) THEN - InitInData_IceD%InputFile = p_FAST%IceFile - InitInData_IceD%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_IceD))//'1' - InitInData_IceD%MSL2SWL = InitOutData_HD%MSL2SWL - InitInData_IceD%WtrDens = InitOutData_HD%WtrDens - InitInData_IceD%gravity = InitOutData_ED%Gravity - InitInData_IceD%TMax = p_FAST%TMax - InitInData_IceD%LegNum = 1 + Init%InData_IceD%InputFile = p_FAST%IceFile + Init%InData_IceD%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_IceD))//'1' + Init%InData_IceD%MSL2SWL = Init%OutData_HD%MSL2SWL + Init%InData_IceD%WtrDens = Init%OutData_HD%WtrDens + Init%InData_IceD%gravity = Init%OutData_ED%Gravity + Init%InData_IceD%TMax = p_FAST%TMax + Init%InData_IceD%LegNum = 1 - CALL IceD_Init( InitInData_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 ), InitOutData_IceD, ErrStat2, ErrMsg2 ) + CALL IceD_Init( Init%InData_IceD, IceD%Input(1,1), IceD%p(1), IceD%x(1,STATE_CURR), IceD%xd(1,STATE_CURR), IceD%z(1,STATE_CURR), & + IceD%OtherSt(1,STATE_CURR), IceD%y(1), IceD%m(1), p_FAST%dt_module( MODULE_IceD ), Init%OutData_IceD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) p_FAST%ModuleInitialized(Module_IceD) = .TRUE. @@ -1167,7 +1118,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! now initialize IceD for additional legs (if necessary) dt_IceD = p_FAST%dt_module( MODULE_IceD ) - p_FAST%numIceLegs = InitOutData_IceD%numLegs + p_FAST%numIceLegs = Init%OutData_IceD%numLegs IF (p_FAST%numIceLegs > IceD_MaxLegs) THEN CALL SetErrStat(ErrID_Fatal,'IceDyn-FAST coupling is supported for up to '//TRIM(Num2LStr(IceD_MaxLegs))//' legs, but ' & @@ -1176,11 +1127,11 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, 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 - InitInData_IceD%LegNum = i - InitInData_IceD%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_IceD))//TRIM(Num2LStr(i)) + 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( InitInData_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, InitOutData_IceD, ErrStat2, ErrMsg2 ) + CALL IceD_Init( Init%InData_IceD, IceD%Input(1,i), IceD%p(i), IceD%x(i,STATE_CURR), IceD%xd(i,STATE_CURR), IceD%z(i,STATE_CURR), & + IceD%OtherSt(i,STATE_CURR), IceD%y(i), IceD%m(i), dt_IceD, Init%OutData_IceD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) !bjj: we're going to force this to have the same timestep because I don't want to have to deal with n IceD modules with n timesteps. @@ -1201,9 +1152,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! 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, InitOutData_ED, InitOutData_BD, InitOutData_SrvD, InitOutData_AD14, InitOutData_AD, & - InitOutData_IfW, InitOutData_OpFM, InitOutData_HD, InitOutData_SD, InitOutData_ExtPtfm, InitOutData_MAP, & - InitOutData_FEAM, InitOutData_MD, InitOutData_Orca, InitOutData_IceF, InitOutData_IceD, ErrStat2, ErrMsg2 ) + CALL FAST_InitOutput( p_FAST, y_FAST, Init, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) @@ -1228,7 +1177,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! Initialize for linearization: ! ------------------------------------------------------------------------- if ( p_FAST%Linearize ) then - call Init_Lin(p_FAST, y_FAST, m_FAST, AD, ED, InitOutData_ED%NumBl, ErrStat2, ErrMsg2) + call Init_Lin(p_FAST, y_FAST, m_FAST, AD, ED, Init%OutData_ED%NumBl, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if (ErrStat >= AbortErrLev) then @@ -1242,7 +1191,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! Initialize data for VTK output ! ------------------------------------------------------------------------- if ( p_FAST%WrVTK > VTK_None ) then - call SetVTKParameters(p_FAST, InitOutData_ED, InitOutData_AD, InitInData_HD, InitOutData_HD, ED, BD, AD, HD, ErrStat2, ErrMsg2) + call SetVTKParameters(p_FAST, Init%OutData_ED, Init%OutData_AD, Init%InData_HD, Init%OutData_HD, ED, BD, AD, HD, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) end if @@ -1287,92 +1236,9 @@ SUBROUTINE Cleanup() !............................................................................................................................... ! Destroy initializion data !............................................................................................................................... - - CALL ED_DestroyInitInput( InitInData_ED, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL ED_DestroyInitOutput( InitOutData_ED, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - CALL BD_DestroyInitInput( InitInData_BD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - IF (ALLOCATED(InitOutData_BD)) THEN - DO i=1,p_FAST%nBeams - CALL BD_DestroyInitOutput( InitOutData_BD(i), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - END DO - DEALLOCATE(InitOutData_BD) - END IF - - CALL AD14_DestroyInitInput( InitInData_AD14, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL AD14_DestroyInitOutput( InitOutData_AD14, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - CALL AD_DestroyInitInput( InitInData_AD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL AD_DestroyInitOutput( InitOutData_AD, ErrStat2, ErrMsg2 ) + CALL FAST_DestroyInitData( Init, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL InflowWind_DestroyInitInput( InitInData_IfW, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL InflowWind_DestroyInitOutput( InitOutData_IfW, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - CALL OpFM_DestroyInitInput( InitInData_OpFM, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL OpFM_DestroyInitOutput( InitOutData_OpFM, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - CALL SrvD_DestroyInitInput( InitInData_SrvD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL SrvD_DestroyInitOutput( InitOutData_SrvD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - CALL HydroDyn_DestroyInitInput( InitInData_HD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL HydroDyn_DestroyInitOutput( InitOutData_HD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - CALL SD_DestroyInitInput( InitInData_SD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL SD_DestroyInitOutput( InitOutData_SD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - CALL ExtPtfm_DestroyInitInput( InitInData_ExtPtfm, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL ExtPtfm_DestroyInitOutput( InitOutData_ExtPtfm, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - CALL MAP_DestroyInitInput( InitInData_MAP, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL MAP_DestroyInitOutput( InitOutData_MAP, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - CALL FEAM_DestroyInitInput( InitInData_FEAM, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL FEAM_DestroyInitOutput( InitOutData_FEAM, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - CALL MD_DestroyInitInput( InitInData_MD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL MD_DestroyInitOutput( InitOutData_MD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - CALL Orca_DestroyInitInput( InitInData_Orca, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL Orca_DestroyInitOutput( InitOutData_Orca, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - CALL IceFloe_DestroyInitInput( InitInData_IceF, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL IceFloe_DestroyInitOutput( InitOutData_IceF, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - CALL IceD_DestroyInitInput( InitInData_IceD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL IceD_DestroyInitOutput( InitOutData_IceD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - END SUBROUTINE Cleanup END SUBROUTINE FAST_InitializeAll @@ -1824,33 +1690,14 @@ SUBROUTINE ValidateInputData(p, m_FAST, ErrStat, ErrMsg) END SUBROUTINE ValidateInputData !---------------------------------------------------------------------------------------------------------------------------------- !> This routine initializes the output for the glue code, including writing the header for the primary output file. -SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, InitOutData_ED, InitOutData_BD, InitOutData_SrvD, & - InitOutData_AD14, InitOutData_AD, & - InitOutData_IfW, InitOutData_OpFM, InitOutData_HD, InitOutData_SD, InitOutData_ExtPtfm, InitOutData_MAP, & - InitOutData_FEAM, InitOutData_MD, InitOutData_Orca, InitOutData_IceF, InitOutData_IceD, ErrStat, ErrMsg ) +SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, Init, ErrStat, ErrMsg ) IMPLICIT NONE ! Passed variables TYPE(FAST_ParameterType), INTENT(IN) :: p_FAST !< Glue-code simulation parameters TYPE(FAST_OutputFileType), INTENT(INOUT) :: y_FAST !< Glue-code simulation outputs - - TYPE(ED_InitOutputType), INTENT(IN) :: InitOutData_ED !< Initialization output for ElastoDyn - TYPE(BD_InitOutputType), INTENT(IN) :: InitOutData_BD(:) !< Initialization output for BeamDyn (each instance) - TYPE(SrvD_InitOutputType), INTENT(IN) :: InitOutData_SrvD !< Initialization output for ServoDyn - TYPE(AD14_InitOutputType), INTENT(IN) :: InitOutData_AD14 !< Initialization output for AeroDyn14 - TYPE(AD_InitOutputType), INTENT(IN) :: InitOutData_AD !< Initialization output for AeroDyn - TYPE(InflowWind_InitOutputType),INTENT(IN) :: InitOutData_IfW !< Initialization output for InflowWind - TYPE(OpFM_InitOutputType), INTENT(IN) :: InitOutData_OpFM !< Initialization output for OpenFOAM - TYPE(HydroDyn_InitOutputType), INTENT(IN) :: InitOutData_HD !< Initialization output for HydroDyn - TYPE(SD_InitOutputType), INTENT(IN) :: InitOutData_SD !< Initialization output for SubDyn - TYPE(ExtPtfm_InitOutputType), INTENT(IN) :: InitOutData_ExtPtfm !< Initialization output for ExtPtfm_MCKF - TYPE(MAP_InitOutputType), INTENT(IN) :: InitOutData_MAP !< Initialization output for MAP - TYPE(Orca_InitOutputType), INTENT(IN) :: InitOutData_Orca !< Initialization output for OrcaFlex interface - TYPE(FEAM_InitOutputType), INTENT(IN) :: InitOutData_FEAM !< Initialization output for FEAMooring - TYPE(MD_InitOutputType), INTENT(IN) :: InitOutData_MD !< Initialization output for MoorDyn - TYPE(IceFloe_InitOutputType), INTENT(IN) :: InitOutData_IceF !< Initialization output for IceFloe - TYPE(IceD_InitOutputType), INTENT(IN) :: InitOutData_IceD !< Initialization output for IceDyn + TYPE(FAST_InitData), INTENT(IN) :: Init !< Initialization data for all modules INTEGER(IntKi), INTENT(OUT) :: ErrStat !< Error status CHARACTER(*), INTENT(OUT) :: ErrMsg !< Error message corresponding to ErrStat @@ -1876,68 +1723,68 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, InitOutData_ED, InitOutData_BD, Init ! and save the module version info for later use, too: !...................................................... - y_FAST%Module_Ver( Module_ED ) = InitOutData_ED%Ver + y_FAST%Module_Ver( Module_ED ) = Init%OutData_ED%Ver y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_ED ) )) IF ( p_FAST%CompElast == Module_BD ) THEN - y_FAST%Module_Ver( Module_BD ) = InitOutData_BD(1)%Ver ! call copy routine for this type if it every uses dynamic memory + y_FAST%Module_Ver( Module_BD ) = Init%OutData_BD(1)%Ver ! call copy routine for this type if it every uses dynamic memory y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_BD ))) END IF IF ( p_FAST%CompInflow == Module_IfW ) THEN - y_FAST%Module_Ver( Module_IfW ) = InitOutData_IfW%Ver ! call copy routine for this type if it every uses dynamic memory + y_FAST%Module_Ver( Module_IfW ) = Init%OutData_IfW%Ver ! call copy routine for this type if it every uses dynamic memory y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_IfW ))) ELSEIF ( p_FAST%CompInflow == Module_OpFM ) THEN - y_FAST%Module_Ver( Module_OpFM ) = InitOutData_OpFM%Ver ! call copy routine for this type if it every uses dynamic memory + y_FAST%Module_Ver( Module_OpFM ) = Init%OutData_OpFM%Ver ! call copy routine for this type if it every uses dynamic memory y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_OpFM ))) END IF IF ( p_FAST%CompAero == Module_AD14 ) THEN - y_FAST%Module_Ver( Module_AD14 ) = InitOutData_AD14%Ver + y_FAST%Module_Ver( Module_AD14 ) = Init%OutData_AD14%Ver y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_AD14 ) )) ELSEIF ( p_FAST%CompAero == Module_AD ) THEN - y_FAST%Module_Ver( Module_AD ) = InitOutData_AD%Ver + y_FAST%Module_Ver( Module_AD ) = Init%OutData_AD%Ver y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_AD ) )) END IF IF ( p_FAST%CompServo == Module_SrvD ) THEN - y_FAST%Module_Ver( Module_SrvD ) = InitOutData_SrvD%Ver + y_FAST%Module_Ver( Module_SrvD ) = Init%OutData_SrvD%Ver y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_SrvD ))) END IF IF ( p_FAST%CompHydro == Module_HD ) THEN - y_FAST%Module_Ver( Module_HD ) = InitOutData_HD%Ver + y_FAST%Module_Ver( Module_HD ) = Init%OutData_HD%Ver y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_HD ))) END IF IF ( p_FAST%CompSub == Module_SD ) THEN - y_FAST%Module_Ver( Module_SD ) = InitOutData_SD%Ver + y_FAST%Module_Ver( Module_SD ) = Init%OutData_SD%Ver y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_SD ))) ELSE IF ( p_FAST%CompSub == Module_ExtPtfm ) THEN - y_FAST%Module_Ver( Module_ExtPtfm ) = InitOutData_ExtPtfm%Ver + y_FAST%Module_Ver( Module_ExtPtfm ) = Init%OutData_ExtPtfm%Ver y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_ExtPtfm ))) END IF IF ( p_FAST%CompMooring == Module_MAP ) THEN - y_FAST%Module_Ver( Module_MAP ) = InitOutData_MAP%Ver + y_FAST%Module_Ver( Module_MAP ) = Init%OutData_MAP%Ver y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_MAP ))) ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN - y_FAST%Module_Ver( Module_MD ) = InitOutData_MD%Ver + y_FAST%Module_Ver( Module_MD ) = Init%OutData_MD%Ver y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_MD ))) ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN - y_FAST%Module_Ver( Module_FEAM ) = InitOutData_FEAM%Ver + y_FAST%Module_Ver( Module_FEAM ) = Init%OutData_FEAM%Ver y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_FEAM ))) ELSEIF ( p_FAST%CompMooring == Module_Orca ) THEN - y_FAST%Module_Ver( Module_Orca ) = InitOutData_Orca%Ver + y_FAST%Module_Ver( Module_Orca ) = Init%OutData_Orca%Ver y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_Orca))) END IF IF ( p_FAST%CompIce == Module_IceF ) THEN - y_FAST%Module_Ver( Module_IceF ) = InitOutData_IceF%Ver + y_FAST%Module_Ver( Module_IceF ) = Init%OutData_IceF%Ver y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_IceF ))) ELSEIF ( p_FAST%CompIce == Module_IceD ) THEN - y_FAST%Module_Ver( Module_IceD ) = InitOutData_IceD%Ver + y_FAST%Module_Ver( Module_IceD ) = Init%OutData_IceD%Ver y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_IceD ))) END IF @@ -1949,26 +1796,26 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, InitOutData_ED, InitOutData_BD, Init !y_FAST%numOuts(Module_InfW) = 3 !hack for now: always output 3 wind speeds at hub-height - IF ( ALLOCATED( InitOutData_IfW%WriteOutputHdr ) ) y_FAST%numOuts(Module_IfW) = SIZE(InitOutData_IfW%WriteOutputHdr) - IF ( ALLOCATED( InitOutData_OpFM%WriteOutputHdr ) ) y_FAST%numOuts(Module_OpFM) = SIZE(InitOutData_OpFM%WriteOutputHdr) - IF ( ALLOCATED( InitOutData_ED%WriteOutputHdr ) ) y_FAST%numOuts(Module_ED) = SIZE(InitOutData_ED%WriteOutputHdr) + IF ( ALLOCATED( Init%OutData_IfW%WriteOutputHdr ) ) y_FAST%numOuts(Module_IfW) = SIZE(Init%OutData_IfW%WriteOutputHdr) + IF ( ALLOCATED( Init%OutData_OpFM%WriteOutputHdr ) ) y_FAST%numOuts(Module_OpFM) = SIZE(Init%OutData_OpFM%WriteOutputHdr) + IF ( ALLOCATED( Init%OutData_ED%WriteOutputHdr ) ) y_FAST%numOuts(Module_ED) = SIZE(Init%OutData_ED%WriteOutputHdr) do i=1,p_FAST%nBeams - IF ( ALLOCATED( InitOutData_BD(i)%WriteOutputHdr) ) y_FAST%numOuts(Module_BD) = y_FAST%numOuts(Module_BD) + SIZE(InitOutData_BD(i)%WriteOutputHdr) + IF ( ALLOCATED( Init%OutData_BD(i)%WriteOutputHdr) ) y_FAST%numOuts(Module_BD) = y_FAST%numOuts(Module_BD) + SIZE(Init%OutData_BD(i)%WriteOutputHdr) end do !ad14 doesn't have outputs: y_FAST%numOuts(Module_AD14) = 0 - IF ( ALLOCATED( InitOutData_AD%WriteOutputHdr ) ) y_FAST%numOuts(Module_AD) = SIZE(InitOutData_AD%WriteOutputHdr) - IF ( ALLOCATED( InitOutData_SrvD%WriteOutputHdr ) ) y_FAST%numOuts(Module_SrvD) = SIZE(InitOutData_SrvD%WriteOutputHdr) - IF ( ALLOCATED( InitOutData_HD%WriteOutputHdr ) ) y_FAST%numOuts(Module_HD) = SIZE(InitOutData_HD%WriteOutputHdr) - IF ( ALLOCATED( InitOutData_SD%WriteOutputHdr ) ) y_FAST%numOuts(Module_SD) = SIZE(InitOutData_SD%WriteOutputHdr) - IF ( ALLOCATED( InitOutData_ExtPtfm%WriteOutputHdr) ) y_FAST%numOuts(Module_ExtPtfm)= SIZE(InitOutData_ExtPtfm%WriteOutputHdr) - IF ( ALLOCATED( InitOutData_MAP%WriteOutputHdr ) ) y_FAST%numOuts(Module_MAP) = SIZE(InitOutData_MAP%WriteOutputHdr) - IF ( ALLOCATED( InitOutData_FEAM%WriteOutputHdr ) ) y_FAST%numOuts(Module_FEAM) = SIZE(InitOutData_FEAM%WriteOutputHdr) - IF ( ALLOCATED( InitOutData_MD%WriteOutputHdr ) ) y_FAST%numOuts(Module_MD) = SIZE(InitOutData_MD%WriteOutputHdr) - IF ( ALLOCATED( InitOutData_Orca%WriteOutputHdr ) ) y_FAST%numOuts(Module_Orca) = SIZE(InitOutData_Orca%WriteOutputHdr) - IF ( ALLOCATED( InitOutData_IceF%WriteOutputHdr ) ) y_FAST%numOuts(Module_IceF) = SIZE(InitOutData_IceF%WriteOutputHdr) - IF ( ALLOCATED( InitOutData_IceD%WriteOutputHdr ) ) y_FAST%numOuts(Module_IceD) = SIZE(InitOutData_IceD%WriteOutputHdr)*p_FAST%numIceLegs + IF ( ALLOCATED( Init%OutData_AD%WriteOutputHdr ) ) y_FAST%numOuts(Module_AD) = SIZE(Init%OutData_AD%WriteOutputHdr) + IF ( ALLOCATED( Init%OutData_SrvD%WriteOutputHdr ) ) y_FAST%numOuts(Module_SrvD) = SIZE(Init%OutData_SrvD%WriteOutputHdr) + IF ( ALLOCATED( Init%OutData_HD%WriteOutputHdr ) ) y_FAST%numOuts(Module_HD) = SIZE(Init%OutData_HD%WriteOutputHdr) + IF ( ALLOCATED( Init%OutData_SD%WriteOutputHdr ) ) y_FAST%numOuts(Module_SD) = SIZE(Init%OutData_SD%WriteOutputHdr) + IF ( ALLOCATED( Init%OutData_ExtPtfm%WriteOutputHdr) ) y_FAST%numOuts(Module_ExtPtfm)= SIZE(Init%OutData_ExtPtfm%WriteOutputHdr) + IF ( ALLOCATED( Init%OutData_MAP%WriteOutputHdr ) ) y_FAST%numOuts(Module_MAP) = SIZE(Init%OutData_MAP%WriteOutputHdr) + IF ( ALLOCATED( Init%OutData_FEAM%WriteOutputHdr ) ) y_FAST%numOuts(Module_FEAM) = SIZE(Init%OutData_FEAM%WriteOutputHdr) + IF ( ALLOCATED( Init%OutData_MD%WriteOutputHdr ) ) y_FAST%numOuts(Module_MD) = SIZE(Init%OutData_MD%WriteOutputHdr) + IF ( ALLOCATED( Init%OutData_Orca%WriteOutputHdr ) ) y_FAST%numOuts(Module_Orca) = SIZE(Init%OutData_Orca%WriteOutputHdr) + IF ( ALLOCATED( Init%OutData_IceF%WriteOutputHdr ) ) y_FAST%numOuts(Module_IceF) = SIZE(Init%OutData_IceF%WriteOutputHdr) + IF ( ALLOCATED( Init%OutData_IceD%WriteOutputHdr ) ) y_FAST%numOuts(Module_IceD) = SIZE(Init%OutData_IceD%WriteOutputHdr)*p_FAST%numIceLegs !...................................................... ! Initialize the output channel names and units @@ -1985,29 +1832,29 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, InitOutData_ED, InitOutData_BD, Init indxNext = 2 DO i=1,y_FAST%numOuts(Module_IfW) !InflowWind - y_FAST%ChannelNames(indxNext) = InitOutData_IfW%WriteOutputHdr(i) - y_FAST%ChannelUnits(indxNext) = InitOutData_IfW%WriteOutputUnt(i) + y_FAST%ChannelNames(indxNext) = Init%OutData_IfW%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = Init%OutData_IfW%WriteOutputUnt(i) indxNext = indxNext + 1 END DO DO i=1,y_FAST%numOuts(Module_OpFM) !OpenFOAM - y_FAST%ChannelNames(indxNext) = InitOutData_OpFM%WriteOutputHdr(i) - y_FAST%ChannelUnits(indxNext) = InitOutData_OpFM%WriteOutputUnt(i) + y_FAST%ChannelNames(indxNext) = Init%OutData_OpFM%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = Init%OutData_OpFM%WriteOutputUnt(i) indxNext = indxNext + 1 END DO DO i=1,y_FAST%numOuts(Module_ED) !ElastoDyn - y_FAST%ChannelNames(indxNext) = InitOutData_ED%WriteOutputHdr(i) - y_FAST%ChannelUnits(indxNext) = InitOutData_ED%WriteOutputUnt(i) + y_FAST%ChannelNames(indxNext) = Init%OutData_ED%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = Init%OutData_ED%WriteOutputUnt(i) indxNext = indxNext + 1 END DO IF ( y_FAST%numOuts(Module_BD) > 0_IntKi ) THEN !BeamDyn do i=1,p_FAST%nBeams - if ( allocated(InitOutData_BD(i)%WriteOutputHdr) ) then - do j=1,size(InitOutData_BD(i)%WriteOutputHdr) - y_FAST%ChannelNames(indxNext) = 'B'//TRIM(Num2Lstr(i))//trim(InitOutData_BD(i)%WriteOutputHdr(j)) - y_FAST%ChannelUnits(indxNext) = InitOutData_BD(i)%WriteOutputUnt(j) + if ( allocated(Init%OutData_BD(i)%WriteOutputHdr) ) then + do j=1,size(Init%OutData_BD(i)%WriteOutputHdr) + y_FAST%ChannelNames(indxNext) = 'B'//TRIM(Num2Lstr(i))//trim(Init%OutData_BD(i)%WriteOutputHdr(j)) + y_FAST%ChannelUnits(indxNext) = Init%OutData_BD(i)%WriteOutputUnt(j) indxNext = indxNext + 1 end do ! j end if @@ -2018,70 +1865,70 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, InitOutData_ED, InitOutData_BD, Init ! none for AeroDyn14 DO i=1,y_FAST%numOuts(Module_AD) !AeroDyn - y_FAST%ChannelNames(indxNext) = InitOutData_AD%WriteOutputHdr(i) - y_FAST%ChannelUnits(indxNext) = InitOutData_AD%WriteOutputUnt(i) + y_FAST%ChannelNames(indxNext) = Init%OutData_AD%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = Init%OutData_AD%WriteOutputUnt(i) indxNext = indxNext + 1 END DO DO i=1,y_FAST%numOuts(Module_SrvD) !ServoDyn - y_FAST%ChannelNames(indxNext) = InitOutData_SrvD%WriteOutputHdr(i) - y_FAST%ChannelUnits(indxNext) = InitOutData_SrvD%WriteOutputUnt(i) + y_FAST%ChannelNames(indxNext) = Init%OutData_SrvD%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = Init%OutData_SrvD%WriteOutputUnt(i) indxNext = indxNext + 1 END DO DO i=1,y_FAST%numOuts(Module_HD) !HydroDyn - y_FAST%ChannelNames(indxNext) = InitOutData_HD%WriteOutputHdr(i) - y_FAST%ChannelUnits(indxNext) = InitOutData_HD%WriteOutputUnt(i) + y_FAST%ChannelNames(indxNext) = Init%OutData_HD%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = Init%OutData_HD%WriteOutputUnt(i) indxNext = indxNext + 1 END DO DO i=1,y_FAST%numOuts(Module_SD) !SubDyn - y_FAST%ChannelNames(indxNext) = InitOutData_SD%WriteOutputHdr(i) - y_FAST%ChannelUnits(indxNext) = InitOutData_SD%WriteOutputUnt(i) + y_FAST%ChannelNames(indxNext) = Init%OutData_SD%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = Init%OutData_SD%WriteOutputUnt(i) indxNext = indxNext + 1 END DO DO i=1,y_FAST%numOuts(Module_ExtPtfm) !ExtPtfm_MCKF - y_FAST%ChannelNames(indxNext) = InitOutData_ExtPtfm%WriteOutputHdr(i) - y_FAST%ChannelUnits(indxNext) = InitOutData_ExtPtfm%WriteOutputUnt(i) + y_FAST%ChannelNames(indxNext) = Init%OutData_ExtPtfm%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = Init%OutData_ExtPtfm%WriteOutputUnt(i) indxNext = indxNext + 1 END DO DO i=1,y_FAST%numOuts(Module_MAP) !MAP - y_FAST%ChannelNames(indxNext) = InitOutData_MAP%WriteOutputHdr(i) - y_FAST%ChannelUnits(indxNext) = InitOutData_MAP%WriteOutputUnt(i) + y_FAST%ChannelNames(indxNext) = Init%OutData_MAP%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = Init%OutData_MAP%WriteOutputUnt(i) indxNext = indxNext + 1 END DO DO i=1,y_FAST%numOuts(Module_MD) !MoorDyn - y_FAST%ChannelNames(indxNext) = InitOutData_MD%WriteOutputHdr(i) - y_FAST%ChannelUnits(indxNext) = InitOutData_MD%WriteOutputUnt(i) + y_FAST%ChannelNames(indxNext) = Init%OutData_MD%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = Init%OutData_MD%WriteOutputUnt(i) indxNext = indxNext + 1 END DO DO i=1,y_FAST%numOuts(Module_FEAM) !FEAMooring - y_FAST%ChannelNames(indxNext) = InitOutData_FEAM%WriteOutputHdr(i) - y_FAST%ChannelUnits(indxNext) = InitOutData_FEAM%WriteOutputUnt(i) + y_FAST%ChannelNames(indxNext) = Init%OutData_FEAM%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = Init%OutData_FEAM%WriteOutputUnt(i) indxNext = indxNext + 1 END DO DO i=1,y_FAST%numOuts(Module_Orca) !OrcaFlex - y_FAST%ChannelNames(indxNext) = InitOutData_Orca%WriteOutputHdr(i) - y_FAST%ChannelUnits(indxNext) = InitOutData_Orca%WriteOutputUnt(i) + y_FAST%ChannelNames(indxNext) = Init%OutData_Orca%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = Init%OutData_Orca%WriteOutputUnt(i) indxNext = indxNext + 1 END DO DO i=1,y_FAST%numOuts(Module_IceF) !IceFloe - y_FAST%ChannelNames(indxNext) = InitOutData_IceF%WriteOutputHdr(i) - y_FAST%ChannelUnits(indxNext) = InitOutData_IceF%WriteOutputUnt(i) + y_FAST%ChannelNames(indxNext) = Init%OutData_IceF%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = Init%OutData_IceF%WriteOutputUnt(i) indxNext = indxNext + 1 END DO IF ( y_FAST%numOuts(Module_IceD) > 0_IntKi ) THEN !IceDyn DO I=1,p_FAST%numIceLegs - DO J=1,SIZE(InitOutData_IceD%WriteOutputHdr) - y_FAST%ChannelNames(indxNext) =TRIM(InitOutData_IceD%WriteOutputHdr(J))//'L'//TRIM(Num2Lstr(I)) !bjj: do we want this "Lx" at the end? - y_FAST%ChannelUnits(indxNext) = InitOutData_IceD%WriteOutputUnt(J) + DO J=1,SIZE(Init%OutData_IceD%WriteOutputHdr) + y_FAST%ChannelNames(indxNext) =TRIM(Init%OutData_IceD%WriteOutputHdr(J))//'L'//TRIM(Num2Lstr(I)) !bjj: do we want this "Lx" at the end? + y_FAST%ChannelUnits(indxNext) = Init%OutData_IceD%WriteOutputUnt(J) indxNext = indxNext + 1 END DO ! J END DO ! I diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index b67b32bb2d..db2c1df716 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -332,7 +332,7 @@ MODULE FAST_Types ! ========= FAST_MiscLinType ======= TYPE, PUBLIC :: FAST_MiscLinType REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: LinTimes !< List of times at which to linearize [s] - INTEGER(IntKi) :: CopyOP_CtrlCode !< if we are mesh control code for copy type [-] + INTEGER(IntKi) :: CopyOP_CtrlCode !< mesh control code for copy type (new on first call; update otherwise) [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: AzimTarget !< target azimuth positions in CalcSteady algorithm [rad] LOGICAL :: IsConverged !< whether the error calculation in the CalcSteady algorithm is converged [-] LOGICAL :: FoundSteady !< whether the CalcSteady algorithm found a steady-state solution [-] @@ -672,6 +672,44 @@ MODULE FAST_Types REAL(ReKi) , DIMENSION(1:3) :: LidarFocus !< lidar focus (relative to lidar location) [m] END TYPE FAST_ExternInputType ! ======================= +! ========= 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(BD_InitInputType) :: InData_BD !< BD Initialization input data [-] + TYPE(BD_InitOutputType) , DIMENSION(:), ALLOCATABLE :: OutData_BD !< BD Initialization output data [-] + TYPE(SrvD_InitInputType) :: InData_SrvD !< SrvD Initialization input data [-] + TYPE(SrvD_InitOutputType) :: OutData_SrvD !< SrvD Initialization output data [-] + TYPE(AD14_InitInputType) :: InData_AD14 !< AD14 Initialization input data [-] + TYPE(AD14_InitOutputType) :: OutData_AD14 !< AD14 Initialization output data [-] + TYPE(AD_InitInputType) :: InData_AD !< AD Initialization input data [-] + TYPE(AD_InitOutputType) :: OutData_AD !< AD Initialization output data [-] + TYPE(InflowWind_InitInputType) :: InData_IfW !< IfW Initialization input data [-] + TYPE(InflowWind_InitOutputType) :: OutData_IfW !< IfW Initialization output data [-] + TYPE(OpFM_InitInputType) :: InData_OpFM !< OpFM Initialization input data [-] + TYPE(OpFM_InitOutputType) :: OutData_OpFM !< OpFM Initialization output data [-] + TYPE(HydroDyn_InitInputType) :: InData_HD !< HD Initialization input data [-] + TYPE(HydroDyn_InitOutputType) :: OutData_HD !< HD Initialization output data [-] + TYPE(SD_InitInputType) :: InData_SD !< SD Initialization input data [-] + TYPE(SD_InitOutputType) :: OutData_SD !< SD Initialization output data [-] + TYPE(ExtPtfm_InitInputType) :: InData_ExtPtfm !< ExtPtfm Initialization input data [-] + TYPE(ExtPtfm_InitOutputType) :: OutData_ExtPtfm !< ExtPtfm Initialization output data [-] + TYPE(MAP_InitInputType) :: InData_MAP !< MAP Initialization input data [-] + TYPE(MAP_InitOutputType) :: OutData_MAP !< MAP Initialization output data [-] + TYPE(FEAM_InitInputType) :: InData_FEAM !< FEAM Initialization input data [-] + TYPE(FEAM_InitOutputType) :: OutData_FEAM !< FEAM Initialization output data [-] + TYPE(MD_InitInputType) :: InData_MD !< MD Initialization input data [-] + TYPE(MD_InitOutputType) :: OutData_MD !< MD Initialization output data [-] + TYPE(Orca_InitInputType) :: InData_Orca !< Orca Initialization input data [-] + TYPE(Orca_InitOutputType) :: OutData_Orca !< Orca Initialization output data [-] + TYPE(IceFloe_InitInputType) :: InData_IceF !< IceF Initialization input data [-] + TYPE(IceFloe_InitOutputType) :: OutData_IceF !< IceF Initialization output data [-] + TYPE(IceD_InitInputType) :: InData_IceD !< IceD Initialization input data [-] + TYPE(IceD_InitOutputType) :: OutData_IceD !< IceD Initialization output data (each instance will have the same output channels) [-] + TYPE(SC_InitInputType) :: InData_SC !< SC Initialization input data [-] + TYPE(SC_InitOutputType) :: OutData_SC !< SC Initialization output data [-] + END TYPE FAST_InitData +! ======================= ! ========= FAST_MiscVarType ======= TYPE, PUBLIC :: FAST_MiscVarType REAL(DbKi) :: TiLstPrn !< The simulation time of the last print (to file) [(s)] @@ -38843,47 +38881,3679 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) ! ED_P_2_Mooring_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2 ) ! Mooring_P_2_ED_P + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) ! ED_P_2_Mooring_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2 ) ! Mooring_P_2_ED_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) ! ED_P_2_SD_TP + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SD_TP_2_ED_P, ErrStat2, ErrMsg2 ) ! SD_TP_2_ED_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SD_P_2_HD_M_P, ErrStat2, ErrMsg2 ) ! SD_P_2_HD_M_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%HD_M_P_2_SD_P, ErrStat2, ErrMsg2 ) ! HD_M_P_2_SD_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SD_P_2_HD_M_L, ErrStat2, ErrMsg2 ) ! SD_P_2_HD_M_L + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%HD_M_L_2_SD_P, ErrStat2, ErrMsg2 ) ! HD_M_L_2_SD_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_SrvD_P_N, ErrStat2, ErrMsg2 ) ! ED_P_2_SrvD_P_N + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SrvD_P_2_ED_P_N, ErrStat2, ErrMsg2 ) ! SrvD_P_2_ED_P_N + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_L_2_SrvD_P_T, ErrStat2, ErrMsg2 ) ! ED_L_2_SrvD_P_T + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SrvD_P_2_ED_P_T, ErrStat2, ErrMsg2 ) ! SrvD_P_2_ED_P_T + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BDED_L_2_AD_L_B not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BDED_L_2_AD_L_B)) DEALLOCATE(OutData%BDED_L_2_AD_L_B) + ALLOCATE(OutData%BDED_L_2_AD_L_B(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BDED_L_2_AD_L_B.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%BDED_L_2_AD_L_B,1), UBOUND(OutData%BDED_L_2_AD_L_B,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%BDED_L_2_AD_L_B(i1), ErrStat2, ErrMsg2 ) ! BDED_L_2_AD_L_B + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AD_L_2_BDED_B not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%AD_L_2_BDED_B)) DEALLOCATE(OutData%AD_L_2_BDED_B) + ALLOCATE(OutData%AD_L_2_BDED_B(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AD_L_2_BDED_B.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%AD_L_2_BDED_B,1), UBOUND(OutData%AD_L_2_BDED_B,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%AD_L_2_BDED_B(i1), ErrStat2, ErrMsg2 ) ! AD_L_2_BDED_B + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BD_L_2_BD_L not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BD_L_2_BD_L)) DEALLOCATE(OutData%BD_L_2_BD_L) + ALLOCATE(OutData%BD_L_2_BD_L(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BD_L_2_BD_L.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%BD_L_2_BD_L,1), UBOUND(OutData%BD_L_2_BD_L,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%BD_L_2_BD_L(i1), ErrStat2, ErrMsg2 ) ! BD_L_2_BD_L + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2 ) ! ED_L_2_AD_L_T + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%AD_L_2_ED_P_T, ErrStat2, ErrMsg2 ) ! AD_L_2_ED_P_T + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ED_P_2_AD_P_R not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%ED_P_2_AD_P_R)) DEALLOCATE(OutData%ED_P_2_AD_P_R) + ALLOCATE(OutData%ED_P_2_AD_P_R(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_P_2_AD_P_R.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%ED_P_2_AD_P_R,1), UBOUND(OutData%ED_P_2_AD_P_R,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2 ) ! ED_P_2_AD_P_R + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2 ) ! ED_P_2_AD_P_H + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%IceF_P_2_SD_P, ErrStat2, ErrMsg2 ) ! IceF_P_2_SD_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SD_P_2_IceF_P, ErrStat2, ErrMsg2 ) ! SD_P_2_IceF_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IceD_P_2_SD_P 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%IceD_P_2_SD_P)) DEALLOCATE(OutData%IceD_P_2_SD_P) + ALLOCATE(OutData%IceD_P_2_SD_P(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IceD_P_2_SD_P.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%IceD_P_2_SD_P,1), UBOUND(OutData%IceD_P_2_SD_P,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%IceD_P_2_SD_P(i1), ErrStat2, ErrMsg2 ) ! IceD_P_2_SD_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SD_P_2_IceD_P 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%SD_P_2_IceD_P)) DEALLOCATE(OutData%SD_P_2_IceD_P) + ALLOCATE(OutData%SD_P_2_IceD_P(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SD_P_2_IceD_P.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%SD_P_2_IceD_P,1), UBOUND(OutData%SD_P_2_IceD_P,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SD_P_2_IceD_P(i1), ErrStat2, ErrMsg2 ) ! SD_P_2_IceD_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jacobian_Opt1 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Jacobian_Opt1)) DEALLOCATE(OutData%Jacobian_Opt1) + ALLOCATE(OutData%Jacobian_Opt1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jacobian_Opt1.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%Jacobian_Opt1,2), UBOUND(OutData%Jacobian_Opt1,2) + DO i1 = LBOUND(OutData%Jacobian_Opt1,1), UBOUND(OutData%Jacobian_Opt1,1) + OutData%Jacobian_Opt1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jacobian_pivot 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%Jacobian_pivot)) DEALLOCATE(OutData%Jacobian_pivot) + ALLOCATE(OutData%Jacobian_pivot(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jacobian_pivot.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Jacobian_pivot,1), UBOUND(OutData%Jacobian_pivot,1) + OutData%Jacobian_pivot(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_u_indx not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Jac_u_indx)) DEALLOCATE(OutData%Jac_u_indx) + ALLOCATE(OutData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%Jac_u_indx,2), UBOUND(OutData%Jac_u_indx,2) + DO i1 = LBOUND(OutData%Jac_u_indx,1), UBOUND(OutData%Jac_u_indx,1) + OutData%Jac_u_indx(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MeshUnpack( OutData%u_ED_PlatformPtMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_ED_PlatformPtMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MeshUnpack( OutData%u_ED_PlatformPtMesh_2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_ED_PlatformPtMesh_2 + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MeshUnpack( OutData%u_SD_TPMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_SD_TPMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MeshUnpack( OutData%u_SD_LMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_SD_LMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MeshUnpack( OutData%u_SD_LMesh_2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_SD_LMesh_2 + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MeshUnpack( OutData%u_HD_M_LumpedMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_HD_M_LumpedMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MeshUnpack( OutData%u_HD_M_DistribMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_HD_M_DistribMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MeshUnpack( OutData%u_HD_Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_HD_Mesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MeshUnpack( OutData%u_ED_HubPtLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_ED_HubPtLoad + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MeshUnpack( OutData%u_ED_HubPtLoad_2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_ED_HubPtLoad_2 + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_BD_RootMotion 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%u_BD_RootMotion)) DEALLOCATE(OutData%u_BD_RootMotion) + ALLOCATE(OutData%u_BD_RootMotion(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_BD_RootMotion.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%u_BD_RootMotion,1), UBOUND(OutData%u_BD_RootMotion,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MeshUnpack( OutData%u_BD_RootMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_BD_RootMotion + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y_BD_BldMotion_4Loads 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%y_BD_BldMotion_4Loads)) DEALLOCATE(OutData%y_BD_BldMotion_4Loads) + ALLOCATE(OutData%y_BD_BldMotion_4Loads(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_BD_BldMotion_4Loads.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%y_BD_BldMotion_4Loads,1), UBOUND(OutData%y_BD_BldMotion_4Loads,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MeshUnpack( OutData%y_BD_BldMotion_4Loads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! y_BD_BldMotion_4Loads + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MeshUnpack( OutData%u_Orca_PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_Orca_PtfmMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MeshUnpack( OutData%u_ExtPtfm_PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_ExtPtfm_PtfmMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END SUBROUTINE FAST_UnPackModuleMapType + + SUBROUTINE FAST_CopyExternInputType( SrcExternInputTypeData, DstExternInputTypeData, CtrlCode, ErrStat, ErrMsg ) + TYPE(FAST_ExternInputType), INTENT(IN) :: SrcExternInputTypeData + TYPE(FAST_ExternInputType), INTENT(INOUT) :: DstExternInputTypeData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyExternInputType' +! + ErrStat = ErrID_None + ErrMsg = "" + DstExternInputTypeData%GenTrq = SrcExternInputTypeData%GenTrq + DstExternInputTypeData%ElecPwr = SrcExternInputTypeData%ElecPwr + DstExternInputTypeData%YawPosCom = SrcExternInputTypeData%YawPosCom + DstExternInputTypeData%YawRateCom = SrcExternInputTypeData%YawRateCom + DstExternInputTypeData%BlPitchCom = SrcExternInputTypeData%BlPitchCom + DstExternInputTypeData%HSSBrFrac = SrcExternInputTypeData%HSSBrFrac + DstExternInputTypeData%LidarFocus = SrcExternInputTypeData%LidarFocus + END SUBROUTINE FAST_CopyExternInputType + + SUBROUTINE FAST_DestroyExternInputType( ExternInputTypeData, ErrStat, ErrMsg ) + TYPE(FAST_ExternInputType), INTENT(INOUT) :: ExternInputTypeData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyExternInputType' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" + END SUBROUTINE FAST_DestroyExternInputType + + SUBROUTINE FAST_PackExternInputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(FAST_ExternInputType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackExternInputType' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Re_BufSz = Re_BufSz + 1 ! GenTrq + Re_BufSz = Re_BufSz + 1 ! ElecPwr + Re_BufSz = Re_BufSz + 1 ! YawPosCom + Re_BufSz = Re_BufSz + 1 ! YawRateCom + Re_BufSz = Re_BufSz + SIZE(InData%BlPitchCom) ! BlPitchCom + Re_BufSz = Re_BufSz + 1 ! HSSBrFrac + Re_BufSz = Re_BufSz + SIZE(InData%LidarFocus) ! LidarFocus + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + ReKiBuf(Re_Xferred) = InData%GenTrq + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ElecPwr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawPosCom + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawRateCom + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%BlPitchCom,1), UBOUND(InData%BlPitchCom,1) + ReKiBuf(Re_Xferred) = InData%BlPitchCom(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%HSSBrFrac + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%LidarFocus,1), UBOUND(InData%LidarFocus,1) + ReKiBuf(Re_Xferred) = InData%LidarFocus(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END SUBROUTINE FAST_PackExternInputType + + SUBROUTINE FAST_UnPackExternInputType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(FAST_ExternInputType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackExternInputType' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%GenTrq = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%ElecPwr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawPosCom = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawRateCom = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + i1_l = LBOUND(OutData%BlPitchCom,1) + i1_u = UBOUND(OutData%BlPitchCom,1) + DO i1 = LBOUND(OutData%BlPitchCom,1), UBOUND(OutData%BlPitchCom,1) + OutData%BlPitchCom(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%HSSBrFrac = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + i1_l = LBOUND(OutData%LidarFocus,1) + i1_u = UBOUND(OutData%LidarFocus,1) + DO i1 = LBOUND(OutData%LidarFocus,1), UBOUND(OutData%LidarFocus,1) + OutData%LidarFocus(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END SUBROUTINE FAST_UnPackExternInputType + + SUBROUTINE FAST_CopyInitData( SrcInitDataData, DstInitDataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(FAST_InitData), INTENT(INOUT) :: SrcInitDataData + TYPE(FAST_InitData), INTENT(INOUT) :: DstInitDataData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyInitData' +! + ErrStat = ErrID_None + ErrMsg = "" + 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 + CALL BD_CopyInitInput( SrcInitDataData%InData_BD, DstInitDataData%InData_BD, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcInitDataData%OutData_BD)) THEN + i1_l = LBOUND(SrcInitDataData%OutData_BD,1) + i1_u = UBOUND(SrcInitDataData%OutData_BD,1) + IF (.NOT. ALLOCATED(DstInitDataData%OutData_BD)) THEN + ALLOCATE(DstInitDataData%OutData_BD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitDataData%OutData_BD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcInitDataData%OutData_BD,1), UBOUND(SrcInitDataData%OutData_BD,1) + CALL BD_CopyInitOutput( SrcInitDataData%OutData_BD(i1), DstInitDataData%OutData_BD(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + CALL SrvD_CopyInitInput( SrcInitDataData%InData_SrvD, DstInitDataData%InData_SrvD, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL SrvD_CopyInitOutput( SrcInitDataData%OutData_SrvD, DstInitDataData%OutData_SrvD, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL AD14_CopyInitInput( SrcInitDataData%InData_AD14, DstInitDataData%InData_AD14, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL AD14_CopyInitOutput( SrcInitDataData%OutData_AD14, DstInitDataData%OutData_AD14, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL AD_CopyInitInput( SrcInitDataData%InData_AD, DstInitDataData%InData_AD, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL AD_CopyInitOutput( SrcInitDataData%OutData_AD, DstInitDataData%OutData_AD, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL InflowWind_CopyInitInput( SrcInitDataData%InData_IfW, DstInitDataData%InData_IfW, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL InflowWind_CopyInitOutput( SrcInitDataData%OutData_IfW, DstInitDataData%OutData_IfW, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL OpFM_CopyInitInput( SrcInitDataData%InData_OpFM, DstInitDataData%InData_OpFM, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL OpFM_CopyInitOutput( SrcInitDataData%OutData_OpFM, DstInitDataData%OutData_OpFM, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL HydroDyn_CopyInitInput( SrcInitDataData%InData_HD, DstInitDataData%InData_HD, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL HydroDyn_CopyInitOutput( SrcInitDataData%OutData_HD, DstInitDataData%OutData_HD, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL SD_CopyInitInput( SrcInitDataData%InData_SD, DstInitDataData%InData_SD, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL SD_CopyInitOutput( SrcInitDataData%OutData_SD, DstInitDataData%OutData_SD, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL ExtPtfm_CopyInitInput( SrcInitDataData%InData_ExtPtfm, DstInitDataData%InData_ExtPtfm, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL ExtPtfm_CopyInitOutput( SrcInitDataData%OutData_ExtPtfm, DstInitDataData%OutData_ExtPtfm, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MAP_CopyInitInput( SrcInitDataData%InData_MAP, DstInitDataData%InData_MAP, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MAP_CopyInitOutput( SrcInitDataData%OutData_MAP, DstInitDataData%OutData_MAP, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL FEAM_CopyInitInput( SrcInitDataData%InData_FEAM, DstInitDataData%InData_FEAM, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL FEAM_CopyInitOutput( SrcInitDataData%OutData_FEAM, DstInitDataData%OutData_FEAM, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MD_CopyInitInput( SrcInitDataData%InData_MD, DstInitDataData%InData_MD, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MD_CopyInitOutput( SrcInitDataData%OutData_MD, DstInitDataData%OutData_MD, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL Orca_CopyInitInput( SrcInitDataData%InData_Orca, DstInitDataData%InData_Orca, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL Orca_CopyInitOutput( SrcInitDataData%OutData_Orca, DstInitDataData%OutData_Orca, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL IceFloe_CopyInitInput( SrcInitDataData%InData_IceF, DstInitDataData%InData_IceF, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL IceFloe_CopyInitOutput( SrcInitDataData%OutData_IceF, DstInitDataData%OutData_IceF, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL IceD_CopyInitInput( SrcInitDataData%InData_IceD, DstInitDataData%InData_IceD, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL IceD_CopyInitOutput( SrcInitDataData%OutData_IceD, DstInitDataData%OutData_IceD, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL SC_CopyInitInput( SrcInitDataData%InData_SC, DstInitDataData%InData_SC, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL SC_CopyInitOutput( SrcInitDataData%OutData_SC, DstInitDataData%OutData_SC, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + END SUBROUTINE FAST_CopyInitData + + SUBROUTINE FAST_DestroyInitData( InitDataData, ErrStat, ErrMsg ) + TYPE(FAST_InitData), INTENT(INOUT) :: InitDataData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyInitData' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" + CALL ED_DestroyInitInput( InitDataData%InData_ED, ErrStat, ErrMsg ) + CALL ED_DestroyInitOutput( InitDataData%OutData_ED, ErrStat, ErrMsg ) + CALL BD_DestroyInitInput( InitDataData%InData_BD, ErrStat, ErrMsg ) +IF (ALLOCATED(InitDataData%OutData_BD)) THEN +DO i1 = LBOUND(InitDataData%OutData_BD,1), UBOUND(InitDataData%OutData_BD,1) + CALL BD_DestroyInitOutput( InitDataData%OutData_BD(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(InitDataData%OutData_BD) +ENDIF + CALL SrvD_DestroyInitInput( InitDataData%InData_SrvD, ErrStat, ErrMsg ) + CALL SrvD_DestroyInitOutput( InitDataData%OutData_SrvD, ErrStat, ErrMsg ) + CALL AD14_DestroyInitInput( InitDataData%InData_AD14, ErrStat, ErrMsg ) + CALL AD14_DestroyInitOutput( InitDataData%OutData_AD14, ErrStat, ErrMsg ) + CALL AD_DestroyInitInput( InitDataData%InData_AD, ErrStat, ErrMsg ) + CALL AD_DestroyInitOutput( InitDataData%OutData_AD, ErrStat, ErrMsg ) + CALL InflowWind_DestroyInitInput( InitDataData%InData_IfW, ErrStat, ErrMsg ) + CALL InflowWind_DestroyInitOutput( InitDataData%OutData_IfW, ErrStat, ErrMsg ) + CALL OpFM_DestroyInitInput( InitDataData%InData_OpFM, ErrStat, ErrMsg ) + CALL OpFM_DestroyInitOutput( InitDataData%OutData_OpFM, ErrStat, ErrMsg ) + CALL HydroDyn_DestroyInitInput( InitDataData%InData_HD, ErrStat, ErrMsg ) + CALL HydroDyn_DestroyInitOutput( InitDataData%OutData_HD, ErrStat, ErrMsg ) + CALL SD_DestroyInitInput( InitDataData%InData_SD, ErrStat, ErrMsg ) + CALL SD_DestroyInitOutput( InitDataData%OutData_SD, ErrStat, ErrMsg ) + CALL ExtPtfm_DestroyInitInput( InitDataData%InData_ExtPtfm, ErrStat, ErrMsg ) + CALL ExtPtfm_DestroyInitOutput( InitDataData%OutData_ExtPtfm, ErrStat, ErrMsg ) + CALL MAP_DestroyInitInput( InitDataData%InData_MAP, ErrStat, ErrMsg ) + CALL MAP_DestroyInitOutput( InitDataData%OutData_MAP, ErrStat, ErrMsg ) + CALL FEAM_DestroyInitInput( InitDataData%InData_FEAM, ErrStat, ErrMsg ) + CALL FEAM_DestroyInitOutput( InitDataData%OutData_FEAM, ErrStat, ErrMsg ) + CALL MD_DestroyInitInput( InitDataData%InData_MD, ErrStat, ErrMsg ) + CALL MD_DestroyInitOutput( InitDataData%OutData_MD, ErrStat, ErrMsg ) + CALL Orca_DestroyInitInput( InitDataData%InData_Orca, ErrStat, ErrMsg ) + CALL Orca_DestroyInitOutput( InitDataData%OutData_Orca, ErrStat, ErrMsg ) + CALL IceFloe_DestroyInitInput( InitDataData%InData_IceF, ErrStat, ErrMsg ) + CALL IceFloe_DestroyInitOutput( InitDataData%OutData_IceF, ErrStat, ErrMsg ) + CALL IceD_DestroyInitInput( InitDataData%InData_IceD, ErrStat, ErrMsg ) + CALL IceD_DestroyInitOutput( InitDataData%OutData_IceD, ErrStat, ErrMsg ) + CALL SC_DestroyInitInput( InitDataData%InData_SC, ErrStat, ErrMsg ) + CALL SC_DestroyInitOutput( InitDataData%OutData_SC, ErrStat, ErrMsg ) + END SUBROUTINE FAST_DestroyInitData + + SUBROUTINE FAST_PackInitData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(FAST_InitData), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackInitData' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + Int_BufSz = Int_BufSz + 3 ! InData_ED: size of buffers for each call to pack subtype + CALL ED_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_ED, ErrStat2, ErrMsg2, .TRUE. ) ! InData_ED + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! InData_ED + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! InData_ED + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! InData_ED + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! OutData_ED: size of buffers for each call to pack subtype + CALL ED_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_ED, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_ED + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OutData_ED + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OutData_ED + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OutData_ED + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! InData_BD: size of buffers for each call to pack subtype + CALL BD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_BD, ErrStat2, ErrMsg2, .TRUE. ) ! InData_BD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! InData_BD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! InData_BD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! InData_BD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! OutData_BD allocated yes/no + IF ( ALLOCATED(InData%OutData_BD) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! OutData_BD upper/lower bounds for each dimension + DO i1 = LBOUND(InData%OutData_BD,1), UBOUND(InData%OutData_BD,1) + Int_BufSz = Int_BufSz + 3 ! OutData_BD: size of buffers for each call to pack subtype + CALL BD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_BD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutData_BD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OutData_BD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OutData_BD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OutData_BD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 3 ! InData_SrvD: size of buffers for each call to pack subtype + CALL SrvD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_SrvD, ErrStat2, ErrMsg2, .TRUE. ) ! InData_SrvD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! InData_SrvD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! InData_SrvD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! InData_SrvD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! OutData_SrvD: size of buffers for each call to pack subtype + CALL SrvD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_SrvD, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_SrvD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OutData_SrvD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OutData_SrvD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OutData_SrvD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! InData_AD14: size of buffers for each call to pack subtype + CALL AD14_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_AD14, ErrStat2, ErrMsg2, .TRUE. ) ! InData_AD14 + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! InData_AD14 + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! InData_AD14 + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! InData_AD14 + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! OutData_AD14: size of buffers for each call to pack subtype + CALL AD14_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_AD14, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_AD14 + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OutData_AD14 + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OutData_AD14 + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OutData_AD14 + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! InData_AD: size of buffers for each call to pack subtype + CALL AD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_AD, ErrStat2, ErrMsg2, .TRUE. ) ! InData_AD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! InData_AD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! InData_AD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! InData_AD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! OutData_AD: size of buffers for each call to pack subtype + CALL AD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_AD, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_AD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OutData_AD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OutData_AD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OutData_AD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! InData_IfW: size of buffers for each call to pack subtype + CALL InflowWind_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_IfW, ErrStat2, ErrMsg2, .TRUE. ) ! InData_IfW + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! InData_IfW + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! InData_IfW + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! InData_IfW + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! OutData_IfW: size of buffers for each call to pack subtype + CALL InflowWind_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_IfW, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_IfW + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OutData_IfW + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OutData_IfW + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OutData_IfW + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! InData_OpFM: size of buffers for each call to pack subtype + CALL OpFM_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_OpFM, ErrStat2, ErrMsg2, .TRUE. ) ! InData_OpFM + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! InData_OpFM + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! InData_OpFM + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! InData_OpFM + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! OutData_OpFM: size of buffers for each call to pack subtype + CALL OpFM_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_OpFM, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_OpFM + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OutData_OpFM + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OutData_OpFM + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OutData_OpFM + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! InData_HD: size of buffers for each call to pack subtype + CALL HydroDyn_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_HD, ErrStat2, ErrMsg2, .TRUE. ) ! InData_HD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! InData_HD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! InData_HD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! InData_HD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! OutData_HD: size of buffers for each call to pack subtype + CALL HydroDyn_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_HD, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_HD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OutData_HD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OutData_HD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OutData_HD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! InData_SD: size of buffers for each call to pack subtype + CALL SD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_SD, ErrStat2, ErrMsg2, .TRUE. ) ! InData_SD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! InData_SD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! InData_SD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! InData_SD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! OutData_SD: size of buffers for each call to pack subtype + CALL SD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_SD, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_SD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OutData_SD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OutData_SD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OutData_SD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! InData_ExtPtfm: size of buffers for each call to pack subtype + CALL ExtPtfm_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_ExtPtfm, ErrStat2, ErrMsg2, .TRUE. ) ! InData_ExtPtfm + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! InData_ExtPtfm + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! InData_ExtPtfm + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! InData_ExtPtfm + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! OutData_ExtPtfm: size of buffers for each call to pack subtype + CALL ExtPtfm_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_ExtPtfm, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_ExtPtfm + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OutData_ExtPtfm + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OutData_ExtPtfm + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OutData_ExtPtfm + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! InData_MAP: size of buffers for each call to pack subtype + CALL MAP_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_MAP, ErrStat2, ErrMsg2, .TRUE. ) ! InData_MAP + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! InData_MAP + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! InData_MAP + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! InData_MAP + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! OutData_MAP: size of buffers for each call to pack subtype + CALL MAP_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_MAP, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_MAP + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OutData_MAP + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OutData_MAP + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OutData_MAP + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! InData_FEAM: size of buffers for each call to pack subtype + CALL FEAM_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_FEAM, ErrStat2, ErrMsg2, .TRUE. ) ! InData_FEAM + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! InData_FEAM + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! InData_FEAM + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! InData_FEAM + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! OutData_FEAM: size of buffers for each call to pack subtype + CALL FEAM_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_FEAM, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_FEAM + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OutData_FEAM + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OutData_FEAM + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OutData_FEAM + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! InData_MD: size of buffers for each call to pack subtype + CALL MD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_MD, ErrStat2, ErrMsg2, .TRUE. ) ! InData_MD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! InData_MD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! InData_MD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! InData_MD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! OutData_MD: size of buffers for each call to pack subtype + CALL MD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_MD, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_MD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OutData_MD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OutData_MD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OutData_MD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! InData_Orca: size of buffers for each call to pack subtype + CALL Orca_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_Orca, ErrStat2, ErrMsg2, .TRUE. ) ! InData_Orca + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! InData_Orca + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! InData_Orca + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! InData_Orca + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! OutData_Orca: size of buffers for each call to pack subtype + CALL Orca_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_Orca, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_Orca + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OutData_Orca + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OutData_Orca + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OutData_Orca + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! InData_IceF: size of buffers for each call to pack subtype + CALL IceFloe_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_IceF, ErrStat2, ErrMsg2, .TRUE. ) ! InData_IceF + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! InData_IceF + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! InData_IceF + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! InData_IceF + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! OutData_IceF: size of buffers for each call to pack subtype + CALL IceFloe_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_IceF, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_IceF + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OutData_IceF + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OutData_IceF + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OutData_IceF + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! InData_IceD: size of buffers for each call to pack subtype + CALL IceD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_IceD, ErrStat2, ErrMsg2, .TRUE. ) ! InData_IceD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! InData_IceD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! InData_IceD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! InData_IceD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! OutData_IceD: size of buffers for each call to pack subtype + CALL IceD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_IceD, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_IceD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OutData_IceD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OutData_IceD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OutData_IceD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! InData_SC: size of buffers for each call to pack subtype + CALL SC_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_SC, ErrStat2, ErrMsg2, .TRUE. ) ! InData_SC + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! InData_SC + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! InData_SC + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! InData_SC + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! OutData_SC: size of buffers for each call to pack subtype + CALL SC_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_SC, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_SC + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OutData_SC + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OutData_SC + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OutData_SC + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + CALL ED_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_ED, ErrStat2, ErrMsg2, OnlySize ) ! InData_ED + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL ED_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_ED, ErrStat2, ErrMsg2, OnlySize ) ! OutData_ED + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL BD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_BD, ErrStat2, ErrMsg2, OnlySize ) ! InData_BD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%OutData_BD) ) 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%OutData_BD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutData_BD,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%OutData_BD,1), UBOUND(InData%OutData_BD,1) + CALL BD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_BD(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutData_BD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + CALL SrvD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_SrvD, ErrStat2, ErrMsg2, OnlySize ) ! InData_SrvD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL SrvD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_SrvD, ErrStat2, ErrMsg2, OnlySize ) ! OutData_SrvD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL AD14_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_AD14, ErrStat2, ErrMsg2, OnlySize ) ! InData_AD14 + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL AD14_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_AD14, ErrStat2, ErrMsg2, OnlySize ) ! OutData_AD14 + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL AD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_AD, ErrStat2, ErrMsg2, OnlySize ) ! InData_AD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL AD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_AD, ErrStat2, ErrMsg2, OnlySize ) ! OutData_AD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL InflowWind_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_IfW, ErrStat2, ErrMsg2, OnlySize ) ! InData_IfW + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL InflowWind_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_IfW, ErrStat2, ErrMsg2, OnlySize ) ! OutData_IfW + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL OpFM_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_OpFM, ErrStat2, ErrMsg2, OnlySize ) ! InData_OpFM + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL OpFM_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_OpFM, ErrStat2, ErrMsg2, OnlySize ) ! OutData_OpFM + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL HydroDyn_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_HD, ErrStat2, ErrMsg2, OnlySize ) ! InData_HD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL HydroDyn_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_HD, ErrStat2, ErrMsg2, OnlySize ) ! OutData_HD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL SD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_SD, ErrStat2, ErrMsg2, OnlySize ) ! InData_SD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL SD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_SD, ErrStat2, ErrMsg2, OnlySize ) ! OutData_SD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL ExtPtfm_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_ExtPtfm, ErrStat2, ErrMsg2, OnlySize ) ! InData_ExtPtfm + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL ExtPtfm_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_ExtPtfm, ErrStat2, ErrMsg2, OnlySize ) ! OutData_ExtPtfm + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL MAP_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_MAP, ErrStat2, ErrMsg2, OnlySize ) ! InData_MAP + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL MAP_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_MAP, ErrStat2, ErrMsg2, OnlySize ) ! OutData_MAP + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL FEAM_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_FEAM, ErrStat2, ErrMsg2, OnlySize ) ! InData_FEAM + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL FEAM_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_FEAM, ErrStat2, ErrMsg2, OnlySize ) ! OutData_FEAM + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL MD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_MD, ErrStat2, ErrMsg2, OnlySize ) ! InData_MD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL MD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_MD, ErrStat2, ErrMsg2, OnlySize ) ! OutData_MD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL Orca_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_Orca, ErrStat2, ErrMsg2, OnlySize ) ! InData_Orca + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL Orca_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_Orca, ErrStat2, ErrMsg2, OnlySize ) ! OutData_Orca + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL IceFloe_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_IceF, ErrStat2, ErrMsg2, OnlySize ) ! InData_IceF + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL IceFloe_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_IceF, ErrStat2, ErrMsg2, OnlySize ) ! OutData_IceF + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL IceD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_IceD, ErrStat2, ErrMsg2, OnlySize ) ! InData_IceD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL IceD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_IceD, ErrStat2, ErrMsg2, OnlySize ) ! OutData_IceD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL SC_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_SC, ErrStat2, ErrMsg2, OnlySize ) ! InData_SC + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL SC_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_SC, ErrStat2, ErrMsg2, OnlySize ) ! OutData_SC + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END SUBROUTINE FAST_PackInitData + + SUBROUTINE FAST_UnPackInitData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(FAST_InitData), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackInitData' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL ED_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_ED, ErrStat2, ErrMsg2 ) ! InData_ED CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -38923,7 +42593,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) ! ED_P_2_SD_TP + CALL ED_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_ED, ErrStat2, ErrMsg2 ) ! OutData_ED CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -38963,13 +42633,27 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SD_TP_2_ED_P, ErrStat2, ErrMsg2 ) ! SD_TP_2_ED_P + CALL BD_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_BD, ErrStat2, ErrMsg2 ) ! InData_BD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutData_BD 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%OutData_BD)) DEALLOCATE(OutData%OutData_BD) + ALLOCATE(OutData%OutData_BD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutData_BD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%OutData_BD,1), UBOUND(OutData%OutData_BD,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -39003,13 +42687,15 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SD_P_2_HD_M_P, ErrStat2, ErrMsg2 ) ! SD_P_2_HD_M_P + CALL BD_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_BD(i1), ErrStat2, ErrMsg2 ) ! OutData_BD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -39043,7 +42729,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%HD_M_P_2_SD_P, ErrStat2, ErrMsg2 ) ! HD_M_P_2_SD_P + CALL SrvD_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_SrvD, ErrStat2, ErrMsg2 ) ! InData_SrvD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -39083,7 +42769,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SD_P_2_HD_M_L, ErrStat2, ErrMsg2 ) ! SD_P_2_HD_M_L + CALL SrvD_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_SrvD, ErrStat2, ErrMsg2 ) ! OutData_SrvD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -39123,7 +42809,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%HD_M_L_2_SD_P, ErrStat2, ErrMsg2 ) ! HD_M_L_2_SD_P + CALL AD14_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_AD14, ErrStat2, ErrMsg2 ) ! InData_AD14 CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -39163,7 +42849,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_SrvD_P_N, ErrStat2, ErrMsg2 ) ! ED_P_2_SrvD_P_N + CALL AD14_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_AD14, ErrStat2, ErrMsg2 ) ! OutData_AD14 CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -39203,7 +42889,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SrvD_P_2_ED_P_N, ErrStat2, ErrMsg2 ) ! SrvD_P_2_ED_P_N + CALL AD_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_AD, ErrStat2, ErrMsg2 ) ! InData_AD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -39243,7 +42929,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_L_2_SrvD_P_T, ErrStat2, ErrMsg2 ) ! ED_L_2_SrvD_P_T + CALL AD_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_AD, ErrStat2, ErrMsg2 ) ! OutData_AD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -39283,27 +42969,13 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SrvD_P_2_ED_P_T, ErrStat2, ErrMsg2 ) ! SrvD_P_2_ED_P_T + CALL InflowWind_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_IfW, ErrStat2, ErrMsg2 ) ! InData_IfW CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BDED_L_2_AD_L_B not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BDED_L_2_AD_L_B)) DEALLOCATE(OutData%BDED_L_2_AD_L_B) - ALLOCATE(OutData%BDED_L_2_AD_L_B(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BDED_L_2_AD_L_B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BDED_L_2_AD_L_B,1), UBOUND(OutData%BDED_L_2_AD_L_B,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -39337,29 +43009,13 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%BDED_L_2_AD_L_B(i1), ErrStat2, ErrMsg2 ) ! BDED_L_2_AD_L_B + CALL InflowWind_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_IfW, ErrStat2, ErrMsg2 ) ! OutData_IfW CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AD_L_2_BDED_B not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AD_L_2_BDED_B)) DEALLOCATE(OutData%AD_L_2_BDED_B) - ALLOCATE(OutData%AD_L_2_BDED_B(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AD_L_2_BDED_B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AD_L_2_BDED_B,1), UBOUND(OutData%AD_L_2_BDED_B,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -39393,29 +43049,13 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%AD_L_2_BDED_B(i1), ErrStat2, ErrMsg2 ) ! AD_L_2_BDED_B + CALL OpFM_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_OpFM, ErrStat2, ErrMsg2 ) ! InData_OpFM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BD_L_2_BD_L not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BD_L_2_BD_L)) DEALLOCATE(OutData%BD_L_2_BD_L) - ALLOCATE(OutData%BD_L_2_BD_L(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BD_L_2_BD_L.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BD_L_2_BD_L,1), UBOUND(OutData%BD_L_2_BD_L,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -39449,15 +43089,13 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%BD_L_2_BD_L(i1), ErrStat2, ErrMsg2 ) ! BD_L_2_BD_L + CALL OpFM_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_OpFM, ErrStat2, ErrMsg2 ) ! OutData_OpFM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -39491,7 +43129,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2 ) ! ED_L_2_AD_L_T + CALL HydroDyn_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_HD, ErrStat2, ErrMsg2 ) ! InData_HD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -39531,27 +43169,13 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%AD_L_2_ED_P_T, ErrStat2, ErrMsg2 ) ! AD_L_2_ED_P_T + CALL HydroDyn_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_HD, ErrStat2, ErrMsg2 ) ! OutData_HD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ED_P_2_AD_P_R not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ED_P_2_AD_P_R)) DEALLOCATE(OutData%ED_P_2_AD_P_R) - ALLOCATE(OutData%ED_P_2_AD_P_R(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_P_2_AD_P_R.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ED_P_2_AD_P_R,1), UBOUND(OutData%ED_P_2_AD_P_R,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -39585,15 +43209,13 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2 ) ! ED_P_2_AD_P_R + CALL SD_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_SD, ErrStat2, ErrMsg2 ) ! InData_SD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -39627,7 +43249,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2 ) ! ED_P_2_AD_P_H + CALL SD_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_SD, ErrStat2, ErrMsg2 ) ! OutData_SD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -39667,7 +43289,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%IceF_P_2_SD_P, ErrStat2, ErrMsg2 ) ! IceF_P_2_SD_P + CALL ExtPtfm_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_ExtPtfm, ErrStat2, ErrMsg2 ) ! InData_ExtPtfm CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -39707,223 +43329,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SD_P_2_IceF_P, ErrStat2, ErrMsg2 ) ! SD_P_2_IceF_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IceD_P_2_SD_P 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%IceD_P_2_SD_P)) DEALLOCATE(OutData%IceD_P_2_SD_P) - ALLOCATE(OutData%IceD_P_2_SD_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IceD_P_2_SD_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IceD_P_2_SD_P,1), UBOUND(OutData%IceD_P_2_SD_P,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%IceD_P_2_SD_P(i1), ErrStat2, ErrMsg2 ) ! IceD_P_2_SD_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SD_P_2_IceD_P 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%SD_P_2_IceD_P)) DEALLOCATE(OutData%SD_P_2_IceD_P) - ALLOCATE(OutData%SD_P_2_IceD_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SD_P_2_IceD_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SD_P_2_IceD_P,1), UBOUND(OutData%SD_P_2_IceD_P,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SD_P_2_IceD_P(i1), ErrStat2, ErrMsg2 ) ! SD_P_2_IceD_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jacobian_Opt1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Jacobian_Opt1)) DEALLOCATE(OutData%Jacobian_Opt1) - ALLOCATE(OutData%Jacobian_Opt1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jacobian_Opt1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Jacobian_Opt1,2), UBOUND(OutData%Jacobian_Opt1,2) - DO i1 = LBOUND(OutData%Jacobian_Opt1,1), UBOUND(OutData%Jacobian_Opt1,1) - OutData%Jacobian_Opt1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jacobian_pivot 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%Jacobian_pivot)) DEALLOCATE(OutData%Jacobian_pivot) - ALLOCATE(OutData%Jacobian_pivot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jacobian_pivot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Jacobian_pivot,1), UBOUND(OutData%Jacobian_pivot,1) - OutData%Jacobian_pivot(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_u_indx not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Jac_u_indx)) DEALLOCATE(OutData%Jac_u_indx) - ALLOCATE(OutData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Jac_u_indx,2), UBOUND(OutData%Jac_u_indx,2) - DO i1 = LBOUND(OutData%Jac_u_indx,1), UBOUND(OutData%Jac_u_indx,1) - OutData%Jac_u_indx(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%u_ED_PlatformPtMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_ED_PlatformPtMesh + CALL ExtPtfm_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_ExtPtfm, ErrStat2, ErrMsg2 ) ! OutData_ExtPtfm CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -39963,7 +43369,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MeshUnpack( OutData%u_ED_PlatformPtMesh_2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_ED_PlatformPtMesh_2 + CALL MAP_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_MAP, ErrStat2, ErrMsg2 ) ! InData_MAP CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -40003,7 +43409,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MeshUnpack( OutData%u_SD_TPMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_SD_TPMesh + CALL MAP_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_MAP, ErrStat2, ErrMsg2 ) ! OutData_MAP CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -40043,7 +43449,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MeshUnpack( OutData%u_SD_LMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_SD_LMesh + CALL FEAM_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_FEAM, ErrStat2, ErrMsg2 ) ! InData_FEAM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -40083,7 +43489,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MeshUnpack( OutData%u_SD_LMesh_2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_SD_LMesh_2 + CALL FEAM_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_FEAM, ErrStat2, ErrMsg2 ) ! OutData_FEAM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -40123,7 +43529,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MeshUnpack( OutData%u_HD_M_LumpedMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_HD_M_LumpedMesh + CALL MD_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_MD, ErrStat2, ErrMsg2 ) ! InData_MD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -40163,7 +43569,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MeshUnpack( OutData%u_HD_M_DistribMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_HD_M_DistribMesh + CALL MD_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_MD, ErrStat2, ErrMsg2 ) ! OutData_MD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -40203,7 +43609,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MeshUnpack( OutData%u_HD_Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_HD_Mesh + CALL Orca_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_Orca, ErrStat2, ErrMsg2 ) ! InData_Orca CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -40243,7 +43649,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MeshUnpack( OutData%u_ED_HubPtLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_ED_HubPtLoad + CALL Orca_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_Orca, ErrStat2, ErrMsg2 ) ! OutData_Orca CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -40283,27 +43689,13 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MeshUnpack( OutData%u_ED_HubPtLoad_2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_ED_HubPtLoad_2 + CALL IceFloe_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_IceF, ErrStat2, ErrMsg2 ) ! InData_IceF CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_BD_RootMotion 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%u_BD_RootMotion)) DEALLOCATE(OutData%u_BD_RootMotion) - ALLOCATE(OutData%u_BD_RootMotion(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_BD_RootMotion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%u_BD_RootMotion,1), UBOUND(OutData%u_BD_RootMotion,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -40337,29 +43729,13 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MeshUnpack( OutData%u_BD_RootMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_BD_RootMotion + CALL IceFloe_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_IceF, ErrStat2, ErrMsg2 ) ! OutData_IceF CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y_BD_BldMotion_4Loads 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%y_BD_BldMotion_4Loads)) DEALLOCATE(OutData%y_BD_BldMotion_4Loads) - ALLOCATE(OutData%y_BD_BldMotion_4Loads(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_BD_BldMotion_4Loads.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%y_BD_BldMotion_4Loads,1), UBOUND(OutData%y_BD_BldMotion_4Loads,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -40393,15 +43769,13 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MeshUnpack( OutData%y_BD_BldMotion_4Loads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! y_BD_BldMotion_4Loads + CALL IceD_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_IceD, ErrStat2, ErrMsg2 ) ! InData_IceD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -40435,7 +43809,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MeshUnpack( OutData%u_Orca_PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_Orca_PtfmMesh + CALL IceD_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_IceD, ErrStat2, ErrMsg2 ) ! OutData_IceD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -40475,189 +43849,54 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MeshUnpack( OutData%u_ExtPtfm_PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_ExtPtfm_PtfmMesh + CALL SC_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_SC, ErrStat2, ErrMsg2 ) ! InData_SC CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE FAST_UnPackModuleMapType - - SUBROUTINE FAST_CopyExternInputType( SrcExternInputTypeData, DstExternInputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_ExternInputType), INTENT(IN) :: SrcExternInputTypeData - TYPE(FAST_ExternInputType), INTENT(INOUT) :: DstExternInputTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyExternInputType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstExternInputTypeData%GenTrq = SrcExternInputTypeData%GenTrq - DstExternInputTypeData%ElecPwr = SrcExternInputTypeData%ElecPwr - DstExternInputTypeData%YawPosCom = SrcExternInputTypeData%YawPosCom - DstExternInputTypeData%YawRateCom = SrcExternInputTypeData%YawRateCom - DstExternInputTypeData%BlPitchCom = SrcExternInputTypeData%BlPitchCom - DstExternInputTypeData%HSSBrFrac = SrcExternInputTypeData%HSSBrFrac - DstExternInputTypeData%LidarFocus = SrcExternInputTypeData%LidarFocus - END SUBROUTINE FAST_CopyExternInputType - - SUBROUTINE FAST_DestroyExternInputType( ExternInputTypeData, ErrStat, ErrMsg ) - TYPE(FAST_ExternInputType), INTENT(INOUT) :: ExternInputTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyExternInputType' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE FAST_DestroyExternInputType - - SUBROUTINE FAST_PackExternInputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FAST_ExternInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackExternInputType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! GenTrq - Re_BufSz = Re_BufSz + 1 ! ElecPwr - Re_BufSz = Re_BufSz + 1 ! YawPosCom - Re_BufSz = Re_BufSz + 1 ! YawRateCom - Re_BufSz = Re_BufSz + SIZE(InData%BlPitchCom) ! BlPitchCom - Re_BufSz = Re_BufSz + 1 ! HSSBrFrac - Re_BufSz = Re_BufSz + SIZE(InData%LidarFocus) ! LidarFocus - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%GenTrq - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ElecPwr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawPosCom - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawRateCom - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%BlPitchCom,1), UBOUND(InData%BlPitchCom,1) - ReKiBuf(Re_Xferred) = InData%BlPitchCom(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%HSSBrFrac - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%LidarFocus,1), UBOUND(InData%LidarFocus,1) - ReKiBuf(Re_Xferred) = InData%LidarFocus(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE FAST_PackExternInputType + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SC_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_SC, ErrStat2, ErrMsg2 ) ! OutData_SC + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - SUBROUTINE FAST_UnPackExternInputType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FAST_ExternInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackExternInputType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%GenTrq = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ElecPwr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawPosCom = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawRateCom = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%BlPitchCom,1) - i1_u = UBOUND(OutData%BlPitchCom,1) - DO i1 = LBOUND(OutData%BlPitchCom,1), UBOUND(OutData%BlPitchCom,1) - OutData%BlPitchCom(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%HSSBrFrac = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%LidarFocus,1) - i1_u = UBOUND(OutData%LidarFocus,1) - DO i1 = LBOUND(OutData%LidarFocus,1), UBOUND(OutData%LidarFocus,1) - OutData%LidarFocus(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE FAST_UnPackExternInputType + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END SUBROUTINE FAST_UnPackInitData SUBROUTINE FAST_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) TYPE(FAST_MiscVarType), INTENT(IN) :: SrcMiscData From 09d5d3cd140f346d72cc9fc81eb43da6b41321b2 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Mon, 8 Jun 2020 08:51:15 -0600 Subject: [PATCH 51/72] fix syntax in regression test python script --- 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 8d92c94ba0..60678f04ee 100644 --- a/reg_tests/executeOpenfastLinearRegressionCase.py +++ b/reg_tests/executeOpenfastLinearRegressionCase.py @@ -142,7 +142,7 @@ def isclose(a, b, rel_tol=1e-09, abs_tol=0.0): else: names = os.listdir(src) for name in names: - if name is "ServoData": + if name == "ServoData": continue srcname = os.path.join(src, name) dstname = os.path.join(dst, name) From 306e04a3fe81695e181b79cf86929d7a187fa80d Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Tue, 9 Jun 2020 10:52:22 -0600 Subject: [PATCH 52/72] ExtPtfm: move lapack interfaces to NWTC_LAPACK Note that I removed ability to linearize with ExtPtfm model in OpenFAST because it isn't fully implemented (i.e., the input-output solves aren't in the linearization matrices). I also commented out the ExtPtfm standard inputs because it seems like they should be just normal inputs. At the minimum, these should be documented before being included here. --- modules/extptfm/src/ExtPtfm_MCKF.f90 | 44 +---------------- .../src/NetLib/lapack/NWTC_LAPACK.f90 | 47 +++++++++++++++++++ modules/openfast-library/src/FAST_Lin.f90 | 18 +++---- modules/openfast-library/src/FAST_Subs.f90 | 2 +- 4 files changed, 59 insertions(+), 52 deletions(-) diff --git a/modules/extptfm/src/ExtPtfm_MCKF.f90 b/modules/extptfm/src/ExtPtfm_MCKF.f90 index e27fec588c..e5c32f0337 100644 --- a/modules/extptfm/src/ExtPtfm_MCKF.f90 +++ b/modules/extptfm/src/ExtPtfm_MCKF.f90 @@ -31,6 +31,7 @@ MODULE ExtPtfm_MCKF USE ExtPtfm_MCKF_Types USE ExtPtfm_MCKF_Parameters ! ID_*, N_INPUTS, N_OUTPUTS USE NWTC_Library + USE NWTC_LAPACK IMPLICIT NONE @@ -62,48 +63,7 @@ MODULE ExtPtfm_MCKF - INTERFACE LAPACK_COPY - SUBROUTINE DCOPY(N,DX,INCX,DY,INCY) - USE Precision, only: R8Ki - INTEGER :: INCX,INCY,N - real(R8Ki) :: DX(*),DY(*) - ENDSUBROUTINE - SUBROUTINE SCOPY(N,X,INCX,Y,INCY) - USE Precision, only: SiKi - INTEGER :: INCX,INCY,N - real(SiKi) :: X(*),Y(*) - ENDSUBROUTINE - END INTERFACE - INTERFACE LAPACK_GEMV - SUBROUTINE DGEMV(TRANS,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) - USE Precision, only: R8Ki - real(R8Ki) :: ALPHA,BETA - integer :: INCX,INCY,LDA,M,N - character :: TRANS - real(R8Ki) :: A(LDA,*),X(*),Y(*) - ENDSUBROUTINE - SUBROUTINE SGEMV(TRANS,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) - USE Precision, only: SiKi - real(SiKi) :: ALPHA,BETA - integer :: INCX,INCY,LDA,M,N - character :: TRANS - real(SiKi) :: A(LDA,*),X(*),Y(*) - ENDSUBROUTINE - END INTERFACE LAPACK_GEMV - INTERFACE LAPACK_AXPY - SUBROUTINE DAXPY(N,DA,DX,INCX,DY,INCY) - USE Precision, only: R8Ki - real(R8Ki) :: DA - integer :: INCX,INCY,N - real(R8Ki) :: DX(*),DY(*) - ENDSUBROUTINE - SUBROUTINE SAXPY(N,A,X,INCX,Y,INCY) - USE Precision, only: SiKi - real(SiKi) :: A - integer :: INCX,INCY,N - real(SiKi) :: X(*),Y(*) - ENDSUBROUTINE - END INTERFACE + CONTAINS !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ diff --git a/modules/nwtc-library/src/NetLib/lapack/NWTC_LAPACK.f90 b/modules/nwtc-library/src/NetLib/lapack/NWTC_LAPACK.f90 index f82fff275c..99cdd7a088 100644 --- a/modules/nwtc-library/src/NetLib/lapack/NWTC_LAPACK.f90 +++ b/modules/nwtc-library/src/NetLib/lapack/NWTC_LAPACK.f90 @@ -99,7 +99,54 @@ MODULE NWTC_LAPACK MODULE PROCEDURE LAPACK_sgesvd END INTERFACE + +!> straight-up lapack routines (from ExtPtfm_MCKF): + INTERFACE LAPACK_COPY + SUBROUTINE DCOPY(N,DX,INCX,DY,INCY) + USE Precision, only: R8Ki + INTEGER :: INCX,INCY,N + real(R8Ki) :: DX(*),DY(*) + ENDSUBROUTINE + SUBROUTINE SCOPY(N,X,INCX,Y,INCY) + USE Precision, only: SiKi + INTEGER :: INCX,INCY,N + real(SiKi) :: X(*),Y(*) + ENDSUBROUTINE + END INTERFACE + + INTERFACE LAPACK_GEMV + SUBROUTINE DGEMV(TRANS,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) + USE Precision, only: R8Ki + real(R8Ki) :: ALPHA,BETA + integer :: INCX,INCY,LDA,M,N + character :: TRANS + real(R8Ki) :: A(LDA,*),X(*),Y(*) + ENDSUBROUTINE + SUBROUTINE SGEMV(TRANS,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) + USE Precision, only: SiKi + real(SiKi) :: ALPHA,BETA + integer :: INCX,INCY,LDA,M,N + character :: TRANS + real(SiKi) :: A(LDA,*),X(*),Y(*) + ENDSUBROUTINE + END INTERFACE LAPACK_GEMV + + INTERFACE LAPACK_AXPY + SUBROUTINE DAXPY(N,DA,DX,INCX,DY,INCY) + USE Precision, only: R8Ki + real(R8Ki) :: DA + integer :: INCX,INCY,N + real(R8Ki) :: DX(*),DY(*) + ENDSUBROUTINE + SUBROUTINE SAXPY(N,A,X,INCX,Y,INCY) + USE Precision, only: SiKi + real(SiKi) :: A + integer :: INCX,INCY,N + real(SiKi) :: X(*),Y(*) + ENDSUBROUTINE + END INTERFACE + CONTAINS !======================================================================= diff --git a/modules/openfast-library/src/FAST_Lin.f90 b/modules/openfast-library/src/FAST_Lin.f90 index e281f2852a..fc4b1d2ec3 100644 --- a/modules/openfast-library/src/FAST_Lin.f90 +++ b/modules/openfast-library/src/FAST_Lin.f90 @@ -492,13 +492,13 @@ SUBROUTINE Init_Lin_InputOutput(p_FAST, y_FAST, NumBl, ErrStat, ErrMsg) y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%use_u(y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%SizeLin(LIN_INPUT_COL)) = .true. end if - - ! ExtPtfm standard inputs: x1, x1dot x1ddot ! TODO TODO TODO CHECK - if (p_FAST%CompSub == MODULE_ExtPtfm) then - do j = 1,18 - y_FAST%Lin%Modules(MODULE_ExtPtfm)%Instance(1)%use_u(y_FAST%Lin%Modules(MODULE_ExtPtfm)%Instance(1)%SizeLin(LIN_INPUT_COL)+1-j) = .true. - end do - end if + !bjj: removed because I'm not sure these should be included in the "standard" inputs + !!!! ExtPtfm standard inputs: x1, x1dot x1ddot ! TODO TODO TODO CHECK + !!!if (p_FAST%CompSub == MODULE_ExtPtfm) then + !!! do j = 1,18 + !!! y_FAST%Lin%Modules(MODULE_ExtPtfm)%Instance(1)%use_u(y_FAST%Lin%Modules(MODULE_ExtPtfm)%Instance(1)%SizeLin(LIN_INPUT_COL)+1-j) = .true. + !!! end do + !!!end if elseif(p_FAST%LinInputs == LIN_ALL) then do i = 1,p_FAST%Lin_NumMods @@ -1652,7 +1652,7 @@ SUBROUTINE Glue_Jacobians( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, OpFM, end if IF (p_FAST%CompSub == Module_ExtPtfm) THEN - write(*,*)'>>> FAST_LIN: Linear_ExtPtfm_InputSolve_du, TODO' + CALL WrScr('>>> FAST_LIN: Linear_ExtPtfm_InputSolve_du, TODO') ENDIF @@ -1757,7 +1757,7 @@ SUBROUTINE Glue_Jacobians( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, OpFM, end if IF (p_FAST%CompSub == Module_ExtPtfm) THEN - write(*,*)'>>> FAST_LIN: Linear_ExtPtfm_InputSolve_dy, TODO' + CALL WrScr('>>> FAST_LIN: Linear_ExtPtfm_InputSolve_dy, TODO') ENDIF END SUBROUTINE Glue_Jacobians diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 230dc07e67..3b35b89b25 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -1678,7 +1678,7 @@ SUBROUTINE ValidateInputData(p, m_FAST, ErrStat, ErrMsg) if (p%CompInflow == MODULE_OpFM) call SetErrStat(ErrID_Fatal,'Linearization is not implemented for the OpenFOAM coupling.',ErrStat, ErrMsg, RoutineName) if (p%CompAero == MODULE_AD14) call SetErrStat(ErrID_Fatal,'Linearization is not implemented for the AeroDyn v14 module.',ErrStat, ErrMsg, RoutineName) !if (p%CompSub == MODULE_SD) call SetErrStat(ErrID_Fatal,'Linearization is not implemented for the SubDyn module.',ErrStat, ErrMsg, RoutineName) - if (p%CompSub /= MODULE_None) call SetErrStat(ErrID_Fatal,'Linearization is not implemented for the any of the substructure modules.',ErrStat, ErrMsg, RoutineName) + if (p%CompSub /= MODULE_None) call SetErrStat(ErrID_Fatal,'Linearization is not implemented for the any of the substructure modules.',ErrStat, ErrMsg, RoutineName) if (p%CompMooring /= MODULE_None .and. p%CompMooring /= MODULE_MAP) call SetErrStat(ErrID_Fatal,'Linearization is not implemented for the FEAMooring or MoorDyn mooring modules.',ErrStat, ErrMsg, RoutineName) if (p%CompIce /= MODULE_None) call SetErrStat(ErrID_Fatal,'Linearization is not implemented for any of the ice loading modules.',ErrStat, ErrMsg, RoutineName) From f85ff069ffe8dbf3da108ef988c2dfa187f0a367 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Thu, 11 Jun 2020 16:26:04 -0600 Subject: [PATCH 53/72] Fix index for BD current input OP in TrimSolution and mode shape --- modules/openfast-library/src/FAST_Lin.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/modules/openfast-library/src/FAST_Lin.f90 b/modules/openfast-library/src/FAST_Lin.f90 index fc4b1d2ec3..0310c3a576 100644 --- a/modules/openfast-library/src/FAST_Lin.f90 +++ b/modules/openfast-library/src/FAST_Lin.f90 @@ -4224,7 +4224,7 @@ SUBROUTINE SaveOP(i, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, ExtPtf CALL BD_CopyOtherState (BD%OtherSt( k,STATE_CURR), y_FAST%op%OtherSt_BD(k, i), CtrlCode, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyInput (BD%Input(k,1), y_FAST%op%u_BD(k, i), CtrlCode, Errstat2, ErrMsg2) + CALL BD_CopyInput (BD%Input(1,k), y_FAST%op%u_BD(k, i), CtrlCode, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO @@ -4631,7 +4631,7 @@ SUBROUTINE SetOperatingPoint(i, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, O CALL BD_CopyOtherState (y_FAST%op%OtherSt_BD(k, i), BD%OtherSt( k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyInput (y_FAST%op%u_BD(k, i), BD%Input(k,1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL BD_CopyInput (y_FAST%op%u_BD(k, i), BD%Input(1, k), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO From 41d39b6b0c45015b4f43f437a13c3a4305ac0d52 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Tue, 16 Jun 2020 07:56:44 -0600 Subject: [PATCH 54/72] Bug fix: AddOrSub2Pi had infinite loop if angles were exactly pi apart That one's been in there for a LONG time --- modules/nwtc-library/src/NWTC_Num.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/modules/nwtc-library/src/NWTC_Num.f90 b/modules/nwtc-library/src/NWTC_Num.f90 index a243d5f7f4..714d05f043 100644 --- a/modules/nwtc-library/src/NWTC_Num.f90 +++ b/modules/nwtc-library/src/NWTC_Num.f90 @@ -258,7 +258,7 @@ SUBROUTINE AddOrSub2Pi_R4 ( OldAngle, NewAngle ) DelAngle = OldAngle - NewAngle - DO WHILE ( ABS( DelAngle ) >= Pi_R4 ) + DO WHILE ( ABS( DelAngle ) > Pi_R4 ) NewAngle = NewAngle + SIGN( TwoPi_R4, DelAngle ) DelAngle = OldAngle - NewAngle @@ -288,7 +288,7 @@ SUBROUTINE AddOrSub2Pi_R8 ( OldAngle, NewAngle ) DelAngle = OldAngle - NewAngle - DO WHILE ( ABS( DelAngle ) >= Pi_R8 ) + DO WHILE ( ABS( DelAngle ) > Pi_R8 ) NewAngle = NewAngle + SIGN( TwoPi_R8, DelAngle ) DelAngle = OldAngle - NewAngle @@ -318,7 +318,7 @@ SUBROUTINE AddOrSub2Pi_R16 ( OldAngle, NewAngle ) DelAngle = OldAngle - NewAngle - DO WHILE ( ABS( DelAngle ) >= Pi_R16 ) + DO WHILE ( ABS( DelAngle ) > Pi_R16 ) NewAngle = NewAngle + SIGN( TwoPi_R16, DelAngle ) DelAngle = OldAngle - NewAngle From 81930bc856a9961ceb9c5660f1dff2de83c17cd0 Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Thu, 18 Jun 2020 16:22:53 -0600 Subject: [PATCH 55/72] Change github action to only list names of files that are different --- .github/actions/compile-and-test/entrypoint.sh | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/actions/compile-and-test/entrypoint.sh b/.github/actions/compile-and-test/entrypoint.sh index 8d1b38cdc2..62de74efd8 100755 --- a/.github/actions/compile-and-test/entrypoint.sh +++ b/.github/actions/compile-and-test/entrypoint.sh @@ -24,7 +24,7 @@ cd /openfast # Display the differences between this commit and `dev` echo git-diff from ${GITHUB_REF} to dev: -git diff dev +git diff dev --numstat # Move into the "build" directory, remove the old reg tests, and compile cd /openfast/build From c9c25b2b94bb232fbdea8fe5ace88b11f0884b28 Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Mon, 22 Jun 2020 16:49:04 -0600 Subject: [PATCH 56/72] Change warning on nodal outputs, update tests --- modules/aerodyn/src/AeroDyn_IO.f90 | 12 ++++++------ modules/beamdyn/src/BeamDyn_IO.f90 | 10 +++++----- modules/elastodyn/src/ElastoDyn_IO.f90 | 14 +++++++------- reg_tests/r-test | 2 +- 4 files changed, 19 insertions(+), 19 deletions(-) diff --git a/modules/aerodyn/src/AeroDyn_IO.f90 b/modules/aerodyn/src/AeroDyn_IO.f90 index d6be842a8c..c86ca02bce 100644 --- a/modules/aerodyn/src/AeroDyn_IO.f90 +++ b/modules/aerodyn/src/AeroDyn_IO.f90 @@ -2378,13 +2378,13 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, ADBlFile, OutFileRoot, UnE !----------- OUTLIST ----------------------------------------------------------- ! In case there is something ill-formed in the additional nodal outputs section, we will simply ignore it. - ErrMsg_NoAllBldNdOuts='AllBldNd section of AeroDyn input file not found or improperly formatted. Therefore assuming no nodal outputs.' + ErrMsg_NoAllBldNdOuts='AllBldNd section of AeroDyn input file not found or improperly formatted.' !----------- OUTLIST for BldNd ----------------------------------------------------------- CALL ReadCom( UnIn, InputFile, 'Section Header: OutList for Blade node channels', ErrStat2, ErrMsg2, UnEc ) IF ( ErrStat2 >= AbortErrLev ) THEN InputFileData%BldNd_NumOuts = 0 - call wrscr( trim(ErrMsg_NoAllBldNdOuts)//' --> '//trim(ErrMsg2) ) + call wrscr( trim(ErrMsg_NoAllBldNdOuts) ) CALL Cleanup() RETURN ENDIF @@ -2396,7 +2396,7 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, ADBlFile, OutFileRoot, UnE CALL ReadVar( UnIn, InputFile, InputFileData%BldNd_BladesOut, 'BldNd_BladesOut', 'Which blades to output node data on.'//TRIM(Num2Lstr(I)), ErrStat2, ErrMsg2, UnEc ) IF ( ErrStat2 >= AbortErrLev ) THEN InputFileData%BldNd_NumOuts = 0 - call wrscr( trim(ErrMsg_NoAllBldNdOuts)//' --> '//trim(ErrMsg2) ) + call wrscr( trim(ErrMsg_NoAllBldNdOuts) ) CALL Cleanup() RETURN ENDIF @@ -2407,7 +2407,7 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, ADBlFile, OutFileRoot, UnE CALL ReadVar( UnIn, InputFile, InputFileData%BldNd_BlOutNd_Str, 'BldNd_BlOutNd_Str', 'Which nodes to output node data on.'//TRIM(Num2Lstr(I)), ErrStat2, ErrMsg2, UnEc ) IF ( ErrStat2 >= AbortErrLev ) THEN InputFileData%BldNd_NumOuts = 0 - call wrscr( trim(ErrMsg_NoAllBldNdOuts)//' --> '//trim(ErrMsg2) ) + call wrscr( trim(ErrMsg_NoAllBldNdOuts) ) CALL Cleanup() RETURN ENDIF @@ -2417,7 +2417,7 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, ADBlFile, OutFileRoot, UnE CALL ReadCom( UnIn, InputFile, 'Section Header: OutList', ErrStat2, ErrMsg2, UnEc ) IF ( ErrStat2 >= AbortErrLev ) THEN InputFileData%BldNd_NumOuts = 0 - call wrscr( trim(ErrMsg_NoAllBldNdOuts)//' --> '//trim(ErrMsg2) ) + call wrscr( trim(ErrMsg_NoAllBldNdOuts) ) CALL Cleanup() RETURN ENDIF @@ -2427,7 +2427,7 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, ADBlFile, OutFileRoot, UnE CALL ReadOutputList ( UnIn, InputFile, InputFileData%BldNd_OutList, InputFileData%BldNd_NumOuts, 'OutList', "List of user-requested output channels", ErrStat2, ErrMsg2, UnEc ) ! Routine in NWTC Subroutine Library IF ( ErrStat2 >= AbortErrLev ) THEN InputFileData%BldNd_NumOuts = 0 - call wrscr( trim(ErrMsg_NoAllBldNdOuts)//' --> '//trim(ErrMsg2) ) + call wrscr( trim(ErrMsg_NoAllBldNdOuts) ) CALL Cleanup() RETURN ENDIF diff --git a/modules/beamdyn/src/BeamDyn_IO.f90 b/modules/beamdyn/src/BeamDyn_IO.f90 index 3898574b6e..92af5a918c 100644 --- a/modules/beamdyn/src/BeamDyn_IO.f90 +++ b/modules/beamdyn/src/BeamDyn_IO.f90 @@ -975,7 +975,7 @@ SUBROUTINE BD_ReadPrimaryFile(InputFile,InputFileData,OutFileRoot,UnEc,ErrStat,E !----------- OUTLIST ----------------------------------------------------------- ! In case there is something ill-formed in the additional nodal outputs section, we will simply ignore it. - ErrMsg_NoBldNdOuts='BldNd section of BeamDyn input file not found or improperly formatted. Therefore assuming no nodal outputs.' + ErrMsg_NoBldNdOuts='Nodal outputs section of BeamDyn input file not found or improperly formatted.' InputFileData%BldNd_NumOuts = 0 ! Just in case we don't get an error but have no nodal outputs. @@ -983,7 +983,7 @@ SUBROUTINE BD_ReadPrimaryFile(InputFile,InputFileData,OutFileRoot,UnEc,ErrStat,E CALL ReadCom( UnIn, InputFile, 'Section Header: OutList for Blade node channels', ErrStat2, ErrMsg2, UnEc ) IF ( ErrStat2 >= AbortErrLev ) THEN InputFileData%BldNd_NumOuts = 0 - call wrscr( trim(ErrMsg_NoBldNdOuts)//' --> '//trim(ErrMsg2) ) + call wrscr( trim(ErrMsg_NoBldNdOuts) ) CALL Cleanup() RETURN ENDIF @@ -993,7 +993,7 @@ SUBROUTINE BD_ReadPrimaryFile(InputFile,InputFileData,OutFileRoot,UnEc,ErrStat,E CALL ReadVar( UnIn, InputFile, InputFileData%BldNd_BlOutNd_Str, 'BldNd_BlOutNd_Str', 'Which nodes to output node data on.'//TRIM(Num2Lstr(I)), ErrStat2, ErrMsg2, UnEc ) IF ( ErrStat2 >= AbortErrLev ) THEN InputFileData%BldNd_NumOuts = 0 - call wrscr( trim(ErrMsg_NoBldNdOuts)//' --> '//trim(ErrMsg2) ) + call wrscr( trim(ErrMsg_NoBldNdOuts) ) CALL Cleanup() RETURN ENDIF @@ -1003,7 +1003,7 @@ SUBROUTINE BD_ReadPrimaryFile(InputFile,InputFileData,OutFileRoot,UnEc,ErrStat,E CALL ReadCom( UnIn, InputFile, 'Section Header: OutList', ErrStat2, ErrMsg2, UnEc ) IF ( ErrStat2 >= AbortErrLev ) THEN InputFileData%BldNd_NumOuts = 0 - CALL SetErrStat( ErrID_Warn, ErrMsg_NoBldNdOuts//' --> '//ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SetErrStat( ErrID_Warn, ErrMsg_NoBldNdOuts, ErrStat, ErrMsg, RoutineName ) CALL Cleanup() RETURN ENDIF @@ -1013,7 +1013,7 @@ SUBROUTINE BD_ReadPrimaryFile(InputFile,InputFileData,OutFileRoot,UnEc,ErrStat,E CALL ReadOutputList ( UnIn, InputFile, InputFileData%BldNd_OutList, InputFileData%BldNd_NumOuts, 'BldNd_OutList', "List of user-requested output channels", ErrStat2, ErrMsg2, UnEc ) ! Routine in NWTC Subroutine Library IF ( ErrStat2 >= AbortErrLev ) THEN InputFileData%BldNd_NumOuts = 0 - call wrscr( trim(ErrMsg_NoBldNdOuts)//' --> '//trim(ErrMsg2) ) + call wrscr( trim(ErrMsg_NoBldNdOuts) ) CALL Cleanup() RETURN ENDIF diff --git a/modules/elastodyn/src/ElastoDyn_IO.f90 b/modules/elastodyn/src/ElastoDyn_IO.f90 index c841e9c936..16eb7528a6 100644 --- a/modules/elastodyn/src/ElastoDyn_IO.f90 +++ b/modules/elastodyn/src/ElastoDyn_IO.f90 @@ -4334,14 +4334,14 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, BldFile, FurlFile, TwrFile !----------- OUTLIST ----------------------------------------------------------- - ! In case there is something ill-formed in the additional nodal outputs section, we will simply ignore it and assume that it is an NREL compatable input file. - ErrMsg_NoAllBldNdOuts='AllBldNd section of ElastoDyn input file not found or improperly formatted. Therefore assuming no nodal outputs.' + ! In case there is something ill-formed in the additional nodal outputs section, we will simply ignore it and assume that this section does not exist. + ErrMsg_NoAllBldNdOuts='Nodal outputs section of ElastoDyn input file not found or improperly formatted.' !----------- OUTLIST for BldNd ----------------------------------------------------------- CALL ReadCom( UnIn, InputFile, 'Section Header: OutList for Blade node channels', ErrStat2, ErrMsg2, UnEc ) IF ( ErrStat2 >= AbortErrLev ) THEN InputFileData%BldNd_NumOuts = 0 - call wrscr( trim(ErrMsg_NoAllBldNdOuts)//' --> '//trim(ErrMsg2) ) + call wrscr( trim(ErrMsg_NoAllBldNdOuts) ) CALL Cleanup() RETURN ENDIF @@ -4353,7 +4353,7 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, BldFile, FurlFile, TwrFile CALL ReadVar( UnIn, InputFile, InputFileData%BldNd_BladesOut, 'BldNd_BladesOut', 'Which blades to output node data on.'//TRIM(Num2Lstr(I)), ErrStat2, ErrMsg2, UnEc ) IF ( ErrStat2 >= AbortErrLev ) THEN InputFileData%BldNd_NumOuts = 0 - call wrscr( trim(ErrMsg_NoAllBldNdOuts)//' --> '//trim(ErrMsg2) ) + call wrscr( trim(ErrMsg_NoAllBldNdOuts) ) CALL Cleanup() RETURN ENDIF @@ -4364,7 +4364,7 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, BldFile, FurlFile, TwrFile CALL ReadVar( UnIn, InputFile, InputFileData%BldNd_BlOutNd_Str, 'BldNd_BlOutNd_Str', 'Which nodes to output node data on.'//TRIM(Num2Lstr(I)), ErrStat2, ErrMsg2, UnEc ) IF ( ErrStat2 >= AbortErrLev ) THEN InputFileData%BldNd_NumOuts = 0 - call wrscr( trim(ErrMsg_NoAllBldNdOuts)//' --> '//trim(ErrMsg2) ) + call wrscr( trim(ErrMsg_NoAllBldNdOuts) ) CALL Cleanup() RETURN ENDIF @@ -4374,7 +4374,7 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, BldFile, FurlFile, TwrFile CALL ReadCom( UnIn, InputFile, 'Section Header: OutList', ErrStat2, ErrMsg2, UnEc ) IF ( ErrStat2 >= AbortErrLev ) THEN InputFileData%BldNd_NumOuts = 0 - call wrscr( trim(ErrMsg_NoAllBldNdOuts)//' --> '//trim(ErrMsg2) ) + call wrscr( trim(ErrMsg_NoAllBldNdOuts) ) CALL Cleanup() RETURN ENDIF @@ -4384,7 +4384,7 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, BldFile, FurlFile, TwrFile CALL ReadOutputList ( UnIn, InputFile, InputFileData%BldNd_OutList, InputFileData%BldNd_NumOuts, 'BldNd_OutList', "List of user-requested output channels", ErrStat2, ErrMsg2, UnEc ) ! Routine in NWTC Subroutine Library IF ( ErrStat2 >= AbortErrLev ) THEN InputFileData%BldNd_NumOuts = 0 - call wrscr( trim(ErrMsg_NoAllBldNdOuts)//' --> '//trim(ErrMsg2) ) + call wrscr( trim(ErrMsg_NoAllBldNdOuts) ) CALL Cleanup() RETURN ENDIF diff --git a/reg_tests/r-test b/reg_tests/r-test index 3cdfafa4fd..079c09ad7a 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 3cdfafa4fdbcd275e317f8bf86b974ef55c76ae5 +Subproject commit 079c09ad7a6d49ef49db923994f9c5b9a45f260d From b3d70a8ff0a580b6c898faa5a02e54e26d1cbd77 Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Mon, 22 Jun 2020 16:55:45 -0600 Subject: [PATCH 57/72] Update 5MW_Land_BD_DLL_WTurb test case results --- 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 079c09ad7a..b25cad2dbc 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 079c09ad7a6d49ef49db923994f9c5b9a45f260d +Subproject commit b25cad2dbc2411af745231ed7f16522e0f20391f From ce5acabc4a8207f36adaf79e10e31eff6ac64ed9 Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Tue, 23 Jun 2020 09:19:44 -0600 Subject: [PATCH 58/72] Updated reg-test --- 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 b25cad2dbc..60b872355c 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit b25cad2dbc2411af745231ed7f16522e0f20391f +Subproject commit 60b872355c54cf42913fbeb40f0a17e92d02e18e From 4132035eb4c4ab2058cbc2f06611546980189f27 Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Tue, 23 Jun 2020 10:34:41 -0600 Subject: [PATCH 59/72] [BugFix] unitialized WaveDir when no waves This prevented the SS_Excitation from working --- modules/hydrodyn/src/HydroDyn.f90 | 2 ++ modules/hydrodyn/src/HydroDyn_Input.f90 | 6 +++++- 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/modules/hydrodyn/src/HydroDyn.f90 b/modules/hydrodyn/src/HydroDyn.f90 index 9f1b60fb8e..f8567fe657 100644 --- a/modules/hydrodyn/src/HydroDyn.f90 +++ b/modules/hydrodyn/src/HydroDyn.f90 @@ -592,6 +592,8 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I DEALLOCATE( Waves_InitOut%WaveElev ) DEALLOCATE( Waves_InitOut%WaveTime ) DEALLOCATE( Waves_InitOut%NodeInWater ) + ELSE ! No waves + Waves_InitOut%WaveDir=InitInp%Waves%WaveDir ! Set direction: needed for SS excitation END IF !========================================================================== diff --git a/modules/hydrodyn/src/HydroDyn_Input.f90 b/modules/hydrodyn/src/HydroDyn_Input.f90 index 83c5e1b773..b4042f2373 100644 --- a/modules/hydrodyn/src/HydroDyn_Input.f90 +++ b/modules/hydrodyn/src/HydroDyn_Input.f90 @@ -2475,7 +2475,11 @@ SUBROUTINE HydroDynInput_ProcessInitData( InitInp, ErrStat, ErrMsg ) ! TODO: Issue warning if WaveTMax was not already 0.0 in this case. IF ( .NOT. EqualRealNos(InitInp%Waves%WaveTMax, 0.0_DbKi) ) THEN CALL WrScr( ' Setting WaveTMax to 0.0 since WaveMod = 0' ) - InitInp%Waves%WaveTMax = 0.0 + InitInp%Waves%WaveTMax = 0.0 + END IF + IF ( .NOT. EqualRealNos(InitInp%Waves%WaveDir, 0.0_SiKi) ) THEN + CALL WrScr( ' Setting WaveDir to 0.0 since WaveMod = 0' ) + InitInp%Waves%WaveDir = 0.0 END IF ELSEIF ( InitInp%Waves%WaveMod == 5 ) THEN ! User wave elevation file reading in IF (InitInp%TMax > InitInp%Waves%WaveTMax ) THEN From 9df32ac3a4243864a8d42b84a436ad3cebda72ff Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Tue, 23 Jun 2020 11:00:41 -0600 Subject: [PATCH 60/72] HD bug fix: WaveDir isn't always initialized also fixed some comments --- modules/hydrodyn/src/Morison_Output.f90 | 2 +- modules/hydrodyn/src/SS_Excitation.f90 | 2 +- modules/hydrodyn/src/Waves.f90 | 3 ++- 3 files changed, 4 insertions(+), 3 deletions(-) diff --git a/modules/hydrodyn/src/Morison_Output.f90 b/modules/hydrodyn/src/Morison_Output.f90 index dba8a047f0..f859a3a556 100644 --- a/modules/hydrodyn/src/Morison_Output.f90 +++ b/modules/hydrodyn/src/Morison_Output.f90 @@ -7327,7 +7327,7 @@ SUBROUTINE MrsnOut_Init( InitInp, y, p, InitOut, ErrStat, ErrMsg ) IF ( InitInp%OutAll ) THEN ! p%NumOutAll = InitInp%NMember*2*22 + InitInp%NJoints*19 - p%NumOutAll = 0 + p%NumOutAll = 0 ELSE p%NumOutAll = 0 END IF diff --git a/modules/hydrodyn/src/SS_Excitation.f90 b/modules/hydrodyn/src/SS_Excitation.f90 index 7c913081ce..f2071c1db1 100644 --- a/modules/hydrodyn/src/SS_Excitation.f90 +++ b/modules/hydrodyn/src/SS_Excitation.f90 @@ -110,7 +110,7 @@ SUBROUTINE SS_Exc_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Ini CALL ReadCom ( UnSS, TRIM(InitInp%InputFile)//'.ssexctn', 'Header',ErrStat2, ErrMsg2 )! Reads the first entire line (Title header) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Exc_Init') - CALL ReadVar( UnSS,TRIM(InitInp%InputFile)//'.ssexctn', WaveDir, 'WaveDir', 'Wave direction (deg)',ErrStat2, ErrMsg2) ! Reads in the third line, containing the number of states + CALL ReadVar( UnSS,TRIM(InitInp%InputFile)//'.ssexctn', WaveDir, 'WaveDir', 'Wave direction (deg)',ErrStat2, ErrMsg2) ! Reads in the second line, containing the wave direction CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Exc_Init') ! Check that excitation state-space file Beta angle (in degrees) matches the HydroDyn input file angle diff --git a/modules/hydrodyn/src/Waves.f90 b/modules/hydrodyn/src/Waves.f90 index ecaae852d6..04cdd41e64 100644 --- a/modules/hydrodyn/src/Waves.f90 +++ b/modules/hydrodyn/src/Waves.f90 @@ -2189,7 +2189,8 @@ SUBROUTINE Waves_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ! subroutine calls as necessary. InitOut%WaveDirMin = InitInp%WaveDir InitOut%WaveDirMax = InitInp%WaveDir - + InitOut%WaveDir = InitInp%WaveDir ! Not sure why there are so many copies of this variable, but InitOut%WaveDir must be set, and isn't in all cases otherwise. + ! Initialize the variables associated with the incident wave: From b32598cdc9e1e036499145898c4805092b4e851e Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Tue, 23 Jun 2020 11:41:45 -0600 Subject: [PATCH 61/72] Make mode-shape input files specified relative to the input file --- modules/openfast-library/src/FAST_Subs.f90 | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 3b35b89b25..2cca60d7fc 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -7124,6 +7124,7 @@ SUBROUTINE ReadModeShapeFile(p_FAST, InputFile, ErrStat, ErrMsg, checkpointOnly) CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ReadModeShapeFile' + CHARACTER(1024) :: PriPath ! Path name of the primary file INTEGER(IntKi) :: i INTEGER(IntKi) :: UnIn INTEGER(IntKi) :: UnEc @@ -7133,6 +7134,8 @@ SUBROUTINE ReadModeShapeFile(p_FAST, InputFile, ErrStat, ErrMsg, checkpointOnly) ErrMsg = "" UnEc = -1 + CALL GetPath( InputFile, PriPath ) ! Input files will be relative to the path where the primary input file is located. + ! Open data file. CALL GetNewUnit( UnIn, ErrStat2, ErrMsg2 ) @@ -7154,12 +7157,15 @@ SUBROUTINE ReadModeShapeFile(p_FAST, InputFile, ErrStat, ErrMsg, checkpointOnly) CALL ReadVar( UnIn, InputFile, p_FAST%VTK_modes%CheckpointRoot, 'CheckpointRoot', 'Name of the checkpoint file written by FAST when linearization data was produced', ErrStat2, ErrMsg2, UnEc ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF ( PathIsRelative( p_FAST%VTK_modes%CheckpointRoot ) ) p_FAST%VTK_modes%CheckpointRoot = TRIM(PriPath)//TRIM(p_FAST%VTK_modes%CheckpointRoot) + if (present(checkpointOnly)) then if (checkpointOnly) then call cleanup() return end if end if + CALL ReadVar( UnIn, InputFile, p_FAST%VTK_modes%MatlabFileName, 'MatlabFileName', 'Name of the file with eigenvectors written by Matlab', ErrStat2, ErrMsg2, UnEc ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -7167,6 +7173,7 @@ SUBROUTINE ReadModeShapeFile(p_FAST, InputFile, ErrStat, ErrMsg, checkpointOnly) CALL Cleanup() RETURN END IF + IF ( PathIsRelative( p_FAST%VTK_modes%MatlabFileName ) ) p_FAST%VTK_modes%MatlabFileName = TRIM(PriPath)//TRIM(p_FAST%VTK_modes%MatlabFileName) !----------- VISUALIZATION OPTIONS ------------------------------------------ From 9e6602e89c1b796cb245852ebd28b95025b7f787 Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Tue, 23 Jun 2020 11:42:18 -0600 Subject: [PATCH 62/72] Undo previous commit on setting wavedir (wrong location) --- modules/hydrodyn/src/HydroDyn.f90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/modules/hydrodyn/src/HydroDyn.f90 b/modules/hydrodyn/src/HydroDyn.f90 index f8567fe657..9f1b60fb8e 100644 --- a/modules/hydrodyn/src/HydroDyn.f90 +++ b/modules/hydrodyn/src/HydroDyn.f90 @@ -592,8 +592,6 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I DEALLOCATE( Waves_InitOut%WaveElev ) DEALLOCATE( Waves_InitOut%WaveTime ) DEALLOCATE( Waves_InitOut%NodeInWater ) - ELSE ! No waves - Waves_InitOut%WaveDir=InitInp%Waves%WaveDir ! Set direction: needed for SS excitation END IF !========================================================================== From 6a68cb71c5c504a6bb8d13b66d25777d83744a9b Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Tue, 23 Jun 2020 16:04:32 -0600 Subject: [PATCH 63/72] Minor docs formatting so sphinx doesn't complain --- docs/source/user/aerodyn/input.rst | 19 ++++++++++--------- docs/source/user/api_change.rst | 10 +++++----- 2 files changed, 15 insertions(+), 14 deletions(-) diff --git a/docs/source/user/aerodyn/input.rst b/docs/source/user/aerodyn/input.rst index 0cc938ee7c..cf8e653b23 100644 --- a/docs/source/user/aerodyn/input.rst +++ b/docs/source/user/aerodyn/input.rst @@ -10,10 +10,11 @@ file is required. This driver file specifies initialization inputs normally provided to AeroDyn by OpenFAST, as well as the per-time-step inputs to AeroDyn. -As an example, the ``driver.dvr`` file is the main driver, the ``input.dat`` is the primary input file, the ``blade.dat`` file contains the blade -geometry data, and the ``airfoil.dat`` file contains the airfoil -angle of attack, lift, drag, moment coefficients, and pressure -coefficients. Example input files are included in :numref:`ad_appendix`. +As an example, the ``driver.dvr`` file is the main driver, the ``input.dat`` is +the primary input file, the ``blade.dat`` file contains the blade geometry data, +and the ``airfoil.dat`` file contains the airfoil angle of attack, lift, drag, +moment coefficients, and pressure coefficients. Example input files are +included in :numref:`ad_appendix`. No lines should be added or removed from the input files, except in tables where the number of rows is specified and comment lines in the @@ -151,11 +152,11 @@ for ``DTAero`` may be used to indicate that AeroDyn should employ the time step prescribed by the driver code (OpenFAST or the standalone driver program). -Set ``WakeMod`` to 0 if you want to disable rotor wake/induction -effects or 1 to include these effects using the (quasi-steady) BEM theory model. When -``WakeMod`` is set to 2, a dynamic BEM theory model (DBEMT) is used (also referred to - as dynamic inflow or dynamic wake model). -``WakeMod`` cannot be set to 2 during linearization analyses. +Set ``WakeMod`` to 0 if you want to disable rotor wake/induction effects or 1 to +include these effects using the (quasi-steady) BEM theory model. When +``WakeMod`` is set to 2, a dynamic BEM theory model (DBEMT) is used (also +referred to as dynamic inflow or dynamic wake model). ``WakeMod`` cannot be set +to 2 during linearization analyses. Set ``AFAeroMod`` to 1 to include steady blade airfoil aerodynamics or 2 to enable UA; ``AFAeroMod`` must be 1 during linearization analyses diff --git a/docs/source/user/api_change.rst b/docs/source/user/api_change.rst index eed4ee491b..df28a1ac9b 100644 --- a/docs/source/user/api_change.rst +++ b/docs/source/user/api_change.rst @@ -9,10 +9,11 @@ The changes are tabulated according to the module input file, line number, and f The line number corresponds to the resulting line number after all changes are implemented. Thus, be sure to implement each in order so that subsequent line numbers are correct. -OpenFAST v2.3.0 to OpenFAST vTBD ----------------------------------- - ============== ==== ================== ============================================================================================================================================================================= -Added in OpenFAST vTBD +OpenFAST v2.3.0 to OpenFAST `dev` +--------------------------------- + +============== ==== ================== ============================================================================================================================================================================= +Added in OpenFAST `dev` -------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- Module Line Flag Name Example Value ============== ==== ================== ============================================================================================================================================================================= @@ -45,7 +46,6 @@ Module Line Flag Name Example Val AeroDyn Airfoil Input File - Airfoil Tables 2 UserProp 0 UserProp ! User property (control) setting AeroDyn 37 AFTabMod 1 AFTabMod - Interpolation method for multiple airfoil tables {1=1D interpolation on AoA (first table only); 2=2D interpolation on AoA and Re; 3=2D interpolation on AoA and UserProp} (-) ============================================= ==== =============== ======================================================================================================================================================================================================== ----------------------------------- OpenFAST v2.1.0 to OpenFAST v2.2.0 From d603d0eaafde489128586d710fa45436906d7c53 Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Tue, 23 Jun 2020 16:19:23 -0600 Subject: [PATCH 64/72] Update API changes doc for HAWC wind (PR #437) --- docs/source/user/api_change.rst | 1 + 1 file changed, 1 insertion(+) diff --git a/docs/source/user/api_change.rst b/docs/source/user/api_change.rst index df28a1ac9b..7f85e764a3 100644 --- a/docs/source/user/api_change.rst +++ b/docs/source/user/api_change.rst @@ -24,6 +24,7 @@ OpenFAST 46 TrimTol 0.0001 TrimTol - Tolerance for the r OpenFAST 47 TrimGain 0.001 TrimGain - Proportional gain for the rotational speed error (>0) [used only if CalcSteady=True] (rad/(rad/s) for yaw or pitch; Nm/(rad/s) for torque) OpenFAST 48 Twr_Kdmp 0 Twr_Kdmp - Damping factor for the tower [used only if CalcSteady=True] (N/(m/s)) OpenFAST 49 Bld_Kdmp 0 Bld_Kdmp - Damping factor for the blades [used only if CalcSteady=True] (N/(m/s)) +InflowWind 48 InitPosition(x) 0.0 InitPosition(x) - Initial offset in +x direction (shift of wind box) [Only used with WindType = 5] (m) ============== ==== ================== ============================================================================================================================================================================= OpenFAST v2.2.0 to OpenFAST v2.3.0 From 5e3e535054b7adfca657a84e1ae95501e341bbb7 Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Thu, 25 Jun 2020 11:14:23 -0600 Subject: [PATCH 65/72] Nodal outputs: minor error handling updates --- modules/aerodyn/src/AeroDyn_IO.f90 | 5 +++++ modules/elastodyn/src/ElastoDyn_AllBldNdOuts_IO.f90 | 1 + modules/elastodyn/src/ElastoDyn_IO.f90 | 5 +++++ 3 files changed, 11 insertions(+) diff --git a/modules/aerodyn/src/AeroDyn_IO.f90 b/modules/aerodyn/src/AeroDyn_IO.f90 index c86ca02bce..fdc9826f3d 100644 --- a/modules/aerodyn/src/AeroDyn_IO.f90 +++ b/modules/aerodyn/src/AeroDyn_IO.f90 @@ -2383,6 +2383,7 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, ADBlFile, OutFileRoot, UnE !----------- OUTLIST for BldNd ----------------------------------------------------------- CALL ReadCom( UnIn, InputFile, 'Section Header: OutList for Blade node channels', ErrStat2, ErrMsg2, UnEc ) IF ( ErrStat2 >= AbortErrLev ) THEN + InputFileData%BldNd_BladesOut = 0 InputFileData%BldNd_NumOuts = 0 call wrscr( trim(ErrMsg_NoAllBldNdOuts) ) CALL Cleanup() @@ -2395,6 +2396,7 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, ADBlFile, OutFileRoot, UnE ! Will likely require reading this line in as a string (BldNd_BladesOut_Str) and parsing it CALL ReadVar( UnIn, InputFile, InputFileData%BldNd_BladesOut, 'BldNd_BladesOut', 'Which blades to output node data on.'//TRIM(Num2Lstr(I)), ErrStat2, ErrMsg2, UnEc ) IF ( ErrStat2 >= AbortErrLev ) THEN + InputFileData%BldNd_BladesOut = 0 InputFileData%BldNd_NumOuts = 0 call wrscr( trim(ErrMsg_NoAllBldNdOuts) ) CALL Cleanup() @@ -2406,6 +2408,7 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, ADBlFile, OutFileRoot, UnE ! TODO: Parse this string into an array of nodes to output at (one idea is to set an array of boolean to T/F for which nodes to output). At present, we ignore it entirely. CALL ReadVar( UnIn, InputFile, InputFileData%BldNd_BlOutNd_Str, 'BldNd_BlOutNd_Str', 'Which nodes to output node data on.'//TRIM(Num2Lstr(I)), ErrStat2, ErrMsg2, UnEc ) IF ( ErrStat2 >= AbortErrLev ) THEN + InputFileData%BldNd_BladesOut = 0 InputFileData%BldNd_NumOuts = 0 call wrscr( trim(ErrMsg_NoAllBldNdOuts) ) CALL Cleanup() @@ -2416,6 +2419,7 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, ADBlFile, OutFileRoot, UnE ! Section header for outlist CALL ReadCom( UnIn, InputFile, 'Section Header: OutList', ErrStat2, ErrMsg2, UnEc ) IF ( ErrStat2 >= AbortErrLev ) THEN + InputFileData%BldNd_BladesOut = 0 InputFileData%BldNd_NumOuts = 0 call wrscr( trim(ErrMsg_NoAllBldNdOuts) ) CALL Cleanup() @@ -2426,6 +2430,7 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, ADBlFile, OutFileRoot, UnE ! OutList - List of user-requested output channels at each node(-): CALL ReadOutputList ( UnIn, InputFile, InputFileData%BldNd_OutList, InputFileData%BldNd_NumOuts, 'OutList', "List of user-requested output channels", ErrStat2, ErrMsg2, UnEc ) ! Routine in NWTC Subroutine Library IF ( ErrStat2 >= AbortErrLev ) THEN + InputFileData%BldNd_BladesOut = 0 InputFileData%BldNd_NumOuts = 0 call wrscr( trim(ErrMsg_NoAllBldNdOuts) ) CALL Cleanup() diff --git a/modules/elastodyn/src/ElastoDyn_AllBldNdOuts_IO.f90 b/modules/elastodyn/src/ElastoDyn_AllBldNdOuts_IO.f90 index a8c6608399..3c668bd57e 100644 --- a/modules/elastodyn/src/ElastoDyn_AllBldNdOuts_IO.f90 +++ b/modules/elastodyn/src/ElastoDyn_AllBldNdOuts_IO.f90 @@ -496,6 +496,7 @@ SUBROUTINE AllBldNdOuts_SetParameters( p, InputFileData, ErrStat, ErrMsg ) ! Set the parameter to store number of requested Blade Node output sets IF ( p%BD4Blades .and. InputFileData%BldNd_NumOuts > 0 ) THEN + p%BldNd_BladesOut = 0_IntKi p%BldNd_NumOuts = 0_IntKi CALL SetErrStat( ErrID_Warn,' AllBldNdOuts option not available in ElastoDyn when BeamDyn is used. Turning off these outputs.',ErrStat,ErrMsg,"SetPrimaryParameters" ) ELSE diff --git a/modules/elastodyn/src/ElastoDyn_IO.f90 b/modules/elastodyn/src/ElastoDyn_IO.f90 index 16eb7528a6..d097d0801b 100644 --- a/modules/elastodyn/src/ElastoDyn_IO.f90 +++ b/modules/elastodyn/src/ElastoDyn_IO.f90 @@ -4340,6 +4340,7 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, BldFile, FurlFile, TwrFile !----------- OUTLIST for BldNd ----------------------------------------------------------- CALL ReadCom( UnIn, InputFile, 'Section Header: OutList for Blade node channels', ErrStat2, ErrMsg2, UnEc ) IF ( ErrStat2 >= AbortErrLev ) THEN + InputFileData%BldNd_BladesOut = 0 InputFileData%BldNd_NumOuts = 0 call wrscr( trim(ErrMsg_NoAllBldNdOuts) ) CALL Cleanup() @@ -4352,6 +4353,7 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, BldFile, FurlFile, TwrFile ! Will likely require reading this line in as a string (BldNd_BladesOut_Str) and parsing it CALL ReadVar( UnIn, InputFile, InputFileData%BldNd_BladesOut, 'BldNd_BladesOut', 'Which blades to output node data on.'//TRIM(Num2Lstr(I)), ErrStat2, ErrMsg2, UnEc ) IF ( ErrStat2 >= AbortErrLev ) THEN + InputFileData%BldNd_BladesOut = 0 InputFileData%BldNd_NumOuts = 0 call wrscr( trim(ErrMsg_NoAllBldNdOuts) ) CALL Cleanup() @@ -4363,6 +4365,7 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, BldFile, FurlFile, TwrFile ! TODO: Parse this string into an array of nodes to output at (one idea is to set an array of boolean to T/F for which nodes to output). At present, we ignore it entirely. CALL ReadVar( UnIn, InputFile, InputFileData%BldNd_BlOutNd_Str, 'BldNd_BlOutNd_Str', 'Which nodes to output node data on.'//TRIM(Num2Lstr(I)), ErrStat2, ErrMsg2, UnEc ) IF ( ErrStat2 >= AbortErrLev ) THEN + InputFileData%BldNd_BladesOut = 0 InputFileData%BldNd_NumOuts = 0 call wrscr( trim(ErrMsg_NoAllBldNdOuts) ) CALL Cleanup() @@ -4373,6 +4376,7 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, BldFile, FurlFile, TwrFile ! Section header for outlist CALL ReadCom( UnIn, InputFile, 'Section Header: OutList', ErrStat2, ErrMsg2, UnEc ) IF ( ErrStat2 >= AbortErrLev ) THEN + InputFileData%BldNd_BladesOut = 0 InputFileData%BldNd_NumOuts = 0 call wrscr( trim(ErrMsg_NoAllBldNdOuts) ) CALL Cleanup() @@ -4383,6 +4387,7 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, BldFile, FurlFile, TwrFile ! OutList - List of user-requested output channels at each node(-): CALL ReadOutputList ( UnIn, InputFile, InputFileData%BldNd_OutList, InputFileData%BldNd_NumOuts, 'BldNd_OutList', "List of user-requested output channels", ErrStat2, ErrMsg2, UnEc ) ! Routine in NWTC Subroutine Library IF ( ErrStat2 >= AbortErrLev ) THEN + InputFileData%BldNd_BladesOut = 0 InputFileData%BldNd_NumOuts = 0 call wrscr( trim(ErrMsg_NoAllBldNdOuts) ) CALL Cleanup() From e2e116cfd2233f01f9b69ee8d47ad4a9e936f673 Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Thu, 25 Jun 2020 11:57:19 -0600 Subject: [PATCH 66/72] Nodal Outputs: documentation on ElastoDyn Nodal Outputs --- .../elastodyn/exampleInput/NodalOutpus.txt | 26 ++ docs/source/user/elastodyn/index.rst | 18 + docs/source/user/elastodyn/input.rst | 405 ++++++++++++++++++ docs/source/user/index.rst | 1 + 4 files changed, 450 insertions(+) create mode 100644 docs/source/user/elastodyn/exampleInput/NodalOutpus.txt create mode 100644 docs/source/user/elastodyn/index.rst create mode 100644 docs/source/user/elastodyn/input.rst diff --git a/docs/source/user/elastodyn/exampleInput/NodalOutpus.txt b/docs/source/user/elastodyn/exampleInput/NodalOutpus.txt new file mode 100644 index 0000000000..db15b8e793 --- /dev/null +++ b/docs/source/user/elastodyn/exampleInput/NodalOutpus.txt @@ -0,0 +1,26 @@ +END of input file (the word "END" must appear in the first 3 columns of this last OutList line) +---------------------- NODE OUTPUTS -------------------------------------------- + 3 BldNd_BladesOut - Blades to output + 99 BldNd_BlOutNd - Blade nodes on each blade (currently unused) + OutList - The next line(s) contains a list of output parameters. See OutListParameters.xlsx, ElastoDyn_Nodes tab for a listing of available output channels, (-) +"ALx" - local flapwise acceleration (absolute) of node +"ALy" - local flapwise acceleration (absolute) of node +"ALz" - local flapwise acceleration (absolute) of node +"TDx" - local flapwise (translational) deflection (relative to the undeflected position) of node +"TDy" - local edgewise (translational) deflection (relative to the undeflected position) of node +"TDz" - local axial (translational) deflection (relative to the undeflected position) of node +"RDx" - Local rotational displacement about x-axis (relative to undeflected) +"RDy" - Local rotational displacement about y-axis (relative to undeflected) +"RDz" - Local rotational displacement about z-axis (relative to undeflected) +"MLx" - local edgewise moment at node +"MLy" - local flapwise moment at node +"MLz" - local pitching moment at node +"FLx" - local flapwise shear force at node +"FLy" - local edgewise shear force at node +"FLz" - local axial force at node +"MLxNT" - Edgewise moment in local coordinate system (initial structural twist removed) +"MlyNT" - Flapwise shear moment in local coordinate system (initial structural twist removed) +"FLxNT" - Flapwise shear force in local coordinate system (initial structural twist removed) +"FlyNT" - Edgewise shear force in local coordinate system (initial structural twist removed) +END of input file (the word "END" must appear in the first 3 columns of this last OutList line) +--------------------------------------------------------------------------------------- diff --git a/docs/source/user/elastodyn/index.rst b/docs/source/user/elastodyn/index.rst new file mode 100644 index 0000000000..d3ef2bdb8c --- /dev/null +++ b/docs/source/user/elastodyn/index.rst @@ -0,0 +1,18 @@ +ElastoDyn Users Guide and Theory Manual +======================================= + +.. only:: html + + This document offers a quick reference guide for the ElastoDyn software + program. It is intended to be used by the general user in combination + with other OpenFAST manuals. The manual will be updated as new releases are + issued and as needed to provide further information on advancements or + modifications to the software. + + The documentation here is incomplete. + + +.. toctree:: + + input.rst + diff --git a/docs/source/user/elastodyn/input.rst b/docs/source/user/elastodyn/input.rst new file mode 100644 index 0000000000..2d1deea9b9 --- /dev/null +++ b/docs/source/user/elastodyn/input.rst @@ -0,0 +1,405 @@ +.. _ed_input: + +Input Files +=========== + +The user configures the structural model parameters via a primary ElastoDyn +input file, as well as separate input files for the tower and *other stuff that +will be documented here later.* + +No lines should be added or removed from the input files. + +Units +----- + +ElastoDyn uses the SI system (kg, m, s, N). Angles are assumed to be in +radians unless otherwise specified. + +ElastoDyn Primary Input File +---------------------------- + +The primary ElastoDyn input file defines modeling options and geometries for the +OpenFAST structure including the tower, nacelle, drivetrain, and blades (if +BeamDyn is not used). It also sets the initial conditions for the structure. + +Simulation Control +~~~~~~~~~~~~~~~~~~ + +Set the **Echo** flag to TRUE if you wish to have ElastoDyn echo the +contents of the ElastoDyn primary, airfoil, and blade input files (useful +for debugging errors in the input files). The echo file has the naming +convention of *OutRootFile.ED.ech*. **OutRootFile** is either +specified in the I/O SETTINGS section of the driver input file when +running ElastoDyn standalone, or by the OpenFAST program when running a +coupled simulation. + +**Method** + +**dT** + +Environmental Condition +~~~~~~~~~~~~~~~~~~~~~~~ + +**gravity** + +Degrees of Freedom +~~~~~~~~~~~~~~~~~~ + +**FlapDOF1** - First flapwise blade mode DOF (flag) + +**FlapDOF2** - Second flapwise blade mode DOF (flag) + +**EdgeDOF** - First edgewise blade mode DOF (flag) + +**TeetDOF** - Rotor-teeter DOF (flag) [unused for 3 blades] + +**DrTrDOF** - Drivetrain rotational-flexibility DOF (flag) + +**GenDOF** - Generator DOF (flag) + +**YawDOF** - Yaw DOF (flag) + +**TwFADOF1** - First fore-aft tower bending-mode DOF (flag) + +**TwFADOF2** - Second fore-aft tower bending-mode DOF (flag) + +**TwSSDOF1** - First side-to-side tower bending-mode DOF (flag) + +**TwSSDOF2** - Second side-to-side tower bending-mode DOF (flag) + +**PtfmSgDOF** - Platform horizontal surge translation DOF (flag) + +**PtfmSwDOF** - Platform horizontal sway translation DOF (flag) + +**PtfmHvDOF** - Platform vertical heave translation DOF (flag) + +**PtfmRDOF** - Platform roll tilt rotation DOF (flag) + +**PtfmPDOF** - Platform pitch tilt rotation DOF (flag) + +**PtfmYDOF** - Platform yaw rotation DOF (flag) + + + +Initial Conditions +~~~~~~~~~~~~~~~~~~ + +**OoPDefl** - Initial out-of-plane blade-tip displacement (meters) + +**IPDefl** - Initial in-plane blade-tip deflection (meters) + +**BlPitch(1)** - Blade 1 initial pitch (degrees) + +**BlPitch(2)** - Blade 2 initial pitch (degrees) + +**BlPitch(3)** - Blade 3 initial pitch (degrees) [unused for 2 blades] + +**TeetDefl** - Initial or fixed teeter angle (degrees) [unused for 3 blades] + +**Azimuth** - Initial azimuth angle for blade 1 (degrees) + +**RotSpeed** - Initial or fixed rotor speed (rpm) + +**NacYaw** - Initial or fixed nacelle-yaw angle (degrees) + +**TTDspFA** - Initial fore-aft tower-top displacement (meters) + +**TTDspSS** - Initial side-to-side tower-top displacement (meters) + +**PtfmSurge** - Initial or fixed horizontal surge translational displacement of platform (meters) + +**PtfmSway** - Initial or fixed horizontal sway translational displacement of platform (meters) + +**PtfmHeave** - Initial or fixed vertical heave translational displacement of platform (meters) + +**PtfmRoll** - Initial or fixed roll tilt rotational displacement of platform (degrees) + +**PtfmPitch** - Initial or fixed pitch tilt rotational displacement of platform (degrees) + +**PtfmYaw** - Initial or fixed yaw rotational displacement of platform (degrees) + +Turbine Configuration +~~~~~~~~~~~~~~~~~~~~~ + +**NumBl** - Number of blades (-) + +**TipRad** - The distance from the rotor apex to the blade tip (meters) + +**HubRad** - The distance from the rotor apex to the blade root (meters) + +**PreCone(1)** - Blade 1 cone angle (degrees) + +**PreCone(2)** - Blade 2 cone angle (degrees) + +**PreCone(3)** - Blade 3 cone angle (degrees) [unused for 2 blades] + +**HubCM** - Distance from rotor apex to hub mass [positive downwind] (meters) + +**UndSling** - Undersling length [distance from teeter pin to the rotor apex] (meters) [unused for 3 blades] + +**Delta3** - Delta-3 angle for teetering rotors (degrees) [unused for 3 blades] + +**AzimB1Up** - Azimuth value to use for I/O when blade 1 points up (degrees) + +**OverHang** - Distance from yaw axis to rotor apex [3 blades] or teeter pin [2 blades] (meters) + +**ShftGagL** - Distance from rotor apex [3 blades] or teeter pin [2 blades] to shaft strain gages [positive for upwind rotors] (meters) + +**ShftTilt** - Rotor shaft tilt angle (degrees) + +**NacCMxn** - Downwind distance from the tower-top to the nacelle CM (meters) + +**NacCMyn** - Lateral distance from the tower-top to the nacelle CM (meters) + +**NacCMzn** - Vertical distance from the tower-top to the nacelle CM (meters) + +**NcIMUxn** - Downwind distance from the tower-top to the nacelle IMU (meters) + +**NcIMUyn** - Lateral distance from the tower-top to the nacelle IMU (meters) + +**NcIMUzn** - Vertical distance from the tower-top to the nacelle IMU (meters) + +**Twr2Shft** - Vertical distance from the tower-top to the rotor shaft (meters) + +**TowerHt** - Height of tower above ground level [onshore] or MSL [offshore] (meters) + +**TowerBsHt** - Height of tower base above ground level [onshore] or MSL [offshore] (meters) + +**PtfmCMxt** - Downwind distance from the ground level [onshore] or MSL [offshore] to the platform CM (meters) + +**PtfmCMyt** - Lateral distance from the ground level [onshore] or MSL [offshore] to the platform CM (meters) + +**PtfmCMzt** - Vertical distance from the ground level [onshore] or MSL [offshore] to the platform CM (meters) + +**PtfmRefzt** - Vertical distance from the ground level [onshore] or MSL [offshore] to the platform reference point (meters) + + + +Mass and Inertia +~~~~~~~~~~~~~~~~ + +**TipMass(1)** - Tip-brake mass, blade 1 (kg) + +**TipMass(2)** - Tip-brake mass, blade 2 (kg) + +**TipMass(3)** - Tip-brake mass, blade 3 (kg) [unused for 2 blades] + +**HubMass** - Hub mass (kg) + +**HubIner** - Hub inertia about rotor axis [3 blades] or teeter axis [2 blades] (kg m^2) + +**GenIner** - Generator inertia about HSS (kg m^2) + +**NacMass** - Nacelle mass (kg) + +**NacYIner** - Nacelle inertia about yaw axis (kg m^2) + +**YawBrMass** - Yaw bearing mass (kg) + +**PtfmMass** - Platform mass (kg) + +**PtfmRIner** - Platform inertia for roll tilt rotation about the platform CM (kg m^2) + +**PtfmPIner** - Platform inertia for pitch tilt rotation about the platform CM (kg m^2) + +**PtfmYIner** - Platform inertia for yaw rotation about the platform CM (kg m^2) + + + +Blade +~~~~~ + +**BldNodes** - Number of blade nodes (per blade) used for analysis (-) + +**BldFile(1)** - Name of file containing properties for blade 1 (quoted string) + +**BldFile(2)** - Name of file containing properties for blade 2 (quoted string) + +**BldFile(3)** - Name of file containing properties for blade 3 (quoted string) [unused for 2 blades] + + +Rotor-Teeter +~~~~~~~~~~~~ + +**TeetMod** - Rotor-teeter spring/damper model {0: none, 1: standard, 2: user-defined from routine UserTeet} (switch) [unused for 3 blades] + +**TeetDmpP** - Rotor-teeter damper position (degrees) [used only for 2 blades and when TeetMod=1] + +**TeetDmp** - Rotor-teeter damping constant (N-m/(rad/s)) [used only for 2 blades and when TeetMod=1] + +**TeetCDmp** - Rotor-teeter rate-independent Coulomb-damping moment (N-m) [used only for 2 blades and when TeetMod=1] + +**TeetSStP** - Rotor-teeter soft-stop position (degrees) [used only for 2 blades and when TeetMod=1] + +**TeetHStP** - Rotor-teeter hard-stop position (degrees) [used only for 2 blades and when TeetMod=1] + +**TeetSSSp** - Rotor-teeter soft-stop linear-spring constant (N-m/rad) [used only for 2 blades and when TeetMod=1] + +**TeetHSSp** - Rotor-teeter hard-stop linear-spring constant (N-m/rad) [used only for 2 blades and when TeetMod=1] + + + +Drivetrain +~~~~~~~~~~ + +**GBoxEff** - Gearbox efficiency (%) + +**GBRatio** - Gearbox ratio (-) + +**DTTorSpr** - Drivetrain torsional spring (N-m/rad) + +**DTTorDmp** - Drivetrain torsional damper (N-m/(rad/s)) + + + +Furling +~~~~~~~ + +**Furling** - Read in additional model properties for furling turbine (flag) [must currently be FALSE) + +**FurlFile** - Name of file containing furling properties (quoted string) [unused when Furling=False] + + +Tower +~~~~~ + +**TwrNodes** - Number of tower nodes used for analysis (-) + +**TwrFile** - Name of file containing tower properties (quoted string) + + +.. _ED-Outputs: + +Outputs +~~~~~~~ + +**SumPrint** [flag] Set this value to TRUE if you want ElastoDyn to generate a +summary file with the name **OutFileRoot**.ED.sum*. **OutFileRoot** is specified +by the OpenFAST program when running a coupled simulation. + +**OutFile** [switch] is currently unused. The eventual purpose is to allow +output from ElastoDyn to be written to a module output file (option 1), or the +main OpenFAST output file (option 2), or both. At present this switch is +ignored. + +**TabDelim** [flag] is currently unused. Setting this to True will set the +delimeter for text files to the tab character for the ElastoDyn module +**OutFile**. + +**OutFmt** [quoted string] is currently unused. ElastoDyn will use this string +as the numerical format specifier for output of floating-point values in its +local output specified by **OutFile**. The length of this string must not exceed +20 characters and must be enclosed in apostrophes or double quotes. You may not +specify an empty string. To ensure that fixed-width column data align properly +with the column titles, you should ensure that the width of the field is 10 +characters. Using an E, EN, or ES specifier will guarantee that you will never +overflow the field because the number is too big, but such numbers are harder to +read. Using an F specifier will give you numbers that are easier to read, but +you may overflow the field. Please refer to any Fortran manual for details for +format specifiers. + +**TStart** [s] sets the start time for **OutFile**. This is currenlty unused. + +**DecFact** [-] This parameter sets the decimation factor for output. ElastoDyn +will output data to **OutFile** only once each DecFact integration time steps. +For instance, a value of 5 will cause FAST to generate output only every fifth +time step. This value must be an integer greater than zero. + +**NTwGages** [-] The number of strain-gage locations along the tower indicates +the number of input values on the next line. Valid values are integers from 0 to +5 (inclusive). + +**TwrGagNd** [-] The virtual strain-gage locations along the tower are assigned +to the tower analysis nodes specified on this line. Possible values are 1 to +TwrNodes (inclusive), where 1 corresponds to the node closest to the tower base +(but not at the base) and a value of TwrNodes corresponds to the node closest to +the tower top. The exact elevations of each analysis node in the undeflected +tower, relative to the base of the tower, are determined as follows: + + Elev. of node J = TwrRBHt + ( J – 1⁄2 ) • [ ( TowerHt + TwrDraft – TwrRBHt ) / TwrNodes ] + (for J = 1,2,...,TwrNodes) + +You must enter at least NTwGages values on this line. +If NTwGages is 0, this line will be skipped, but you must have a line taking up +space in the input file. You can separate the values with combinations of tabs, +spaces, and commas, but you may use only one comma between numbers. + +**NBlGages** [-] specifies the number of strain-gague locations along the blade, +and indicates the number of input values expected in **BldGagNd**. This is only +used when the blade structure is modeled in ElastoDyn. + +**BldGagNd** [-] specifies the virtual strain-gage locations along the blade +that should be output. Possible values are 1 to **BldNodes** (inclusive), where +1 corresponds to the node closest to the blade root (but not at the root) and a +value of BldNodes corresponds to the node closest to the blade tip. The node +locations are specified by the ElastoDyn blade input files. You must enter at +least NBlGages values on this line. If NBlGages is 0, this line will be skipped, +but you must have a line taking up space in the input file. You can separate the +values with combinations of tabs, spaces, and commas, but you may use only one +comma between numbers. This is only used when the blade structure is modeled in +ElastoDyn. + + +The **OutList** section controls output quantities generated by +ElastoDyn. Enter one or more lines containing quoted strings that in turn +contain one or more output parameter names. Separate output parameter +names by any combination of commas, semicolons, spaces, and/or tabs. If +you prefix a parameter name with a minus sign, “-”, underscore, “_”, or +the characters “m” or “M”, ElastoDyn will multiply the value for that +channel by –1 before writing the data. The parameters are written in the +order they are listed in the input file. ElastoDyn allows you to use +multiple lines so that you can break your list into meaningful groups +and so the lines can be shorter. You may enter comments after the +closing quote on any of the lines. Entering a line with the string “END” +at the beginning of the line or at the beginning of a quoted string +found at the beginning of the line will cause ElastoDyn to quit scanning +for more lines of channel names. Blade and tower node-related quantities +are generated for the requested nodes identified through the +**BldGagNd** and **TwrGagNd** lists above. If ElastoDyn encounters an +unknown/invalid channel name, it warns the users but will remove the +suspect channel from the output file. Please refer to the ElastoDyn tab in the +Excel file :download:`OutListParameters.xlsx <../../../OtherSupporting/OutListParameters.xlsx>` +for a complete list of possible output parameters. + +.. _ED-Nodal-Outputs: + +Nodal Outputs +~~~~~~~~~~~~~ + +In addition to the named outputs in :numref:`ED-Outputs` above, ElastoDyn allows +for outputting the full set blade node motions and loads (tower nodes +unavailable at present). Please refer to the ElastoDyn_Nodes tab in the +Excel file :download:`OutListParameters.xlsx <../../../OtherSupporting/OutListParameters.xlsx>` +for a complete list of possible output parameters. + +This section follows the `END` statement from normal Outputs section described +above, and includes a separator description line followed by the following +optinos. + +**BldNd_BladesOut** specifies the number of blades to output. Possible values +are 0 through the number of blades ElastoDyn is modeling. If the value is set to +1, only blade 1 will be output, and if the value is 2, blades 1 and 2 will be +output. + +**BldNd_BlOutNd** specifies which nodes to output. This is currently unused. + +The **OutList** section controls the nodal output quantities generated by +ElastoDyn. In this section, the user specifies the name of the channel family to +output. The output name for each channel is then created internally by ElastoDyn +by combining the blade number, node number, and channel family name. For +example, if the user specifies **TDx** as the channel family name, the output +channels will be named with the convention of **B**\ :math:`\mathbf{\beta}`\ +**N###TDx** where :math:`\mathbf{\beta}` is the blade number, and **###** is the +three digit node number. + + +Sample Nodal Outputs section +^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + +This sample includes the ``END`` statement from the regular outputs section. + +.. container:: + :name: File:EDNodalOutputs + + .. literalinclude:: exampleInput/NodalOutpus.txt + :linenos: diff --git a/docs/source/user/index.rst b/docs/source/user/index.rst index 125a16da8e..fe619b8749 100644 --- a/docs/source/user/index.rst +++ b/docs/source/user/index.rst @@ -15,6 +15,7 @@ Details on the transition from FAST v8 to OpenFAST may be found in :numref:`fast api_change.rst aerodyn/index.rst beamdyn/index.rst + elastodyn/index.rst fast_to_openfast.rst cppapi/index.rst From fd033060da503761484c41719b5ca4c1fda2fc87 Mon Sep 17 00:00:00 2001 From: Rafael M Mudafort Date: Thu, 25 Jun 2020 12:30:50 -0500 Subject: [PATCH 67/72] Reg test: Update the linearization output format --- reg_tests/executeOpenfastLinearRegressionCase.py | 8 ++++---- reg_tests/r-test | 2 +- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/reg_tests/executeOpenfastLinearRegressionCase.py b/reg_tests/executeOpenfastLinearRegressionCase.py index 60678f04ee..6bb34d8ba7 100644 --- a/reg_tests/executeOpenfastLinearRegressionCase.py +++ b/reg_tests/executeOpenfastLinearRegressionCase.py @@ -198,16 +198,16 @@ def isclose(a, b, rel_tol=1e-09, abs_tol=0.0): local_handle.readline() # the next 10 lines are simulation info; save what we need - for i in range(10): + for i in range(11): b_line = baseline_handle.readline() l_line = local_handle.readline() - if i == 4: + if i == 5: b_num_continuous_states = int(b_line.split()[-1]) l_num_continuous_states = int(l_line.split()[-1]) - elif i == 7: + elif i == 8: b_num_inputs = int(b_line.split()[-1]) l_num_inputs = int(l_line.split()[-1]) - elif i == 8: + elif i == 9: b_num_outputs = int(b_line.split()[-1]) l_num_outputs = int(l_line.split()[-1]) diff --git a/reg_tests/r-test b/reg_tests/r-test index 60b872355c..318137143a 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 60b872355c54cf42913fbeb40f0a17e92d02e18e +Subproject commit 318137143a870b417f55656f034558de18d8d33c From b89ae359e9560f177781e91b9c4a2e7d7d796671 Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Thu, 25 Jun 2020 13:01:48 -0600 Subject: [PATCH 68/72] Nodal Outputs: finalize documentation for nodal outputs Also minor change on wording in AD error message --- docs/source/user/aerodyn/ADNodalOutputs.rst | 42 ++++++ .../user/aerodyn/examples/NodalOutputs.txt | 48 ++++++ .../aerodyn/examples/ad_primary_example.inp | 47 ++++++ docs/source/user/aerodyn/input.rst | 5 + docs/source/user/api_change.rst | 3 + docs/source/user/beamdyn/BDNodalOutputs.rst | 40 +++++ .../user/beamdyn/examples/NodalOutputs.txt | 138 +++++++++++++++++ .../beamdyn/examples/bd_primary_nrel_5mw.inp | 141 +++++++++++++++++- docs/source/user/beamdyn/input_files.rst | 5 + docs/source/user/elastodyn/EDNodalOutputs.rst | 42 ++++++ docs/source/user/elastodyn/input.rst | 43 +----- modules/aerodyn/src/AeroDyn_IO.f90 | 2 +- 12 files changed, 512 insertions(+), 44 deletions(-) create mode 100644 docs/source/user/aerodyn/ADNodalOutputs.rst create mode 100644 docs/source/user/aerodyn/examples/NodalOutputs.txt create mode 100644 docs/source/user/beamdyn/BDNodalOutputs.rst create mode 100644 docs/source/user/beamdyn/examples/NodalOutputs.txt create mode 100644 docs/source/user/elastodyn/EDNodalOutputs.rst diff --git a/docs/source/user/aerodyn/ADNodalOutputs.rst b/docs/source/user/aerodyn/ADNodalOutputs.rst new file mode 100644 index 0000000000..a820b42c25 --- /dev/null +++ b/docs/source/user/aerodyn/ADNodalOutputs.rst @@ -0,0 +1,42 @@ +.. _AD-Nodal-Outputs: + +Nodal Outputs +~~~~~~~~~~~~~ + +In addition to the named outputs in :numref:`AD-Outputs` above, AeroDyn allows +for outputting the full set blade node motions and loads (tower nodes +unavailable at present). Please refer to the AeroDyn_Nodes tab in the +Excel file :download:`OutListParameters.xlsx <../../../OtherSupporting/OutListParameters.xlsx>` +for a complete list of possible output parameters. + +This section follows the `END` statement from normal Outputs section described +above, and includes a separator description line followed by the following +optinos. + +**BldNd_BladesOut** specifies the number of blades to output. Possible values +are 0 through the number of blades AeroDyn is modeling. If the value is set to +1, only blade 1 will be output, and if the value is 2, blades 1 and 2 will be +output. + +**BldNd_BlOutNd** specifies which nodes to output. This is currently unused. + +The **OutList** section controls the nodal output quantities generated by +AeroDyn. In this section, the user specifies the name of the channel family to +output. The output name for each channel is then created internally by AeroDyn +by combining the blade number, node number, and channel family name. For +example, if the user specifies **AxInd** as the channel family name, the output +channels will be named with the convention of **B**\ :math:`\mathbf{\beta}`\ +**N###AxInd** where :math:`\mathbf{\beta}` is the blade number, and **###** is +the three digit node number. + + +Sample Nodal Outputs section +^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + +This sample includes the ``END`` statement from the regular outputs section. + +.. container:: + :name: File:ADNodalOutputs + + .. literalinclude:: examples/NodalOutputs.txt + :linenos: diff --git a/docs/source/user/aerodyn/examples/NodalOutputs.txt b/docs/source/user/aerodyn/examples/NodalOutputs.txt new file mode 100644 index 0000000000..851ed267ae --- /dev/null +++ b/docs/source/user/aerodyn/examples/NodalOutputs.txt @@ -0,0 +1,48 @@ +END of input file (the word "END" must appear in the first 3 columns of this last OutList line) +---------------------- NODE OUTPUTS -------------------------------------------- + 3 BldNd_BladesOut - Blades to output + 99 BldNd_BlOutNd - Blade nodes on each blade (currently unused) + OutList - The next line(s) contains a list of output parameters. See OutListParameters.xlsx, ElastoDyn_Nodes tab for a listing of available output channels, (-) +"VUndx" - x-component of undisturbed wind velocity at each node +"VUndy" - y-component of undisturbed wind velocity at each node +"VUndz" - z-component of undisturbed wind velocity at each node +"VDisx" - x-component of disturbed wind velocity at each node +"VDisy" - y-component of disturbed wind velocity at each node +"VDisz" - z-component of disturbed wind velocity at each node +"STVx" - x-component of structural translational velocity at each node +"STVy" - y-component of structural translational velocity at each node +"STVz" - z-component of structural translational velocity at each node +"VRel" - Relvative wind speed at each node +"DynP" - Dynamic pressure at each node +"Re" - Reynolds number (in millions) at each node +"M" - Mach number at each node +"Vindx" - Axial induced wind velocity at each node +"Vindy" - Tangential induced wind velocity at each node +"AxInd" - Axial induction factor at each node +"TnInd" - Tangential induction factor at each node +"Alpha" - Angle of attack at each node +"Theta" - Pitch+Twist angle at each node +"Phi" - Inflow angle at each node +"Curve" - Curvature angle at each node +"Cl" - Lift force coefficient at each node +"Cd" - Drag force coefficient at each node +"Cm" - Pitching moment coefficient at each node +"Cx" - Normal force (to plane) coefficient at each node +"Cy" - Tangential force (to plane) coefficient at each node +"Cn" - Normal force (to chord) coefficient at each node +"Ct" - Tangential force (to chord) coefficient at each node +"Fl" - Lift force per unit length at each node +"Fd" - Drag force per unit length at each node +"Mm" - Pitching moment per unit length at each node +"Fx" - Normal force (to plane) per unit length at each node +"Fy" - Tangential force (to plane) per unit length at each node +"Fn" - Normal force (to chord) per unit length at each node +"Ft" - Tangential force (to chord) per unit length at each node +"Clrnc" - Tower clearance at each node (based on the absolute distance to the nearest point in the tower from blade node B#N# minus the local tower radius, in the deflected configuration); please note that this clearance is only approximate because the calculation assumes that the blade is a line with no volume (however, the calculation does use the local tower radius); when blade node B#N# is above the tower top (or below the tower base), the absolute distance to the tower top (or base) minus the local tower radius, in the deflected configuration, is output +"Vx" - Local axial velocity +"Vy" - Local tangential velocity +"GeomPhi" - Geometric phi? If phi was solved using normal BEMT equations, GeomPhi = 1; otherwise, if it was solved geometrically, GeomPhi = 0. +"Chi" - Skew angle (used in skewed wake correction) +"UA_Flag" - Flag indicating if UA is turned on for this node. +END of input file (the word "END" must appear in the first 3 columns of this last OutList line) +--------------------------------------------------------------------------------------- diff --git a/docs/source/user/aerodyn/examples/ad_primary_example.inp b/docs/source/user/aerodyn/examples/ad_primary_example.inp index d3ca180f54..9c1a632987 100644 --- a/docs/source/user/aerodyn/examples/ad_primary_example.inp +++ b/docs/source/user/aerodyn/examples/ad_primary_example.inp @@ -98,3 +98,50 @@ Vindx Vindy Alpha END (the word "END" must appear in the first 3 columns of this last OutList line in the optional nodal output section) +---------------------- NODE OUTPUTS -------------------------------------------- + 3 BldNd_BladesOut - Blades to output + 99 BldNd_BlOutNd - Blade nodes on each blade (currently unused) + OutList - The next line(s) contains a list of output parameters. See OutListParameters.xlsx, ElastoDyn_Nodes tab for a listing of available output channels, (-) +"VUndx" +"VUndy" +"VUndz" +"VDisx" +"VDisy" +"VDisz" +"STVx" +"STVy" +"STVz" +"VRel" +"DynP" +"Re" +"M" +"Vindx" +"Vindy" +"AxInd" +"TnInd" +"Alpha" +"Theta" +"Phi" +"Curve" +"Cl" +"Cd" +"Cm" +"Cx" +"Cy" +"Cn" +"Ct" +"Fl" +"Fd" +"Mm" +"Fx" +"Fy" +"Fn" +"Ft" +"Clrnc" +"Vx" +"Vy" +"GeomPhi" +"Chi" +"UA_Flag" +END of input file (the word "END" must appear in the first 3 columns of this last OutList line) +--------------------------------------------------------------------------------------- diff --git a/docs/source/user/aerodyn/input.rst b/docs/source/user/aerodyn/input.rst index cf8e653b23..11d193cd98 100644 --- a/docs/source/user/aerodyn/input.rst +++ b/docs/source/user/aerodyn/input.rst @@ -362,6 +362,8 @@ specifies the local tower drag-force coefficient. ``TwrElev`` must be entered in monotonically increasing order—from the lowest (tower-base) to the highest (tower-top) elevation. See Figure 2. +.. _AD-Outputs: + Outputs ~~~~~~~ @@ -416,6 +418,9 @@ unknown/invalid channel name, it warns the users but will remove the suspect channel from the output file. Please refer to Appendix E for a complete list of possible output parameters. +.. include:: ADNodalOutputs.rst + + .. _airfoil_data_input_file: Airfoil Data Input File diff --git a/docs/source/user/api_change.rst b/docs/source/user/api_change.rst index 7f85e764a3..8babd2852b 100644 --- a/docs/source/user/api_change.rst +++ b/docs/source/user/api_change.rst @@ -27,6 +27,9 @@ OpenFAST 49 Bld_Kdmp 0 Bld_Kdmp - Damping factor for InflowWind 48 InitPosition(x) 0.0 InitPosition(x) - Initial offset in +x direction (shift of wind box) [Only used with WindType = 5] (m) ============== ==== ================== ============================================================================================================================================================================= +Additional nodal output channels added for :ref:`AeroDyn15`, +:ref:`BeamDyn`, and :ref:`ElastoDyn`. + OpenFAST v2.2.0 to OpenFAST v2.3.0 ---------------------------------- diff --git a/docs/source/user/beamdyn/BDNodalOutputs.rst b/docs/source/user/beamdyn/BDNodalOutputs.rst new file mode 100644 index 0000000000..249bd8d2a1 --- /dev/null +++ b/docs/source/user/beamdyn/BDNodalOutputs.rst @@ -0,0 +1,40 @@ +.. _BD-Nodal-Outputs: + +Nodal Outputs +~~~~~~~~~~~~~ + +In addition to the named outputs in :numref:`BD-Outputs` above, BeamDyn allows +for outputting the full set blade node motions and loads (tower nodes +unavailable at present). Please refer to the BeamDyn_Nodes tab in the +Excel file :download:`OutListParameters.xlsx <../../../OtherSupporting/OutListParameters.xlsx>` +for a complete list of possible output parameters. + +This section follows the `END` statement from normal Outputs section described +above, and includes a separator description line followed by the following +optinos. + +**BldNd_BlOutNd** specifies which nodes to output. This is currently unused. + +The **OutList** section controls the nodal output quantities generated by +BeamDyn. In this section, the user specifies the name of the channel family to +output. The output name for each channel is then created internally by BeamDyn +by combining the blade number, node number, and channel family name. For +example, if the user specifies **TDxr** as the channel family name, the output +channels will be named with the convention of **B**\ :math:`\mathbf{\beta}`\ +**N###TDxr** where :math:`\mathbf{\beta}` is the blade number, and **###** is the +three digit node number. + + + +Sample Nodal Outputs section +^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + +This sample includes the ``END`` statement from the regular outputs section. + +.. container:: + :name: File:BDNodalOutputs + + .. literalinclude:: examples/NodalOutputs.txt + :linenos: + + diff --git a/docs/source/user/beamdyn/examples/NodalOutputs.txt b/docs/source/user/beamdyn/examples/NodalOutputs.txt new file mode 100644 index 0000000000..536673ffca --- /dev/null +++ b/docs/source/user/beamdyn/examples/NodalOutputs.txt @@ -0,0 +1,138 @@ +END of input file (the word "END" must appear in the first 3 columns of this last OutList line) +---------------------- NODE OUTPUTS -------------------------------------------- + 99 BldNd_BlOutNd - Blade nodes on each blade (currently unused) + OutList - The next line(s) contains a list of output parameters. See OutListParameters.xlsx, ElastoDyn_Nodes tab for a listing of available output channels, (-) +"FxL" - Sectional force resultants at each node expressed in l l: a floating coordinate system local to the deflected beam (N) +"FyL" - Sectional force resultants at each node expressed in l l: a floating coordinate system local to the deflected beam (N) +"FzL" - Sectional force resultants at each node expressed in l l: a floating coordinate system local to the deflected beam (N) +"MxL" - Sectional moment resultants at each node expressed in l l: a floating coordinate system local to the deflected beam (N-m) +"MyL" - Sectional moment resultants at each node expressed in l l: a floating coordinate system local to the deflected beam (N-m) +"MzL" - Sectional moment resultants at each node expressed in l l: a floating coordinate system local to the deflected beam (N-m) +"Fxr" - Sectional force resultants at each node expressed in r r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N) +"Fyr" - Sectional force resultants at each node expressed in r r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N) +"Fzr" - Sectional force resultants at each node expressed in r r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N) +"Mxr" - Sectional moment resultants at each node expressed in r r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N-m) +"Myr" - Sectional moment resultants at each node expressed in r r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N-m) +"Mzr" - Sectional moment resultants at each node expressed in r r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N-m) +"TDxr" - Sectional translational deflection (relative to the undeflected position) at each node expressed in r r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (m) +"TDyr" - Sectional translational deflection (relative to the undeflected position) at each node expressed in r r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (m) +"TDzr" - Sectional translational deflection (relative to the undeflected position) at each node expressed in r r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (m) +"RDxr" - Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) at each node expressed in r r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (-) +"RDyr" - Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) at each node expressed in r r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (-) +"RDzr" - Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) at each node expressed in r r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (-) +"AbsXg" - Node position in X (global coordinate) g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST’s global inertial frame (i) coordinate system (m) +"AbsYg" - Node position in Y (global coordinate) g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST’s global inertial frame (i) coordinate system (m) +"AbsZg" - Node position in Z (global coordinate) g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST’s global inertial frame (i) coordinate system (m) +"AbsXr" - Node position in X (relative to root) r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (m) +"AbsYr" - Node position in Y (relative to root) r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (m) +"AbsZr" - Node position in Z (relative to root) r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (m) +"TVxg" - Sectional translational velocities (absolute) g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST’s global inertial frame (i) coordinate system (m/s) +"TVyg" - Sectional translational velocities (absolute) g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST’s global inertial frame (i) coordinate system (m/s) +"TVzg" - Sectional translational velocities (absolute) g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST’s global inertial frame (i) coordinate system (m/s) +"TVxl" - Sectional translational velocities (absolute) l: a floating coordinate system local to the deflected beam (m/s) +"TVyl" - Sectional translational velocities (absolute) l: a floating coordinate system local to the deflected beam (m/s) +"TVzl" - Sectional translational velocities (absolute) l: a floating coordinate system local to the deflected beam (m/s) +"TVxr" - Sectional translational velocities (absolute) r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (m/s) +"TVyr" - Sectional translational velocities (absolute) r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (m/s) +"TVzr" - Sectional translational velocities (absolute) r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (m/s) +"RVxg" - Sectional angular/rotational velocities (absolute) g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST’s global inertial frame (i) coordinate system (deg/s) +"RVyg" - Sectional angular/rotational velocities (absolute) g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST’s global inertial frame (i) coordinate system (deg/s) +"RVzg" - Sectional angular/rotational velocities (absolute) g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST’s global inertial frame (i) coordinate system (deg/s) +"RVxl" - Sectional angular/rotational velocities (absolute) l: a floating coordinate system local to the deflected beam (deg/s) +"RVyl" - Sectional angular/rotational velocities (absolute) l: a floating coordinate system local to the deflected beam (deg/s) +"RVzl" - Sectional angular/rotational velocities (absolute) l: a floating coordinate system local to the deflected beam (deg/s) +"RVxr" - Sectional angular/rotational velocities (absolute) r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (deg/s) +"RVyr" - Sectional angular/rotational velocities (absolute) r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (deg/s) +"RVzr" - Sectional angular/rotational velocities (absolute) r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (deg/s) +"TAxl" - Sectional angular/rotational velocities (absolute) l: a floating coordinate system local to the deflected beam (m/s^2) +"TAyl" - Sectional angular/rotational velocities (absolute) l: a floating coordinate system local to the deflected beam (m/s^2) +"TAzl" - Sectional angular/rotational velocities (absolute) l: a floating coordinate system local to the deflected beam (m/s^2) +"TAxr" - Sectional angular/rotational velocities (absolute) r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (m/s^2) +"TAyr" - Sectional angular/rotational velocities (absolute) r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (m/s^2) +"TAzr" - Sectional angular/rotational velocities (absolute) r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (m/s^2) +"RAxl" - Sectional angular/rotational velocities (absolute) l: a floating coordinate system local to the deflected beam (deg/s^2) +"RAyl" - Sectional angular/rotational velocities (absolute) l: a floating coordinate system local to the deflected beam (deg/s^2) +"RAzl" - Sectional angular/rotational velocities (absolute) l: a floating coordinate system local to the deflected beam (deg/s^2) +"RAxr" - Sectional angular/rotational velocities (absolute) r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (deg/s^2) +"RAyr" - Sectional angular/rotational velocities (absolute) r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (deg/s^2) +"RAzr" - Sectional angular/rotational velocities (absolute) r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (deg/s^2) +"PFxL" - Applied point forces at each node expressed in l l: a floating coordinate system local to the deflected beam (N) +"PFyL" - Applied point forces at each node expressed in l l: a floating coordinate system local to the deflected beam (N) +"PFzL" - Applied point forces at each node expressed in l l: a floating coordinate system local to the deflected beam (N) +"PMxL" - Applied point moments at each node expressed in l l: a floating coordinate system local to the deflected beam (N-m) +"PMyL" - Applied point moments at each node expressed in l l: a floating coordinate system local to the deflected beam (N-m) +"PMzL" - Applied point moments at each node expressed in l l: a floating coordinate system local to the deflected beam (N-m) +"DFxL" - Applied distributed forces at each node expressed in l l: a floating coordinate system local to the deflected beam (N/m) +"DFyL" - Applied distributed forces at each node expressed in l l: a floating coordinate system local to the deflected beam (N/m) +"DFzL" - Applied distributed forces at each node expressed in l l: a floating coordinate system local to the deflected beam (N/m) +"DMxL" - Applied distributed moments at each node expressed in l l: a floating coordinate system local to the deflected beam (N-m/m) +"DMyL" - Applied distributed moments at each node expressed in l l: a floating coordinate system local to the deflected beam (N-m/m) +"DMzL" - Applied distributed moments at each node expressed in l l: a floating coordinate system local to the deflected beam (N-m/m) +"DFxR" - Applied distributed forces at each node expressed in r r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N/m) +"DFyR" - Applied distributed forces at each node expressed in r r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N/m) +"DFzR" - Applied distributed forces at each node expressed in r r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N/m) +"DMxR" - Applied distributed forces at each node expressed in r r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N-m/m) +"DMyR" - Applied distributed forces at each node expressed in r r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N-m/m) +"DMzR" - Applied distributed forces at each node expressed in r r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N-m/m) +"FFbxl" - Gyroscopic force x l: a floating coordinate system local to the deflected beam (N) +"FFbyl" - Gyroscopic force y l: a floating coordinate system local to the deflected beam (N) +"FFbzl" - Gyroscopic force z l: a floating coordinate system local to the deflected beam (N) +"FFbxr" - Gyroscopic force x r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N) +"FFbyr" - Gyroscopic force y r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N) +"FFbzr" - Gyroscopic force z r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N) +"MFbxl" - Gyroscopic moment about x l: a floating coordinate system local to the deflected beam (N-m) +"MFbyl" - Gyroscopic moment about y l: a floating coordinate system local to the deflected beam (N-m) +"MFbzl" - Gyroscopic moment about z l: a floating coordinate system local to the deflected beam (N-m) +"MFbxr" - Gyroscopic moment about x r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N-m) +"MFbyr" - Gyroscopic moment about y r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N-m) +"MFbzr" - Gyroscopic moment about z r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N-m) +"FFcxl" - Elastic restoring force Fc x l: a floating coordinate system local to the deflected beam (N) +"FFcyl" - Elastic restoring force Fc y l: a floating coordinate system local to the deflected beam (N) +"FFczl" - Elastic restoring force Fc z l: a floating coordinate system local to the deflected beam (N) +"FFcxr" - Elastic restoring force Fc x r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N) +"FFcyr" - Elastic restoring force Fc y r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N) +"FFczr" - Elastic restoring force Fc z r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N) +"MFcxl" - Elastic restoring moment Fc about x l: a floating coordinate system local to the deflected beam (N-m) +"MFcyl" - Elastic restoring moment Fc about y l: a floating coordinate system local to the deflected beam (N-m) +"MFczl" - Elastic restoring moment Fc about z l: a floating coordinate system local to the deflected beam (N-m) +"MFcxr" - Elastic restoring moment Fc about x r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N-m) +"MFcyr" - Elastic restoring moment Fc about y r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N-m) +"MFczr" - Elastic restoring moment Fc about z r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N-m) +"FFdxl" - Elastic restoring force Fd x l: a floating coordinate system local to the deflected beam (N) +"FFdyl" - Elastic restoring force Fd y l: a floating coordinate system local to the deflected beam (N) +"FFdzl" - Elastic restoring force Fd z l: a floating coordinate system local to the deflected beam (N) +"FFdxr" - Elastic restoring force Fd x r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N) +"FFdyr" - Elastic restoring force Fd y r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N) +"FFdzr" - Elastic restoring force Fd z r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N) +"MFdxl" - Elastic restoring moment Fd about x l: a floating coordinate system local to the deflected beam (N-m) +"MFdyl" - Elastic restoring moment Fd about y l: a floating coordinate system local to the deflected beam (N-m) +"MFdzl" - Elastic restoring moment Fd about z l: a floating coordinate system local to the deflected beam (N-m) +"MFdxr" - Elastic restoring moment Fd about x r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N-m) +"MFdyr" - Elastic restoring moment Fd about y r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N-m) +"MFdzr" - Elastic restoring moment Fd about z r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N-m) +"FFgxl" - Gravity force x l: a floating coordinate system local to the deflected beam (N) +"FFgyl" - Gravity force y l: a floating coordinate system local to the deflected beam (N) +"FFgzl" - Gravity force z l: a floating coordinate system local to the deflected beam (N) +"FFgxr" - Gravity force x r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N) +"FFgyr" - Gravity force y r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N) +"FFgzr" - Gravity force z r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N) +"MFgxl" - Gravity moment about x l: a floating coordinate system local to the deflected beam (N-m) +"MFgyl" - Gravity moment about y l: a floating coordinate system local to the deflected beam (N-m) +"MFgzl" - Gravity moment about z l: a floating coordinate system local to the deflected beam (N-m) +"MFgxr" - Gravity moment about x r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N-m) +"MFgyr" - Gravity moment about y r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N-m) +"MFgzr" - Gravity moment about z r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N-m) +"FFixl" - Inertial force x l: a floating coordinate system local to the deflected beam (N) +"FFiyl" - Inertial force y l: a floating coordinate system local to the deflected beam (N) +"FFizl" - Inertial force z l: a floating coordinate system local to the deflected beam (N) +"FFixr" - Inertial force x r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N) +"FFiyr" - Inertial force y r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N) +"FFizr" - Inertial force z r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N) +"MFixl" - Inertial moment about x l: a floating coordinate system local to the deflected beam (N-m) +"MFiyl" - Inertial moment about y l: a floating coordinate system local to the deflected beam (N-m) +"MFizl" - Inertial moment about z l: a floating coordinate system local to the deflected beam (N-m) +"MFixr" - Inertial moment about x r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N-m) +"MFiyr" - Inertial moment about y r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N-m) +"MFizr" - Inertial moment about z r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N-m) +END of input file (the word "END" must appear in the first 3 columns of this last OutList line) +--------------------------------------------------------------------------------------- diff --git a/docs/source/user/beamdyn/examples/bd_primary_nrel_5mw.inp b/docs/source/user/beamdyn/examples/bd_primary_nrel_5mw.inp index 340eac2bb6..04184566cf 100644 --- a/docs/source/user/beamdyn/examples/bd_primary_nrel_5mw.inp +++ b/docs/source/user/beamdyn/examples/bd_primary_nrel_5mw.inp @@ -103,4 +103,143 @@ END of input file (the word "END" must appear in the first 3 columns of the last "RVxr, RVyr, RVzr" "RAxr, RAyr, RAzr" "Fxr, Fyr, Fzr" -END (the word "END" must appear in the first 3 columns of this last OutList line in the optional nodal output section) +"TipTDxr, TipTDyr, TipTDzr" +"TipRDxr, TipRDyr, TipRDzr" +END of input file (the word "END" must appear in the first 3 columns of this last OutList line) +---------------------- NODE OUTPUTS -------------------------------------------- + 99 BldNd_BlOutNd - Blade nodes on each blade (currently unused) + OutList - The next line(s) contains a list of output parameters. See OutListParameters.xlsx, ElastoDyn_Nodes tab for a listing of available output channels, (-) +"FxL" +"FyL" +"FzL" +"MxL" +"MyL" +"MzL" +"Fxr" +"Fyr" +"Fzr" +"Mxr" +"Myr" +"Mzr" +"TDxr" +"TDyr" +"TDzr" +"RDxr" +"RDyr" +"RDzr" +"AbsXg" +"AbsYg" +"AbsZg" +"AbsXr" +"AbsYr" +"AbsZr" +"TVxg" +"TVyg" +"TVzg" +"TVxl" +"TVyl" +"TVzl" +"TVxr" +"TVyr" +"TVzr" +"RVxg" +"RVyg" +"RVzg" +"RVxl" +"RVyl" +"RVzl" +"RVxr" +"RVyr" +"RVzr" +"TAxl" +"TAyl" +"TAzl" +"TAxr" +"TAyr" +"TAzr" +"RAxl" +"RAyl" +"RAzl" +"RAxr" +"RAyr" +"RAzr" +"PFxL" +"PFyL" +"PFzL" +"PMxL" +"PMyL" +"PMzL" +"DFxL" +"DFyL" +"DFzL" +"DMxL" +"DMyL" +"DMzL" +"DFxR" +"DFyR" +"DFzR" +"DMxR" +"DMyR" +"DMzR" +"FFbxl" +"FFbyl" +"FFbzl" +"FFbxr" +"FFbyr" +"FFbzr" +"MFbxl" +"MFbyl" +"MFbzl" +"MFbxr" +"MFbyr" +"MFbzr" +"FFcxl" +"FFcyl" +"FFczl" +"FFcxr" +"FFcyr" +"FFczr" +"MFcxl" +"MFcyl" +"MFczl" +"MFcxr" +"MFcyr" +"MFczr" +"FFdxl" +"FFdyl" +"FFdzl" +"FFdxr" +"FFdyr" +"FFdzr" +"MFdxl" +"MFdyl" +"MFdzl" +"MFdxr" +"MFdyr" +"MFdzr" +"FFgxl" +"FFgyl" +"FFgzl" +"FFgxr" +"FFgyr" +"FFgzr" +"MFgxl" +"MFgyl" +"MFgzl" +"MFgxr" +"MFgyr" +"MFgzr" +"FFixl" +"FFiyl" +"FFizl" +"FFixr" +"FFiyr" +"FFizr" +"MFixl" +"MFiyl" +"MFizl" +"MFixr" +"MFiyr" +"MFizr" +END of input file (the word "END" must appear in the first 3 columns of this last OutList line) +--------------------------------------------------------------------------------------- diff --git a/docs/source/user/beamdyn/input_files.rst b/docs/source/user/beamdyn/input_files.rst index d7bdc2fbdb..7e01003b18 100644 --- a/docs/source/user/beamdyn/input_files.rst +++ b/docs/source/user/beamdyn/input_files.rst @@ -415,6 +415,8 @@ actuator, whereby the pitch angular orientation, velocity, and acceleration are determined by the actuator based on the input blade-pitch angle prescribed by the driver code. +.. _BD-Outputs: + Outputs ~~~~~~~ @@ -461,6 +463,9 @@ remove the suspect channel from the output file. Please refer to Appendix :numref:`app-output-channel` for a complete list of possible output parameters and their names. + +.. include:: BDNodalOutputs.rst + Blade Input File ---------------- diff --git a/docs/source/user/elastodyn/EDNodalOutputs.rst b/docs/source/user/elastodyn/EDNodalOutputs.rst new file mode 100644 index 0000000000..12eb71f513 --- /dev/null +++ b/docs/source/user/elastodyn/EDNodalOutputs.rst @@ -0,0 +1,42 @@ +.. _ED-Nodal-Outputs: + +Nodal Outputs +~~~~~~~~~~~~~ + +In addition to the named outputs in :numref:`ED-Outputs` above, ElastoDyn allows +for outputting the full set blade node motions and loads (tower nodes +unavailable at present). Please refer to the ElastoDyn_Nodes tab in the +Excel file :download:`OutListParameters.xlsx <../../../OtherSupporting/OutListParameters.xlsx>` +for a complete list of possible output parameters. + +This section follows the `END` statement from normal Outputs section described +above, and includes a separator description line followed by the following +optinos. + +**BldNd_BladesOut** specifies the number of blades to output. Possible values +are 0 through the number of blades ElastoDyn is modeling. If the value is set to +1, only blade 1 will be output, and if the value is 2, blades 1 and 2 will be +output. + +**BldNd_BlOutNd** specifies which nodes to output. This is currently unused. + +The **OutList** section controls the nodal output quantities generated by +ElastoDyn. In this section, the user specifies the name of the channel family to +output. The output name for each channel is then created internally by ElastoDyn +by combining the blade number, node number, and channel family name. For +example, if the user specifies **TDx** as the channel family name, the output +channels will be named with the convention of **B**\ :math:`\mathbf{\beta}`\ +**N###TDx** where :math:`\mathbf{\beta}` is the blade number, and **###** is the +three digit node number. + + +Sample Nodal Outputs section +^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + +This sample includes the ``END`` statement from the regular outputs section. + +.. container:: + :name: File:EDNodalOutputs + + .. literalinclude:: exampleInput/NodalOutpus.txt + :linenos: diff --git a/docs/source/user/elastodyn/input.rst b/docs/source/user/elastodyn/input.rst index 2d1deea9b9..8fa4c66633 100644 --- a/docs/source/user/elastodyn/input.rst +++ b/docs/source/user/elastodyn/input.rst @@ -361,45 +361,4 @@ suspect channel from the output file. Please refer to the ElastoDyn tab in the Excel file :download:`OutListParameters.xlsx <../../../OtherSupporting/OutListParameters.xlsx>` for a complete list of possible output parameters. -.. _ED-Nodal-Outputs: - -Nodal Outputs -~~~~~~~~~~~~~ - -In addition to the named outputs in :numref:`ED-Outputs` above, ElastoDyn allows -for outputting the full set blade node motions and loads (tower nodes -unavailable at present). Please refer to the ElastoDyn_Nodes tab in the -Excel file :download:`OutListParameters.xlsx <../../../OtherSupporting/OutListParameters.xlsx>` -for a complete list of possible output parameters. - -This section follows the `END` statement from normal Outputs section described -above, and includes a separator description line followed by the following -optinos. - -**BldNd_BladesOut** specifies the number of blades to output. Possible values -are 0 through the number of blades ElastoDyn is modeling. If the value is set to -1, only blade 1 will be output, and if the value is 2, blades 1 and 2 will be -output. - -**BldNd_BlOutNd** specifies which nodes to output. This is currently unused. - -The **OutList** section controls the nodal output quantities generated by -ElastoDyn. In this section, the user specifies the name of the channel family to -output. The output name for each channel is then created internally by ElastoDyn -by combining the blade number, node number, and channel family name. For -example, if the user specifies **TDx** as the channel family name, the output -channels will be named with the convention of **B**\ :math:`\mathbf{\beta}`\ -**N###TDx** where :math:`\mathbf{\beta}` is the blade number, and **###** is the -three digit node number. - - -Sample Nodal Outputs section -^^^^^^^^^^^^^^^^^^^^^^^^^^^^ - -This sample includes the ``END`` statement from the regular outputs section. - -.. container:: - :name: File:EDNodalOutputs - - .. literalinclude:: exampleInput/NodalOutpus.txt - :linenos: +.. include:: EDNodalOutputs.rst diff --git a/modules/aerodyn/src/AeroDyn_IO.f90 b/modules/aerodyn/src/AeroDyn_IO.f90 index fdc9826f3d..11525e830f 100644 --- a/modules/aerodyn/src/AeroDyn_IO.f90 +++ b/modules/aerodyn/src/AeroDyn_IO.f90 @@ -2378,7 +2378,7 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, ADBlFile, OutFileRoot, UnE !----------- OUTLIST ----------------------------------------------------------- ! In case there is something ill-formed in the additional nodal outputs section, we will simply ignore it. - ErrMsg_NoAllBldNdOuts='AllBldNd section of AeroDyn input file not found or improperly formatted.' + ErrMsg_NoAllBldNdOuts='Nodal output section of AeroDyn input file not found or improperly formatted.' !----------- OUTLIST for BldNd ----------------------------------------------------------- CALL ReadCom( UnIn, InputFile, 'Section Header: OutList for Blade node channels', ErrStat2, ErrMsg2, UnEc ) From 4e23ee514a6d726de747e9c0242c446cbdc0fabc Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Thu, 25 Jun 2020 13:22:58 -0600 Subject: [PATCH 69/72] Fix copy-paste errors in documentation --- docs/source/user/aerodyn/examples/NodalOutputs.txt | 2 +- docs/source/user/aerodyn/examples/ad_primary_example.inp | 2 +- docs/source/user/beamdyn/examples/NodalOutputs.txt | 2 +- docs/source/user/beamdyn/examples/bd_primary_nrel_5mw.inp | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/docs/source/user/aerodyn/examples/NodalOutputs.txt b/docs/source/user/aerodyn/examples/NodalOutputs.txt index 851ed267ae..3445cec6ec 100644 --- a/docs/source/user/aerodyn/examples/NodalOutputs.txt +++ b/docs/source/user/aerodyn/examples/NodalOutputs.txt @@ -2,7 +2,7 @@ END of input file (the word "END" must appear in the first 3 columns of this las ---------------------- NODE OUTPUTS -------------------------------------------- 3 BldNd_BladesOut - Blades to output 99 BldNd_BlOutNd - Blade nodes on each blade (currently unused) - OutList - The next line(s) contains a list of output parameters. See OutListParameters.xlsx, ElastoDyn_Nodes tab for a listing of available output channels, (-) + OutList - The next line(s) contains a list of output parameters. See OutListParameters.xlsx, AeroDyn_Nodes tab for a listing of available output channels, (-) "VUndx" - x-component of undisturbed wind velocity at each node "VUndy" - y-component of undisturbed wind velocity at each node "VUndz" - z-component of undisturbed wind velocity at each node diff --git a/docs/source/user/aerodyn/examples/ad_primary_example.inp b/docs/source/user/aerodyn/examples/ad_primary_example.inp index 9c1a632987..2abc82ebf8 100644 --- a/docs/source/user/aerodyn/examples/ad_primary_example.inp +++ b/docs/source/user/aerodyn/examples/ad_primary_example.inp @@ -101,7 +101,7 @@ END (the word "END" must appear in the first 3 columns of this last OutList line ---------------------- NODE OUTPUTS -------------------------------------------- 3 BldNd_BladesOut - Blades to output 99 BldNd_BlOutNd - Blade nodes on each blade (currently unused) - OutList - The next line(s) contains a list of output parameters. See OutListParameters.xlsx, ElastoDyn_Nodes tab for a listing of available output channels, (-) + OutList - The next line(s) contains a list of output parameters. See OutListParameters.xlsx, AeroDyn_Nodes tab for a listing of available output channels, (-) "VUndx" "VUndy" "VUndz" diff --git a/docs/source/user/beamdyn/examples/NodalOutputs.txt b/docs/source/user/beamdyn/examples/NodalOutputs.txt index 536673ffca..7a260bc694 100644 --- a/docs/source/user/beamdyn/examples/NodalOutputs.txt +++ b/docs/source/user/beamdyn/examples/NodalOutputs.txt @@ -1,7 +1,7 @@ END of input file (the word "END" must appear in the first 3 columns of this last OutList line) ---------------------- NODE OUTPUTS -------------------------------------------- 99 BldNd_BlOutNd - Blade nodes on each blade (currently unused) - OutList - The next line(s) contains a list of output parameters. See OutListParameters.xlsx, ElastoDyn_Nodes tab for a listing of available output channels, (-) + OutList - The next line(s) contains a list of output parameters. See OutListParameters.xlsx, BeamDyn_Nodes tab for a listing of available output channels, (-) "FxL" - Sectional force resultants at each node expressed in l l: a floating coordinate system local to the deflected beam (N) "FyL" - Sectional force resultants at each node expressed in l l: a floating coordinate system local to the deflected beam (N) "FzL" - Sectional force resultants at each node expressed in l l: a floating coordinate system local to the deflected beam (N) diff --git a/docs/source/user/beamdyn/examples/bd_primary_nrel_5mw.inp b/docs/source/user/beamdyn/examples/bd_primary_nrel_5mw.inp index 04184566cf..251c3210c8 100644 --- a/docs/source/user/beamdyn/examples/bd_primary_nrel_5mw.inp +++ b/docs/source/user/beamdyn/examples/bd_primary_nrel_5mw.inp @@ -108,7 +108,7 @@ END of input file (the word "END" must appear in the first 3 columns of the last END of input file (the word "END" must appear in the first 3 columns of this last OutList line) ---------------------- NODE OUTPUTS -------------------------------------------- 99 BldNd_BlOutNd - Blade nodes on each blade (currently unused) - OutList - The next line(s) contains a list of output parameters. See OutListParameters.xlsx, ElastoDyn_Nodes tab for a listing of available output channels, (-) + OutList - The next line(s) contains a list of output parameters. See OutListParameters.xlsx, BeamDyn_Nodes tab for a listing of available output channels, (-) "FxL" "FyL" "FzL" From b775d2bb982f3a30e1afb0d69d77c90a8aa3daf6 Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Fri, 26 Jun 2020 13:34:50 -0600 Subject: [PATCH 70/72] Remove DBG_OUTS from AD15 This functionality is replaced by the nodal outputs. --- modules/aerodyn/src/AeroDyn.f90 | 87 ------------------------------ modules/aerodyn/src/AeroDyn_IO.f90 | 79 --------------------------- 2 files changed, 166 deletions(-) diff --git a/modules/aerodyn/src/AeroDyn.f90 b/modules/aerodyn/src/AeroDyn.f90 index 9237803707..6e19482989 100644 --- a/modules/aerodyn/src/AeroDyn.f90 +++ b/modules/aerodyn/src/AeroDyn.f90 @@ -82,11 +82,6 @@ subroutine AD_SetInitOut(p, InputFileData, InitOut, errStat, errMsg) integer(IntKi) :: i, j, k, f integer(IntKi) :: NumCoords -#ifdef DBG_OUTS - integer(IntKi) :: m - character(6) ::chanPrefix - character(3) :: TmpChar -#endif ! Initialize variables for this routine errStat = ErrID_None @@ -103,71 +98,10 @@ subroutine AD_SetInitOut(p, InputFileData, InitOut, errStat, errMsg) if (ErrStat >= AbortErrLev) return -#ifdef DBG_OUTS - ! Loop over blades and nodes to populate the output channel names and units - - do k=1,p%numBlades - do j=1, p%NumBlNds - - m = (k-1)*p%NumBlNds*23 + (j-1)*23 - - WRITE (TmpChar,'(I3.3)') j - chanPrefix = "B"//trim(num2lstr(k))//"N"//TmpChar - InitOut%WriteOutputHdr( m + 1 ) = trim(chanPrefix)//"Twst" - InitOut%WriteOutputUnt( m + 1 ) = ' (deg) ' - InitOut%WriteOutputHdr( m + 2 ) = trim(chanPrefix)//"Psi" - InitOut%WriteOutputUnt( m + 2 ) = ' (deg) ' - InitOut%WriteOutputHdr( m + 3 ) = trim(chanPrefix)//"Vx" - InitOut%WriteOutputUnt( m + 3 ) = ' (m/s) ' - InitOut%WriteOutputHdr( m + 4 ) = trim(chanPrefix)//"Vy" - InitOut%WriteOutputUnt( m + 4 ) = ' (m/s) ' - InitOut%WriteOutputHdr( m + 5 ) = ' '//trim(chanPrefix)//"AIn" - InitOut%WriteOutputUnt( m + 5 ) = ' (-) ' - InitOut%WriteOutputHdr( m + 6 ) = ' '//trim(chanPrefix)//"ApIn" - InitOut%WriteOutputUnt( m + 6 ) = ' (-) ' - InitOut%WriteOutputHdr( m + 7 ) = trim(chanPrefix)//"Vrel" - InitOut%WriteOutputUnt( m + 7 ) = ' (m/s) ' - InitOut%WriteOutputHdr( m + 8 ) = ' '//trim(chanPrefix)//"Phi" - InitOut%WriteOutputUnt( m + 8 ) = ' (deg) ' - InitOut%WriteOutputHdr( m + 9 ) = ' '//trim(chanPrefix)//"AOA" - InitOut%WriteOutputUnt( m + 9 ) = ' (deg) ' - InitOut%WriteOutputHdr( m + 10 ) = ' '//trim(chanPrefix)//"Cl" - InitOut%WriteOutputUnt( m + 10 ) = ' (-) ' - InitOut%WriteOutputHdr( m + 11 ) = ' '//trim(chanPrefix)//"Cd" - InitOut%WriteOutputUnt( m + 11 ) = ' (-) ' - InitOut%WriteOutputHdr( m + 12 ) = ' '//trim(chanPrefix)//"Cm" - InitOut%WriteOutputUnt( m + 12 ) = ' (-) ' - InitOut%WriteOutputHdr( m + 13 ) = ' '//trim(chanPrefix)//"Cx" - InitOut%WriteOutputUnt( m + 13 ) = ' (-) ' - InitOut%WriteOutputHdr( m + 14 ) = ' '//trim(chanPrefix)//"Cy" - InitOut%WriteOutputUnt( m + 14 ) = ' (-) ' - InitOut%WriteOutputHdr( m + 15 ) = ' '//trim(chanPrefix)//"Cn" - InitOut%WriteOutputUnt( m + 15 ) = ' (-) ' - InitOut%WriteOutputHdr( m + 16 ) = ' '//trim(chanPrefix)//"Ct" - InitOut%WriteOutputUnt( m + 16 ) = ' (-) ' - InitOut%WriteOutputHdr( m + 17 ) = ' '//trim(chanPrefix)//"Fl" - InitOut%WriteOutputUnt( m + 17 ) = ' (N/m) ' - InitOut%WriteOutputHdr( m + 18 ) = ' '//trim(chanPrefix)//"Fd" - InitOut%WriteOutputUnt( m + 18 ) = ' (N/m) ' - InitOut%WriteOutputHdr( m + 19 ) = ' '//trim(chanPrefix)//"M" - InitOut%WriteOutputUnt( m + 19 ) = ' (N/m^2) ' - InitOut%WriteOutputHdr( m + 20 ) = ' '//trim(chanPrefix)//"Fx" - InitOut%WriteOutputUnt( m + 20 ) = ' (N/m) ' - InitOut%WriteOutputHdr( m + 21 ) = ' '//trim(chanPrefix)//"Fy" - InitOut%WriteOutputUnt( m + 21 ) = ' (N/m) ' - InitOut%WriteOutputHdr( m + 22 ) = ' '//trim(chanPrefix)//"Fn" - InitOut%WriteOutputUnt( m + 22 ) = ' (N/m) ' - InitOut%WriteOutputHdr( m + 23 ) = ' '//trim(chanPrefix)//"Ft" - InitOut%WriteOutputUnt( m + 23 ) = ' (N/m) ' - - end do - end do -#else do i=1,p%NumOuts InitOut%WriteOutputHdr(i) = p%OutParam(i)%Name InitOut%WriteOutputUnt(i) = p%OutParam(i)%Units end do -#endif ! Set the info in WriteOutputHdr and WriteOutputUnt @@ -524,11 +458,7 @@ subroutine Init_MiscVars(m, p, u, y, errStat, errMsg) m%SigmaCavitCrit = 0.0_ReKi m%CavitWarnSet = .false. ! arrays for output -#ifdef DBG_OUTS - allocate( m%AllOuts(0:p%NumOuts), STAT=ErrStat2 ) ! allocate starting at zero to account for invalid output channels -#else allocate( m%AllOuts(0:MaxOutPts), STAT=ErrStat2 ) ! allocate starting at zero to account for invalid output channels -#endif if (ErrStat2 /= 0) then call SetErrStat( ErrID_Fatal, "Error allocating AllOuts.", errStat, errMsg, RoutineName ) return @@ -964,12 +894,6 @@ subroutine SetParameters( InitInp, InputFileData, p, ErrStat, ErrMsg ) !p%RootName = TRIM(InitInp%RootName)//'.AD' ! set earlier to it could be used -#ifdef DBG_OUTS - p%NBlOuts = 23 - p%numOuts = p%NumBlNds*p%NumBlades*p%NBlOuts - p%NTwOuts = 0 - -#else p%numOuts = InputFileData%NumOuts p%NBlOuts = InputFileData%NBlOuts p%BlOutNd = InputFileData%BlOutNd @@ -985,7 +909,6 @@ subroutine SetParameters( InitInp, InputFileData, p, ErrStat, ErrMsg ) call setErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if (ErrStat >= AbortErrLev) return -#endif @@ -1212,11 +1135,7 @@ subroutine AD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, !------------------------------------------------------- if (CalcWriteOutput) then if (p%NumOuts > 0) then -#ifdef DBG_OUTS - call Calc_WriteDbgOutput( p, u, m, y, ErrStat2, ErrMsg2 ) -#else call Calc_WriteOutput( p, u, m, y, OtherState, indx, ErrStat2, ErrMsg2 ) -#endif call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) !............................................................................................................................... @@ -1224,11 +1143,7 @@ subroutine AD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, !............................................................................................................................... do i = 1,p%NumOuts ! Loop through all selected output channels -#ifdef DBG_OUTS - y%WriteOutput(i) = m%AllOuts( i ) -#else y%WriteOutput(i) = p%OutParam(i)%SignM * m%AllOuts( p%OutParam(i)%Indx ) -#endif end do ! i - All selected output channels end if @@ -1424,9 +1339,7 @@ subroutine SetInputsForBEMT(p, u, m, indx, errStat, errMsg) call LAPACK_gemm( 'n', 't', 1.0_R8Ki, u%BladeRootMotion(k)%Orientation(:,:,1), u%HubMotion%Orientation(:,:,1), 0.0_R8Ki, orientation, errStat2, errMsg2) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) theta = EulerExtract( orientation ) !hub_theta_root(k) -#ifndef DBG_OUTS m%AllOuts( BPitch( k) ) = -theta(3)*R2D ! save this value of pitch for potential output -#endif theta(3) = 0.0_ReKi m%hub_theta_x_root(k) = theta(1) ! save this value for FAST.Farm diff --git a/modules/aerodyn/src/AeroDyn_IO.f90 b/modules/aerodyn/src/AeroDyn_IO.f90 index 11525e830f..1e471bded2 100644 --- a/modules/aerodyn/src/AeroDyn_IO.f90 +++ b/modules/aerodyn/src/AeroDyn_IO.f90 @@ -1512,81 +1512,6 @@ MODULE AeroDyn_IO contains -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE Calc_WriteDbgOutput( p, u, m, y, ErrStat, ErrMsg ) - - TYPE(AD_ParameterType), INTENT(IN ) :: p ! The module parameters - TYPE(AD_InputType), INTENT(IN ) :: u ! inputs - TYPE(AD_MiscVarType), INTENT(INOUT) :: m ! misc variables - TYPE(AD_OutputType), INTENT(IN ) :: y ! outputs - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! The error status code - CHARACTER(*), INTENT( OUT) :: ErrMsg ! The error message, if an error occurred - - ! local variables - integer, parameter :: indx = 1 ! m%BEMT_u(1) is at t; m%BEMT_u(2) is t+dt - CHARACTER(*), PARAMETER :: RoutineName = 'Calc_WriteOutput' - !INTEGER(intKi) :: ErrStat2 - !CHARACTER(ErrMsgLen) :: ErrMsg2 - - INTEGER(IntKi) :: j,k,i - REAL(ReKi) :: ct, st ! cosine, sine of theta - REAL(ReKi) :: cp, sp ! cosine, sine of phi - - - - ! start routine: - ErrStat = ErrID_None - ErrMsg = "" - - - - ! blade outputs - do k=1,p%numBlades - - ! m%AllOuts( BPitch( k) ) = calculated in SetInputsForBEMT - - do j=1,p%NumBlNds - - i = (k-1)*p%NumBlNds*23 + (j-1)*23 + 1 - - m%AllOuts( i ) = m%BEMT_u(indx)%theta(j,k)*R2D - m%AllOuts( i+1 ) = m%BEMT_u(indx)%psi(k)*R2D - m%AllOuts( i+2 ) = -m%BEMT_u(indx)%Vx(j,k) - m%AllOuts( i+3 ) = m%BEMT_u(indx)%Vy(j,k) - - m%AllOuts( i+4 ) = m%BEMT_y%axInduction(j,k) - m%AllOuts( i+5 ) = m%BEMT_y%tanInduction(j,k) - m%AllOuts( i+6 ) = m%BEMT_y%Vrel(j,k) - m%AllOuts( i+7 ) = m%BEMT_y%phi(j,k)*R2D - m%AllOuts( i+8 ) = (m%BEMT_y%phi(j,k) - m%BEMT_u(indx)%theta(j,k))*R2D - - - m%AllOuts( i+9 ) = m%BEMT_y%Cl(j,k) - m%AllOuts( i+10 ) = m%BEMT_y%Cd(j,k) - m%AllOuts( i+11 ) = m%BEMT_y%Cm(j,k) - m%AllOuts( i+12 ) = m%BEMT_y%Cx(j,k) - m%AllOuts( i+13 ) = m%BEMT_y%Cy(j,k) - - ct=cos(m%BEMT_u(indx)%theta(j,k)) - st=sin(m%BEMT_u(indx)%theta(j,k)) - m%AllOuts( i+14 ) = m%BEMT_y%Cx(j,k)*ct + m%BEMT_y%Cy(j,k)*st - m%AllOuts( i+15 ) = -m%BEMT_y%Cx(j,k)*st + m%BEMT_y%Cy(j,k)*ct - - cp=cos(m%BEMT_y%phi(j,k)) - sp=sin(m%BEMT_y%phi(j,k)) - m%AllOuts( i+16 ) = m%X(j,k)*cp - m%Y(j,k)*sp - m%AllOuts( i+17 ) = m%X(j,k)*sp + m%Y(j,k)*cp - m%AllOuts( i+18 ) = m%M(j,k) - m%AllOuts( i+19 ) = m%X(j,k) - m%AllOuts( i+20 ) = -m%Y(j,k) - m%AllOuts( i+21 ) = m%X(j,k)*ct - m%Y(j,k)*st - m%AllOuts( i+22 ) = -m%X(j,k)*st - m%Y(j,k)*ct - - end do ! nodes - end do ! blades - -END SUBROUTINE Calc_WriteDbgOutput - !---------------------------------------------------------------------------------------------------------------------------------- SUBROUTINE Calc_WriteOutput( p, u, m, y, OtherState, indx, ErrStat, ErrMsg ) @@ -2821,9 +2746,6 @@ SUBROUTINE AD_PrintSum( InputFileData, p, u, y, ErrStat, ErrMsg ) end if -#ifndef DBG_OUTS -! p%OutParam isn't allocated when DBG_OUTS is defined - OutPFmt = '( 15x, I4, 2X, A '//TRIM(Num2LStr(ChanLen))//',1 X, A'//TRIM(Num2LStr(ChanLen))//' )' WRITE (UnSu,'(15x,A)') 'Requested Output Channels:' WRITE (UnSu,'(15x,A)') 'Col Parameter Units' @@ -2841,7 +2763,6 @@ SUBROUTINE AD_PrintSum( InputFileData, p, u, y, ErrStat, ErrMsg ) DO I = 1,p%BldNd_NumOuts WRITE (UnSu,OutPFmt) I, p%BldNd_OutParam(I)%Name, p%BldNd_OutParam(I)%Units END DO -#endif CLOSE(UnSu) From beea78834379b271436ce430bc041a3767aa8825 Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Fri, 26 Jun 2020 14:51:02 -0600 Subject: [PATCH 71/72] Documentation error. Removed duplicate nodal input sections from AD and BD example files. --- .../aerodyn/examples/ad_primary_example.inp | 47 ------ .../beamdyn/examples/bd_primary_nrel_5mw.inp | 137 ------------------ 2 files changed, 184 deletions(-) diff --git a/docs/source/user/aerodyn/examples/ad_primary_example.inp b/docs/source/user/aerodyn/examples/ad_primary_example.inp index 2abc82ebf8..d3ca180f54 100644 --- a/docs/source/user/aerodyn/examples/ad_primary_example.inp +++ b/docs/source/user/aerodyn/examples/ad_primary_example.inp @@ -98,50 +98,3 @@ Vindx Vindy Alpha END (the word "END" must appear in the first 3 columns of this last OutList line in the optional nodal output section) ----------------------- NODE OUTPUTS -------------------------------------------- - 3 BldNd_BladesOut - Blades to output - 99 BldNd_BlOutNd - Blade nodes on each blade (currently unused) - OutList - The next line(s) contains a list of output parameters. See OutListParameters.xlsx, AeroDyn_Nodes tab for a listing of available output channels, (-) -"VUndx" -"VUndy" -"VUndz" -"VDisx" -"VDisy" -"VDisz" -"STVx" -"STVy" -"STVz" -"VRel" -"DynP" -"Re" -"M" -"Vindx" -"Vindy" -"AxInd" -"TnInd" -"Alpha" -"Theta" -"Phi" -"Curve" -"Cl" -"Cd" -"Cm" -"Cx" -"Cy" -"Cn" -"Ct" -"Fl" -"Fd" -"Mm" -"Fx" -"Fy" -"Fn" -"Ft" -"Clrnc" -"Vx" -"Vy" -"GeomPhi" -"Chi" -"UA_Flag" -END of input file (the word "END" must appear in the first 3 columns of this last OutList line) ---------------------------------------------------------------------------------------- diff --git a/docs/source/user/beamdyn/examples/bd_primary_nrel_5mw.inp b/docs/source/user/beamdyn/examples/bd_primary_nrel_5mw.inp index 251c3210c8..1fcd7475e1 100644 --- a/docs/source/user/beamdyn/examples/bd_primary_nrel_5mw.inp +++ b/docs/source/user/beamdyn/examples/bd_primary_nrel_5mw.inp @@ -106,140 +106,3 @@ END of input file (the word "END" must appear in the first 3 columns of the last "TipTDxr, TipTDyr, TipTDzr" "TipRDxr, TipRDyr, TipRDzr" END of input file (the word "END" must appear in the first 3 columns of this last OutList line) ----------------------- NODE OUTPUTS -------------------------------------------- - 99 BldNd_BlOutNd - Blade nodes on each blade (currently unused) - OutList - The next line(s) contains a list of output parameters. See OutListParameters.xlsx, BeamDyn_Nodes tab for a listing of available output channels, (-) -"FxL" -"FyL" -"FzL" -"MxL" -"MyL" -"MzL" -"Fxr" -"Fyr" -"Fzr" -"Mxr" -"Myr" -"Mzr" -"TDxr" -"TDyr" -"TDzr" -"RDxr" -"RDyr" -"RDzr" -"AbsXg" -"AbsYg" -"AbsZg" -"AbsXr" -"AbsYr" -"AbsZr" -"TVxg" -"TVyg" -"TVzg" -"TVxl" -"TVyl" -"TVzl" -"TVxr" -"TVyr" -"TVzr" -"RVxg" -"RVyg" -"RVzg" -"RVxl" -"RVyl" -"RVzl" -"RVxr" -"RVyr" -"RVzr" -"TAxl" -"TAyl" -"TAzl" -"TAxr" -"TAyr" -"TAzr" -"RAxl" -"RAyl" -"RAzl" -"RAxr" -"RAyr" -"RAzr" -"PFxL" -"PFyL" -"PFzL" -"PMxL" -"PMyL" -"PMzL" -"DFxL" -"DFyL" -"DFzL" -"DMxL" -"DMyL" -"DMzL" -"DFxR" -"DFyR" -"DFzR" -"DMxR" -"DMyR" -"DMzR" -"FFbxl" -"FFbyl" -"FFbzl" -"FFbxr" -"FFbyr" -"FFbzr" -"MFbxl" -"MFbyl" -"MFbzl" -"MFbxr" -"MFbyr" -"MFbzr" -"FFcxl" -"FFcyl" -"FFczl" -"FFcxr" -"FFcyr" -"FFczr" -"MFcxl" -"MFcyl" -"MFczl" -"MFcxr" -"MFcyr" -"MFczr" -"FFdxl" -"FFdyl" -"FFdzl" -"FFdxr" -"FFdyr" -"FFdzr" -"MFdxl" -"MFdyl" -"MFdzl" -"MFdxr" -"MFdyr" -"MFdzr" -"FFgxl" -"FFgyl" -"FFgzl" -"FFgxr" -"FFgyr" -"FFgzr" -"MFgxl" -"MFgyl" -"MFgzl" -"MFgxr" -"MFgyr" -"MFgzr" -"FFixl" -"FFiyl" -"FFizl" -"FFixr" -"FFiyr" -"FFizr" -"MFixl" -"MFiyl" -"MFizl" -"MFixr" -"MFiyr" -"MFizr" -END of input file (the word "END" must appear in the first 3 columns of this last OutList line) ---------------------------------------------------------------------------------------- From 4a81a85610655ce6bf6ffdd44954640df22ccb4c Mon Sep 17 00:00:00 2001 From: Rafael M Mudafort Date: Mon, 13 Jul 2020 17:20:24 -0500 Subject: [PATCH 72/72] Update r-test commit --- 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 318137143a..8fb74c6e5a 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 318137143a870b417f55656f034558de18d8d33c +Subproject commit 8fb74c6e5aca388b72488c88df5032df9a340491