From 9902d903b071485d29ed045a49a6e43857539595 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Mon, 18 Dec 2023 15:00:31 -0700 Subject: [PATCH 1/8] minor updates to comments - removed readme file that doesn't apply any more - removed SeaSt module dependence from HD (it already uses SeaSt_WaveField) --- modules/hydrodyn/src/HydroDyn.txt | 1 - modules/hydrodyn/src/HydroDyn_Types.f90 | 1 - modules/nwtc-library/src/readme.txt | 8 -------- modules/openfast-library/src/FAST_Lin.f90 | 2 -- modules/openfast-library/src/FAST_Subs.f90 | 4 ++-- 5 files changed, 2 insertions(+), 14 deletions(-) delete mode 100644 modules/nwtc-library/src/readme.txt diff --git a/modules/hydrodyn/src/HydroDyn.txt b/modules/hydrodyn/src/HydroDyn.txt index 7d2b9c0766..00939dcaaa 100644 --- a/modules/hydrodyn/src/HydroDyn.txt +++ b/modules/hydrodyn/src/HydroDyn.txt @@ -21,7 +21,6 @@ usefrom WAMIT.txt usefrom WAMIT2.txt usefrom Morison.txt usefrom SeaSt_WaveField.txt -usefrom SeaState.txt param HydroDyn/HydroDyn unused INTEGER MaxHDOutputs - 510 - "The maximum number of output channels supported by this module" - param HydroDyn/HydroDyn unused INTEGER MaxUserOutputs - 5150 - " Total possible number of output channels: SS_Excitation = 7 + SS_Radiation = 7 + Morison= 4626 + HydroDyn=510 = 5150" - diff --git a/modules/hydrodyn/src/HydroDyn_Types.f90 b/modules/hydrodyn/src/HydroDyn_Types.f90 index 21d8555c40..54102ff6d8 100644 --- a/modules/hydrodyn/src/HydroDyn_Types.f90 +++ b/modules/hydrodyn/src/HydroDyn_Types.f90 @@ -37,7 +37,6 @@ MODULE HydroDyn_Types USE WAMIT_Types USE WAMIT2_Types USE Morison_Types -USE SeaState_Types USE NWTC_Library IMPLICIT NONE INTEGER(IntKi), PUBLIC, PARAMETER :: MaxHDOutputs = 510 ! The maximum number of output channels supported by this module [-] diff --git a/modules/nwtc-library/src/readme.txt b/modules/nwtc-library/src/readme.txt deleted file mode 100644 index 607db5ced8..0000000000 --- a/modules/nwtc-library/src/readme.txt +++ /dev/null @@ -1,8 +0,0 @@ -The two NWTC_Library-related types files cannot be generated through the registry. At the moment it is a manual process. - -The NWTC registry input file gets split into two sections: one for the mesh mapping and everything else. -It's not an automatic process since you have to copy the SetErrStat routine into NWTC_Library_Types.f90, -and you have to copy the mesh-related types/routines into the ModMesh_Types.f90 file. -Originally, we also had to change some other parts, too, but I've hard-coded some stuff -in the registry source code for when it is trying to generate types for the NWTC_Library module. -We could hard-code the registry to generate SetErrStat() at some point, too. \ No newline at end of file diff --git a/modules/openfast-library/src/FAST_Lin.f90 b/modules/openfast-library/src/FAST_Lin.f90 index dae24ac693..f9847771ae 100644 --- a/modules/openfast-library/src/FAST_Lin.f90 +++ b/modules/openfast-library/src/FAST_Lin.f90 @@ -2275,8 +2275,6 @@ SUBROUTINE Linear_SD_InputSolve_du( p_FAST, y_FAST, SrvD, u_SD, y_SD, y_ED, HD, ! Transfer MAP loads to ED PlatformPtmesh input: ! we're mapping loads, so we also need the sibling meshes' displacements: - MAP_Start = y_FAST%Lin%Modules(MODULE_MAP)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - MAP_Start = y_FAST%Lin%Modules(MODULE_MAP)%Instance(1)%LinStartIndx(LIN_INPUT_COL) ! NOTE: Assumes at least one MAP Fairlead point diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index c7b44503a3..743bbc4e73 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -1127,7 +1127,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, Init%InData_FEAM%NStepWave = 1 ! an arbitrary number > 0 (to set the size of the wave data, which currently contains all zero values) Init%InData_FEAM%gravity = p_FAST%Gravity ! This need to be according to g from driver Init%InData_FEAM%WtrDens = Init%OutData_SeaSt%WaveField%WtrDens ! This needs to be set according to seawater density in SeaState -! Init%InData_FEAM%depth = Init%OutData_SeaSt%WtrDpth ! This need to be set according to the water depth in SeaState +! Init%InData_FEAM%depth = Init%OutData_SeaSt%WaveField%WtrDpth ! This need to be set according to the water depth in SeaState CALL FEAM_Init( Init%InData_FEAM, FEAM%Input(1), FEAM%p, FEAM%x(STATE_CURR), FEAM%xd(STATE_CURR), FEAM%z(STATE_CURR), & FEAM%OtherSt(STATE_CURR), FEAM%y, FEAM%m, p_FAST%dt_module( MODULE_FEAM ), Init%OutData_FEAM, ErrStat2, ErrMsg2 ) @@ -3853,7 +3853,7 @@ SUBROUTINE SetVTKParameters_B4SeaSt(p_FAST, InitOutData_ED, InitInData_SeaSt, BD n = 1 do i=1,p_FAST%VTK_surface%NWaveElevPts(1) do j=1,p_FAST%VTK_surface%NWaveElevPts(2) - InitInData_SeaSt%WaveElevXY(1,n) = dx*(i-1) - WidthBy2 !+ p_FAST%TurbinePos(1) ! HD takes p_FAST%TurbinePos into account already + InitInData_SeaSt%WaveElevXY(1,n) = dx*(i-1) - WidthBy2 !+ p_FAST%TurbinePos(1) ! SeaSt takes p_FAST%TurbinePos into account already InitInData_SeaSt%WaveElevXY(2,n) = dy*(j-1) - WidthBy2 !+ p_FAST%TurbinePos(2) n = n+1 end do From db502618c3daf4de979341b5ca5a71fe43edb0a7 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Wed, 20 Dec 2023 14:23:36 -0700 Subject: [PATCH 2/8] VTK: use AD tower for visualization, if available --- modules/openfast-library/src/FAST_Subs.f90 | 61 +++++++++++++++------- 1 file changed, 43 insertions(+), 18 deletions(-) diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 743bbc4e73..7258e3a830 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -3853,8 +3853,8 @@ SUBROUTINE SetVTKParameters_B4SeaSt(p_FAST, InitOutData_ED, InitInData_SeaSt, BD n = 1 do i=1,p_FAST%VTK_surface%NWaveElevPts(1) do j=1,p_FAST%VTK_surface%NWaveElevPts(2) - InitInData_SeaSt%WaveElevXY(1,n) = dx*(i-1) - WidthBy2 !+ p_FAST%TurbinePos(1) ! SeaSt takes p_FAST%TurbinePos into account already - InitInData_SeaSt%WaveElevXY(2,n) = dy*(j-1) - WidthBy2 !+ p_FAST%TurbinePos(2) + InitInData_SeaSt%WaveElevXY(1,n) = dx*(i-1) - WidthBy2 ! SeaSt takes p_FAST%TurbinePos into account already + InitInData_SeaSt%WaveElevXY(2,n) = dy*(j-1) - WidthBy2 n = n+1 end do end do @@ -3873,7 +3873,7 @@ SUBROUTINE SetVTKParameters(p_FAST, InitOutData_ED, InitOutData_AD, InitInData_S TYPE(SeaSt_InitInputType), INTENT(INOUT) :: InitInData_SeaSt !< The initialization input to SeaState TYPE(SeaSt_InitOutputType), INTENT(INOUT) :: InitOutData_SeaSt !< The initialization output from SeaState TYPE(HydroDyn_InitOutputType),INTENT(INOUT) :: InitOutData_HD !< The initialization output from HydroDyn - TYPE(ElastoDyn_Data), INTENT(IN ) :: ED !< ElastoDyn data + TYPE(ElastoDyn_Data), TARGET, INTENT(IN ) :: ED !< ElastoDyn data TYPE(BeamDyn_Data), INTENT(IN ) :: BD !< BeamDyn data TYPE(AeroDyn_Data), INTENT(IN ) :: AD !< AeroDyn data TYPE(HydroDyn_Data), INTENT(IN ) :: HD !< HydroDyn data @@ -3884,7 +3884,9 @@ SUBROUTINE SetVTKParameters(p_FAST, InitOutData_ED, InitOutData_AD, InitInData_S REAL(SiKi) :: x, y REAL(SiKi) :: TwrDiam_top, TwrDiam_base, TwrRatio, TwrLength INTEGER(IntKi) :: topNode, baseNode - INTEGER(IntKi) :: NumBl, k + INTEGER(IntKi) :: NumBl, k, Indx + LOGICAL :: UseADtwr + TYPE(MeshType), POINTER :: TowerMotionMesh CHARACTER(1024) :: vtkroot INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -3962,28 +3964,51 @@ SUBROUTINE SetVTKParameters(p_FAST, InitOutData_ED, InitOutData_AD, InitInData_S p_FAST%VTK_Surface%NacelleBox(:,8) = (/ -x, y, 2*y /) !....................... - ! tapered tower + ! Create the tower surface data !....................... + TowerMotionMesh => ED%y%TowerLn2Mesh - CALL AllocAry(p_FAST%VTK_Surface%TowerRad,ED%y%TowerLn2Mesh%NNodes,'VTK_Surface%TowerRad',ErrStat2,ErrMsg2) + CALL AllocAry(p_FAST%VTK_Surface%TowerRad,TowerMotionMesh%NNodes,'VTK_Surface%TowerRad',ErrStat2,ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF (ErrStat >= AbortErrLev) RETURN - topNode = ED%y%TowerLn2Mesh%NNodes - 1 - baseNode = ED%y%TowerLn2Mesh%refNode - TwrLength = TwoNorm( ED%y%TowerLn2Mesh%position(:,topNode) - ED%y%TowerLn2Mesh%position(:,baseNode) ) ! this is the assumed length of the tower - TwrRatio = TwrLength / 87.6_SiKi ! use ratio of the tower length to the length of the 5MW tower - TwrDiam_top = 3.87*TwrRatio - TwrDiam_base = 6.0*TwrRatio - - TwrRatio = 0.5 * (TwrDiam_top - TwrDiam_base) / TwrLength - do k=1,ED%y%TowerLn2Mesh%NNodes - TwrLength = TwoNorm( ED%y%TowerLn2Mesh%position(:,k) - ED%y%TowerLn2Mesh%position(:,baseNode) ) - p_FAST%VTK_Surface%TowerRad(k) = 0.5*TwrDiam_Base + TwrRatio*TwrLength - end do + IF ( p_FAST%CompAero == Module_AD .and. allocated(InitOutData_AD%rotors) .and. allocated(AD%y%rotors) ) THEN ! These meshes may have tower diameter data associated with nodes + UseADtwr = allocated(InitOutData_AD%rotors(1)%TowerRad) + ELSE + UseADtwr = .false. + END IF + if (UseADtwr) then + + ! This assumes a vertical tower (i.e., we deal only with z component of position) + Indx = 1 + do k=1,TowerMotionMesh%NNodes + p_FAST%VTK_Surface%TowerRad(k) = InterpStp( TowerMotionMesh%Position(3,k), AD%y%rotors(1)%TowerLoad%Position(3,:), InitOutData_AD%rotors(1)%TowerRad, Indx, AD%y%rotors(1)%TowerLoad%NNodes ) + end do + + else + !....................... + ! default tapered tower, based on 5MW baseline turbine: + !....................... + + topNode = maxloc(TowerMotionMesh%position(3,:),DIM=1) + baseNode = minloc(TowerMotionMesh%position(3,:),DIM=1) + TwrLength = TwoNorm( TowerMotionMesh%position(:,topNode) - TowerMotionMesh%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,TowerMotionMesh%NNodes + TwrLength = TwoNorm( TowerMotionMesh%position(:,k) - TowerMotionMesh%position(:,baseNode) ) + p_FAST%VTK_Surface%TowerRad(k) = 0.5*TwrDiam_Base + TwrRatio*TwrLength + end do + end if + + !....................... ! blade surfaces !....................... From d0a338b69be6538783777b4198f250347618d31b Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Wed, 20 Dec 2023 14:25:36 -0700 Subject: [PATCH 3/8] minor cleanup - I'm not a fan of variables named with lower-case "l", so I made them upper case "L". This is less likely to be confused with the number "1" - registry now gives an error message before ending when data types contain invalid types --- .../nwtc-library/src/Registry_NWTC_Library.txt | 18 +++++++++--------- modules/nwtc-library/src/SysMatlabWindows.f90 | 1 - modules/nwtc-library/src/VTK.f90 | 4 ++-- modules/openfast-library/src/FAST_Subs.f90 | 16 ++++++++-------- .../src/registry_gen_fortran.cpp | 3 +++ 5 files changed, 22 insertions(+), 20 deletions(-) diff --git a/modules/nwtc-library/src/Registry_NWTC_Library.txt b/modules/nwtc-library/src/Registry_NWTC_Library.txt index c90cc0224a..5b6e03407e 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library.txt @@ -24,10 +24,10 @@ 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 FileInfoType IntKi NumLines -typedef ^ ^ IntKi NumFiles -typedef ^ ^ IntKi FileLine {:} -typedef ^ ^ IntKi FileIndx {:} +typedef NWTC_Library FileInfoType IntKi NumLines +typedef ^ ^ IntKi NumFiles +typedef ^ ^ IntKi FileLine {:} +typedef ^ ^ IntKi FileIndx {:} typedef ^ ^ CHARACTER(MaxFileInfoLineLen) FileList {:} typedef ^ ^ CHARACTER(MaxFileInfoLineLen) Lines {:} @@ -35,9 +35,9 @@ typedef NWTC_Library Quaternion ReKi q0 typedef ^ ^ ReKi v {3} typedef NWTC_Library NWTC_RandomNumber_ParameterType IntKi pRNG -typedef ^ ^ IntKi RandSeed {3} -typedef ^ ^ IntKi RandSeedAry {:} -typedef ^ ^ CHARACTER(6) RNG_type +typedef ^ ^ IntKi RandSeed {3} +typedef ^ ^ IntKi RandSeedAry {:} +typedef ^ ^ CHARACTER(6) RNG_type # This file defines types that may be used from the NWTC_Library # include this into a component registry file if you wish to use these types @@ -76,6 +76,6 @@ typedef ^ ^ R8Ki DisplacedPo typedef ^ ^ R8Ki LoadLn2_A_Mat {:}{:} - - "The 3-components of the forces for each node of an element in the point-to-line load mapping (for each element)" typedef ^ ^ R8Ki LoadLn2_F {:}{:} - - "The 6-by-6 matrix that makes up the diagonal of the [A 0; B A] matrix in the point-to-line load mapping" typedef ^ ^ R8Ki LoadLn2_M {:}{:} - - "The 3-components of the moments for each node of an element in the point-to-line load mapping (for each element)" -typedef ^ ^ MeshMapLinearizationType dM -#typedef ^ ^ MeshType Lumped_Points_Dest - - - "temporary mesh for debugging the lumped values in the line2-to-line2" +typedef ^ ^ MeshMapLinearizationType dM +#typedef ^ ^ MeshType Lumped_Points_Dest - - - "temporary mesh for debugging the lumped values in the line2-to-line2" diff --git a/modules/nwtc-library/src/SysMatlabWindows.f90 b/modules/nwtc-library/src/SysMatlabWindows.f90 index ff266e9b13..09c931aff2 100644 --- a/modules/nwtc-library/src/SysMatlabWindows.f90 +++ b/modules/nwtc-library/src/SysMatlabWindows.f90 @@ -47,7 +47,6 @@ MODULE SysSubs !======================================================================= - INTEGER, PARAMETER :: ConRecL = 120 ! The record length for console output. INTEGER, PARAMETER :: CU = 6 ! The I/O unit for the console. INTEGER, PARAMETER :: MaxWrScrLen = 98 ! The maximum number of characters allowed to be written to a line in WrScr diff --git a/modules/nwtc-library/src/VTK.f90 b/modules/nwtc-library/src/VTK.f90 index d70345dec7..78642a159f 100644 --- a/modules/nwtc-library/src/VTK.f90 +++ b/modules/nwtc-library/src/VTK.f90 @@ -12,8 +12,8 @@ module VTK implicit none - character(8), parameter :: RFMT='E17.8E3' - character(8), parameter :: IFMT='I7' + character(*), parameter :: RFMT='E17.8E3' + character(*), parameter :: IFMT='I7' ! Internal type to ensure the same options are used in between calls for the functions vtk_* TYPE, PUBLIC :: VTK_Misc diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 7258e3a830..c453c93763 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -6362,7 +6362,7 @@ SUBROUTINE WrVTK_Surfaces(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW logical, parameter :: OutputFields = .FALSE. ! due to confusion about what fields mean on a surface, we are going to just output the basic meshes if people ask for fields - INTEGER(IntKi) :: NumBl, k, l + INTEGER(IntKi) :: NumBl, k, L INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMSg2 CHARACTER(*), PARAMETER :: RoutineName = 'WrVTK_Surfaces' @@ -6451,18 +6451,18 @@ SUBROUTINE WrVTK_Surfaces(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW if ( p_FAST%CompMooring == Module_MD ) THEN !call MeshWrVTK(p_FAST%TurbinePos, MD%Input(1)%CoupledKinematics, trim(p_FAST%VTK_OutFileRoot)//'.MD_PtFair_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) if (allocated(MD%y%VisLinesMesh)) then - do l=1,size(MD%y%VisLinesMesh) - if (MD%y%VisLinesMesh(l)%Committed) then ! No orientation data, so surface representation not possible - call MeshWrVTK(p_FAST%TurbinePos, MD%y%VisLinesMesh(l), trim(p_FAST%VTK_OutFileRoot)//'.MD_Line'//trim(Num2LStr(l)), y_FAST%VTK_count, p_FAST%VTK_fields, & + do L=1,size(MD%y%VisLinesMesh) + if (MD%y%VisLinesMesh(L)%Committed) then ! No orientation data, so surface representation not possible + call MeshWrVTK(p_FAST%TurbinePos, MD%y%VisLinesMesh(L), trim(p_FAST%VTK_OutFileRoot)//'.MD_Line'//trim(Num2LStr(L)), y_FAST%VTK_count, p_FAST%VTK_fields, & ErrSTat2, ErrMsg2, p_FAST%VTK_tWidth ) endif enddo endif if (allocated(MD%y%VisRodsMesh)) then - do l=1,size(MD%y%VisRodsMesh) - if (MD%y%VisRodsMesh(l)%Committed) then ! No orientation data, so surface representation not possible - call MeshWrVTK_Ln2Surface(p_FAST%TurbinePos, MD%y%VisRodsMesh(l), trim(p_FAST%VTK_OutFileRoot)//'.MD_Rod'//trim(Num2LStr(l))//'Surface', y_FAST%VTK_count, p_FAST%VTK_fields, & - ErrSTat2, ErrMsg2, p_FAST%VTK_tWidth, NumSegments=p_FAST%VTK_Surface%NumSectors, Radius=MD%p%VisRodsDiam(l)%Diam ) + do L=1,size(MD%y%VisRodsMesh) + if (MD%y%VisRodsMesh(L)%Committed) then ! No orientation data, so surface representation not possible + call MeshWrVTK_Ln2Surface(p_FAST%TurbinePos, MD%y%VisRodsMesh(L), trim(p_FAST%VTK_OutFileRoot)//'.MD_Rod'//trim(Num2LStr(L))//'Surface', y_FAST%VTK_count, p_FAST%VTK_fields, & + ErrSTat2, ErrMsg2, p_FAST%VTK_tWidth, NumSegments=p_FAST%VTK_Surface%NumSectors, Radius=MD%p%VisRodsDiam(L)%Diam ) endif enddo endif diff --git a/modules/openfast-registry/src/registry_gen_fortran.cpp b/modules/openfast-registry/src/registry_gen_fortran.cpp index 8444173d83..d3cd46b45d 100644 --- a/modules/openfast-registry/src/registry_gen_fortran.cpp +++ b/modules/openfast-registry/src/registry_gen_fortran.cpp @@ -116,7 +116,10 @@ void Registry::gen_fortran_module(const Module &mod, const std::string &out_dir) // verify that it does, otherwise exit with error if ((ddt.interface != nullptr) && ddt.interface->only_reals) if (!ddt.only_contains_reals()) + { + std::cerr << "Registry warning: Data type '" << dt_name << "' contains non-real values." << std::endl; exit(EXIT_FAILURE); + } // Write derived type header w << "! ========= " << ddt.type_fortran << (this->gen_c_code ? "_C" : "") << " =======\n"; From 37f7da585c7d6b505bb433ebd97ab022c4524aa0 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Wed, 20 Dec 2023 14:27:08 -0700 Subject: [PATCH 4/8] NWTC Library: fix memory size printed in some error statements in some cases, default reals were used instead of double or single, so the error messages when not able to allocate some variables could have been incorrect --- modules/nwtc-library/src/NWTC_IO.f90 | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/modules/nwtc-library/src/NWTC_IO.f90 b/modules/nwtc-library/src/NWTC_IO.f90 index 25d317c68d..57aece75f5 100644 --- a/modules/nwtc-library/src/NWTC_IO.f90 +++ b/modules/nwtc-library/src/NWTC_IO.f90 @@ -726,7 +726,7 @@ SUBROUTINE AllR4PAry3 ( Ary, AryDim1, AryDim2, AryDim3, Descr, ErrStat, ErrMsg ALLOCATE ( Ary(AryDim1,AryDim2,AryDim3) , STAT=ErrStat ) IF ( ErrStat /= 0 ) THEN ErrStat = ErrID_Fatal - ErrMsg = 'Error allocating '//TRIM(Num2LStr(AryDim1*AryDim2*AryDim3*BYTES_IN_REAL))//& + ErrMsg = 'Error allocating '//TRIM(Num2LStr(AryDim1*AryDim2*AryDim3*BYTES_IN_R4Ki))//& ' bytes of memory for the '//TRIM( Descr )//' array.' ELSE ErrStat = ErrID_None @@ -763,7 +763,7 @@ SUBROUTINE AllR8PAry3 ( Ary, AryDim1, AryDim2, AryDim3, Descr, ErrStat, ErrMsg ALLOCATE ( Ary(AryDim1,AryDim2,AryDim3) , STAT=ErrStat ) IF ( ErrStat /= 0 ) THEN ErrStat = ErrID_Fatal - ErrMsg = 'Error allocating '//TRIM(Num2LStr(AryDim1*AryDim2*AryDim3*BYTES_IN_REAL))//& + ErrMsg = 'Error allocating '//TRIM(Num2LStr(AryDim1*AryDim2*AryDim3*BYTES_IN_R8Ki))//& ' bytes of memory for the '//TRIM( Descr )//' array.' ELSE ErrStat = ErrID_None @@ -901,7 +901,7 @@ SUBROUTINE AllR4Ary1 ( Ary, AryDim1, Descr, ErrStat, ErrMsg ) IF ( ALLOCATED(Ary) ) THEN ! or Sttus=151 on IVF ErrMsg = 'Error allocating memory for the '//TRIM( Descr )//' array; array was already allocated.' ELSE - ErrMsg = 'Error allocating '//TRIM(Num2LStr(AryDim1*BYTES_IN_SiKi))//' bytes of memory for the '//TRIM( Descr )//' array.' + ErrMsg = 'Error allocating '//TRIM(Num2LStr(AryDim1*BYTES_IN_R4Ki))//' bytes of memory for the '//TRIM( Descr )//' array.' END IF ELSE ErrStat = ErrID_None @@ -971,7 +971,7 @@ SUBROUTINE AllR4Ary2 ( Ary, AryDim1, AryDim2, Descr, ErrStat, ErrMsg ) IF ( ALLOCATED(Ary) ) THEN ErrMsg = 'Error allocating memory for the '//TRIM( Descr )//' array; array was already allocated.' ELSE - ErrMsg = 'Error allocating '//TRIM(Num2LStr(AryDim1*AryDim2*BYTES_IN_SiKi))//& + ErrMsg = 'Error allocating '//TRIM(Num2LStr(AryDim1*AryDim2*BYTES_IN_R4Ki))//& ' bytes of memory for the '//TRIM( Descr )//' array.' END IF ELSE @@ -1047,7 +1047,7 @@ SUBROUTINE AllR4Ary3 ( Ary, AryDim1, AryDim2, AryDim3, Descr, ErrStat, ErrMsg ) IF ( ALLOCATED(Ary) ) THEN ! or Sttus=151 on IVF ErrMsg = 'Error allocating memory for the '//TRIM( Descr )//' array; array was already allocated.' ELSE - ErrMsg = 'Error allocating '//TRIM(Num2LStr(AryDim1*AryDim2*AryDim3*BYTES_IN_REAL))//& + ErrMsg = 'Error allocating '//TRIM(Num2LStr(AryDim1*AryDim2*AryDim3*BYTES_IN_R4Ki))//& ' bytes of memory for the '//TRIM( Descr )//' array.' END IF ELSE @@ -1084,7 +1084,7 @@ SUBROUTINE AllR8Ary3 ( Ary, AryDim1, AryDim2, AryDim3, Descr, ErrStat, ErrMsg ) IF ( ALLOCATED(Ary) ) THEN ! or Sttus=151 on IVF ErrMsg = 'Error allocating memory for the '//TRIM( Descr )//' array; array was already allocated.' ELSE - ErrMsg = 'Error allocating '//TRIM(Num2LStr(AryDim1*AryDim2*AryDim3*BYTES_IN_REAL))//& + ErrMsg = 'Error allocating '//TRIM(Num2LStr(AryDim1*AryDim2*AryDim3*BYTES_IN_R8Ki))//& ' bytes of memory for the '//TRIM( Descr )//' array.' END IF ELSE @@ -1122,7 +1122,7 @@ SUBROUTINE AllR4Ary4 ( Ary, AryDim1, AryDim2, AryDim3, AryDim4, Descr, ErrStat, IF ( ALLOCATED(Ary) ) THEN ! or Sttus=151 on IVF ErrMsg = 'Error allocating memory for the '//TRIM( Descr )//' array; array was already allocated.' ELSE - ErrMsg = 'Error allocating '//TRIM(Num2LStr(AryDim1*AryDim2*AryDim3*AryDim4*BYTES_IN_REAL))//& + ErrMsg = 'Error allocating '//TRIM(Num2LStr(AryDim1*AryDim2*AryDim3*AryDim4*BYTES_IN_R4Ki))//& ' bytes of memory for the '//TRIM( Descr )//' array.' END IF ELSE @@ -1160,7 +1160,7 @@ SUBROUTINE AllR8Ary4 ( Ary, AryDim1, AryDim2, AryDim3, AryDim4, Descr, ErrStat, IF ( ALLOCATED(Ary) ) THEN ! or Sttus=151 on IVF ErrMsg = 'Error allocating memory for the '//TRIM( Descr )//' array; array was already allocated.' ELSE - ErrMsg = 'Error allocating '//TRIM(Num2LStr(AryDim1*AryDim2*AryDim3*AryDim4*BYTES_IN_REAL))//& + ErrMsg = 'Error allocating '//TRIM(Num2LStr(AryDim1*AryDim2*AryDim3*AryDim4*BYTES_IN_R8Ki))//& ' bytes of memory for the '//TRIM( Descr )//' array.' END IF ELSE @@ -1199,7 +1199,7 @@ SUBROUTINE AllR4Ary5 ( Ary, AryDim1, AryDim2, AryDim3, AryDim4, AryDim5, Descr, IF ( ALLOCATED(Ary) ) THEN ! or Sttus=151 on IVF ErrMsg = 'Error allocating memory for the '//TRIM( Descr )//' array; array was already allocated.' ELSE - ErrMsg = 'Error allocating '//TRIM(Num2LStr(AryDim1*AryDim2*AryDim3*AryDim4*AryDim5*BYTES_IN_REAL))//& + ErrMsg = 'Error allocating '//TRIM(Num2LStr(AryDim1*AryDim2*AryDim3*AryDim4*AryDim5*BYTES_IN_R4Ki))//& ' bytes of memory for the '//TRIM( Descr )//' array.' END IF ELSE @@ -1240,7 +1240,7 @@ SUBROUTINE AllR8Ary5 ( Ary, AryDim1, AryDim2, AryDim3, AryDim4, AryDim5, Descr, IF ( ALLOCATED(Ary) ) THEN ! or Sttus=151 on IVF ErrMsg = 'Error allocating memory for the '//TRIM( Descr )//' array; array was already allocated.' ELSE - ErrMsg = 'Error allocating '//TRIM(Num2LStr(AryDim1*AryDim2*AryDim3*AryDim4*AryDim5*BYTES_IN_REAL))//& + ErrMsg = 'Error allocating '//TRIM(Num2LStr(AryDim1*AryDim2*AryDim3*AryDim4*AryDim5*BYTES_IN_R8Ki))//& ' bytes of memory for the '//TRIM( Descr )//' array.' END IF ELSE From 860cd6207697f51a953d152ef8a53af3e38b4496 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Tue, 2 Jan 2024 09:30:17 -0700 Subject: [PATCH 5/8] VTK fix: use existing `TowerDiam` instead of `TowerRad` --- modules/openfast-library/src/FAST_Subs.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index c453c93763..35b402a361 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -3974,7 +3974,7 @@ SUBROUTINE SetVTKParameters(p_FAST, InitOutData_ED, InitOutData_AD, InitInData_S IF ( p_FAST%CompAero == Module_AD .and. allocated(InitOutData_AD%rotors) .and. allocated(AD%y%rotors) ) THEN ! These meshes may have tower diameter data associated with nodes - UseADtwr = allocated(InitOutData_AD%rotors(1)%TowerRad) + UseADtwr = allocated(InitOutData_AD%rotors(1)%TwrDiam) ELSE UseADtwr = .false. END IF @@ -3984,7 +3984,7 @@ SUBROUTINE SetVTKParameters(p_FAST, InitOutData_ED, InitOutData_AD, InitInData_S ! This assumes a vertical tower (i.e., we deal only with z component of position) Indx = 1 do k=1,TowerMotionMesh%NNodes - p_FAST%VTK_Surface%TowerRad(k) = InterpStp( TowerMotionMesh%Position(3,k), AD%y%rotors(1)%TowerLoad%Position(3,:), InitOutData_AD%rotors(1)%TowerRad, Indx, AD%y%rotors(1)%TowerLoad%NNodes ) + p_FAST%VTK_Surface%TowerRad(k) = InterpStp( TowerMotionMesh%Position(3,k), AD%y%rotors(1)%TowerLoad%Position(3,:), InitOutData_AD%rotors(1)%TwrDiam, Indx, AD%y%rotors(1)%TowerLoad%NNodes ) / 2.0_ReKi end do else From ae10f784f0496854809ed0e8fd4a1e5981fd9d3a Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Thu, 11 Jan 2024 10:35:10 -0700 Subject: [PATCH 6/8] Fix typos in spelling `Boeing` --- modules/aerodyn/src/AirfoilInfo.f90 | 2 +- modules/aerodyn/src/UnsteadyAero.f90 | 8 ++++---- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/modules/aerodyn/src/AirfoilInfo.f90 b/modules/aerodyn/src/AirfoilInfo.f90 index 91cb0f02fa..1aa0aec4ea 100644 --- a/modules/aerodyn/src/AirfoilInfo.f90 +++ b/modules/aerodyn/src/AirfoilInfo.f90 @@ -424,7 +424,7 @@ SUBROUTINE ReadAFfile ( InitInp, NumCoefsIn, p, ErrStat, ErrMsg, UnEc ) RETURN END IF - ! RelThickness, default is 0.2 if user doesn't know it, only used for Boing-Vertol UA model = 7 + ! RelThickness, default is 0.2 if user doesn't know it, only used for Boeing-Vertol UA model = 7 CALL ParseVarWDefault ( FileInfo, CurLine, 'RelThickness', p%RelThickness, 0.2_ReKi, ErrStat2, ErrMsg2, UnEc ) if (ErrStat2 >= AbortErrLev) then ! if the line is missing, set RelThickness = -1 and move on... p%RelThickness=-1 ! To trigger an error diff --git a/modules/aerodyn/src/UnsteadyAero.f90 b/modules/aerodyn/src/UnsteadyAero.f90 index a0f2144368..268757ecd9 100644 --- a/modules/aerodyn/src/UnsteadyAero.f90 +++ b/modules/aerodyn/src/UnsteadyAero.f90 @@ -28,7 +28,7 @@ ! Development plan for the aerodynamic linearization in OpenFAST ! Unpublished ! -! [70] User Documentation / AeroDyn / Unsteady Aerodynamics / Boing-Vertol model +! [70] User Documentation / AeroDyn / Unsteady Aerodynamics / Boeing-Vertol model ! https://openfast.readthedocs.io/ ! ! [other] R. Damiani and G. Hayman (2017) @@ -1424,7 +1424,7 @@ subroutine UA_ValidateInput(InitInp, ErrStat, ErrMsg) if (InitInp%UAMod < UA_Gonzalez .or. InitInp%UAMod > UA_BV ) call SetErrStat( ErrID_Fatal, & "In this version, UAMod must be 2 (Gonzalez's variant), 3 (Minnema/Pierce variant), 4 (continuous HGM model), 5 (HGM with vortex), & - &6 (Oye), 7 (Boing-Vertol)", ErrStat, ErrMsg, RoutineName ) ! NOTE: for later- 1 (baseline/original) + &6 (Oye), 7 (Boeing-Vertol)", 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 ) @@ -1664,7 +1664,7 @@ subroutine UA_TurnOff_param(p, AFInfo, ErrStat, ErrMsg) end subroutine UA_TurnOff_param !============================================================================== -!> Update discrete states for Boieng Vertol model +!> Update discrete states for Boeing Vertol model subroutine UA_UpdateDiscOtherState_BV( i, j, u, p, xd, OtherState, AFInfo, m, ErrStat, ErrMsg ) integer , intent(in ) :: i !< node index within a blade integer , intent(in ) :: j !< blade index @@ -3756,7 +3756,7 @@ subroutine UA_CalcOutput( i, j, t, u_in, p, x, xd, OtherState, AFInfo, y, misc, #endif contains - !> Calc Outputs for Boieng-Vertol dynamic stall + !> Calc Outputs for Boeing-Vertol dynamic stall !! See BV_DynStall.f95 of CACTUS, and [70], notations kept more or less consistent subroutine BV_CalcOutput() real(ReKi) :: alpha_50 From 4a2a69741da07cdcf8a285f1b61f6469df3c0ef4 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Thu, 11 Jan 2024 17:16:05 -0700 Subject: [PATCH 7/8] Fix for OpenFAST/AD_InitOut variables --- modules/openfast-library/src/FAST_Subs.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 35b402a361..c809c0aa88 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -3984,7 +3984,7 @@ SUBROUTINE SetVTKParameters(p_FAST, InitOutData_ED, InitOutData_AD, InitInData_S ! This assumes a vertical tower (i.e., we deal only with z component of position) Indx = 1 do k=1,TowerMotionMesh%NNodes - p_FAST%VTK_Surface%TowerRad(k) = InterpStp( TowerMotionMesh%Position(3,k), AD%y%rotors(1)%TowerLoad%Position(3,:), InitOutData_AD%rotors(1)%TwrDiam, Indx, AD%y%rotors(1)%TowerLoad%NNodes ) / 2.0_ReKi + p_FAST%VTK_Surface%TowerRad(k) = InterpStp( TowerMotionMesh%Position(3,k), InitOutData_AD%rotors(1)%TwrElev, InitOutData_AD%rotors(1)%TwrDiam, Indx, size(InitOutData_AD%rotors(1)%TwrElev) ) / 2.0_ReKi end do else From d12034480b27c23ad0e239fbd83ec0184e2fb141 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Thu, 12 Jan 2023 15:46:17 -0700 Subject: [PATCH 8/8] Windows: Replace `system` calls with equivalent Fortran/C calls Fix intermittent failure of `system` commands on Windows: occasionally the system calls would fail to finish and make the program hang or end prematurely without any error message. --- modules/nwtc-library/src/SysIVF.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/modules/nwtc-library/src/SysIVF.f90 b/modules/nwtc-library/src/SysIVF.f90 index 603ad6da7e..2a6304dbdb 100644 --- a/modules/nwtc-library/src/SysIVF.f90 +++ b/modules/nwtc-library/src/SysIVF.f90 @@ -193,18 +193,18 @@ END SUBROUTINE Get_CWD !> This routine creates a given directory if it does not already exist. SUBROUTINE MKDIR ( new_directory_path ) + USE IFPORT, ONLY: MAKEDIRQQ implicit none character(*), intent(in) :: new_directory_path - character(1024) :: make_command logical :: directory_exists + logical :: success ! Check if the directory exists first inquire( directory=trim(new_directory_path), exist=directory_exists ) if ( .NOT. directory_exists ) then - make_command = 'mkdir "'//trim(new_directory_path)//'"' - call system( make_command ) + success = MAKEDIRQQ( trim(new_directory_path) ) endif END SUBROUTINE MKDIR