-
Notifications
You must be signed in to change notification settings - Fork 5
/
Copy pathUserWind.f90
executable file
·196 lines (136 loc) · 8.16 KB
/
UserWind.f90
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
MODULE UserWind
! The purpose of this module is to allow user-defined wind.
!----------------------------------------------------------------------------------------------------
USE NWTC_Library
USE SharedInflowDefns
IMPLICIT NONE
PRIVATE
! define variables for UserWind here
LOGICAL, SAVE :: Initialized = .FALSE. ! This variable indicates if the initialization routine has been run
REAL(ReKi) :: UWmeanU ! Possibly instantaneous, disk-averaged wind speeds.
REAL(ReKi) :: UWmeanV !
REAL(ReKi) :: UWmeanW !
! allow the initialization and termination routines to be public (called from outside)
PUBLIC :: UsrWnd_Init
PUBLIC :: UsrWnd_Terminate
PUBLIC :: UsrWnd_GetValue
PUBLIC :: UsrWnd_GetWindSpeed
CONTAINS
!====================================================================================================
SUBROUTINE UsrWnd_Init(ErrStat)
! This subroutine is called at the beginning of
!----------------------------------------------------------------------------------------------------
INTEGER, INTENT(OUT) :: ErrStat ! return 0 if no errors; non-zero otherwise
!-------------------------------------------------------------------------------------------------
! Check that the module hasn't already been initialized.
!-------------------------------------------------------------------------------------------------
IF ( Initialized ) THEN
CALL WrScr( ' UserWind has already been initialized.' )
ErrStat = 1
RETURN
ELSE
ErrStat = 0
CALL NWTC_Init()
END IF
!-------------------------------------------------------------------------------------------------
! Perform any initialization steps here (read input files, etc.)
!-------------------------------------------------------------------------------------------------
CALL WrScr( '***** NOTE: User-defined wind employed *****' )
! Set the disk-average wind vector.
UWmeanU = 10.0
UWmeanV = 0.0
UWmeanW = 0.0
!-------------------------------------------------------------------------------------------------
! Set the initialization flag
!-------------------------------------------------------------------------------------------------
Initialized = .TRUE.
RETURN
END SUBROUTINE UsrWnd_Init
!====================================================================================================
FUNCTION UsrWnd_GetValue(VarName, ErrStat)
! This function returns a real scalar value whose name is listed in the VarName input argument.
! If the name is not recognized, an error is returned in ErrStat.
!----------------------------------------------------------------------------------------------------
CHARACTER(*), INTENT(IN) :: VarName
INTEGER, INTENT(OUT) :: ErrStat ! return 0 if no errors; non-zero otherwise
REAL(ReKi) :: UsrWnd_GetValue
CHARACTER(20) :: VarNameUC ! upper-case VarName
!-------------------------------------------------------------------------------------------------
! Check that the module has been initialized.
!-------------------------------------------------------------------------------------------------
IF ( .NOT. Initialized ) THEN
CALL WrScr( 'Initialize UserWind before calling its subroutines.' )
ErrStat = 1
RETURN
ELSE
ErrStat = 0
END IF
!-------------------------------------------------------------------------------------------------
! Return the requested values.
!-------------------------------------------------------------------------------------------------
VarNameUC = VarName
CALL Conv2UC( VarNameUC )
SELECT CASE ( TRIM(VarNameUC) )
CASE ('MEANU' )
UsrWnd_GetValue = UWmeanU
CASE ('MEANV' )
UsrWnd_GetValue = UWmeanV
CASE ('MEANW' )
UsrWnd_GetValue = UWmeanW
CASE DEFAULT
CALL WrScr( ' Invalid variable name in UsrWnd_GetValue().' )
ErrStat = 1
END SELECT
END FUNCTION UsrWnd_GetValue
!====================================================================================================
FUNCTION UsrWnd_GetWindSpeed(Time, InputPosition, ErrStat)
! This function receives time and position (in InputInfo) where (undisturbed) velocities are
! requested. It returns the velocities at the specified time and space.
!----------------------------------------------------------------------------------------------------
REAL(ReKi), INTENT(IN) :: Time
REAL(ReKi), INTENT(IN) :: InputPosition(3) ! X,Y,Z (z is 0 at ground level)
INTEGER, INTENT(OUT):: ErrStat ! return 0 if no errors; non-zero otherwise
TYPE(InflIntrpOut) :: UsrWnd_GetWindSpeed
!-------------------------------------------------------------------------------------------------
! Check that the module has been initialized.
!-------------------------------------------------------------------------------------------------
IF ( .NOT. Initialized ) THEN
CALL WrScr( 'Initialize UserWind before calling its subroutines.' )
ErrStat = 1
RETURN
ELSE
ErrStat = 0
END IF
!-------------------------------------------------------------------------------------------------
! Calculate the wind speed at this time and position.
!-------------------------------------------------------------------------------------------------
! Time
! X = InputPosition(1) ! relative to the undeflected tower centerline (positive downwind)
! Y = InputPosition(2) ! relative to the undeflected tower centerline (positive left when looking downwind)
! Z = InputPosition(3) ! relative to the ground (0 is ground level)
!-------------------------------------------------------------------------------------------------
! We'll test this with steady winds for now.
UsrWnd_GetWindSpeed%Velocity(1) = 10.0 ! U velocity (along positive X)
UsrWnd_GetWindSpeed%Velocity(2) = 0.0 ! V velocity (along positive Y)
UsrWnd_GetWindSpeed%Velocity(3) = 0.0 ! V velocity (along positive Z)
END FUNCTION UsrWnd_GetWindSpeed
!====================================================================================================
SUBROUTINE UsrWnd_Terminate(ErrStat)
! This subroutine is called at the end of program execution (including after fatal errors occur).
! It should close any files that could be open and deallocate any arrays that have been allocated.
!----------------------------------------------------------------------------------------------------
INTEGER, INTENT(OUT) :: ErrStat ! return 0 if no errors; non-zero otherwise
ErrStat = 0
!-------------------------------------------------------------------------------------------------
! Close files
!-------------------------------------------------------------------------------------------------
!-------------------------------------------------------------------------------------------------
! Deallocate arrays
!-------------------------------------------------------------------------------------------------
!-------------------------------------------------------------------------------------------------
! Set the initialization flag
!-------------------------------------------------------------------------------------------------
Initialized = .FALSE.
END SUBROUTINE UsrWnd_Terminate
!====================================================================================================
END MODULE UserWind