1! MBDyn (C) is a multibody analysis code.
2! http://www.mbdyn.org
3!
4! Copyright (C) 1996-2017
5!
6! Pierangelo Masarati	<masarati@aero.polimi.it>
7! Paolo Mantegazza	<mantegazza@aero.polimi.it>
8!
9! Dipartimento di Ingegneria Aerospaziale - Politecnico di Milano
10! via La Masa, 34 - 20156 Milano, Italy
11! http://www.aero.polimi.it
12!
13! Changing this copyright notice is forbidden.
14!
15! This program is free software; you can redistribute it and/or modify
16! it under the terms of the GNU General Public License as published by
17! the Free Software Foundation (version 2 of the License).
18!
19!
20! This program is distributed in the hope that it will be useful,
21! but WITHOUT ANY WARRANTY; without even the implied warranty of
22! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
23! GNU General Public License for more details.
24!
25! You should have received a copy of the GNU General Public License
26! along with this program; if not, write to the Free Software
27! Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
28!
29! Interface to NREL's AeroDyn library
30
31SUBROUTINE MBDyn_init( Version, NBlades, RotRadius )
32
33USE Identify
34USE Blade
35USE Wind  ! Use Global variable VX,VY,VZ.
36USE Precision
37
38
39IMPLICIT NONE
40
41CHARACTER(26) Version
42INTEGER(4) NBlades
43REAL(ReKi) RotRadius
44
45        DynProg = 'MBDyn '
46        DynVer = Version
47        Prog = ' '
48
49        CALL SetProgName
50
51        NB = NBlades
52
53        B = NB    ! Need this value when we swith on "WAKE"
54                  ! or "SWIRL" options
55        R = RotRadius
56        RETURN
57
58END SUBROUTINE MBDyn_init
59
60SUBROUTINE MBDyn_ad_inputgate( FileName, FileNameLen, ElemFileName, ElemFileNameLen, * )
61
62IMPLICIT NONE
63
64INTEGER(4) FileNameLen,ElemFileNameLen
65CHARACTER(FileNameLen) FileName
66CHARACTER(ElemFileNameLen) ElemFileName
67
68        !print *,'### FileName=',FileName(1:FileNameLen),' FileNameLen=',FileNameLen
69
70        !print *,'==> MBDyn_ad_inputgate(',FileName(1:FileNameLen),',',ElemFileName(1:ElemFileNameLen),')'
71
72        if (FileNameLen .gt. 0) then
73                CALL AD_inputgate(FileName)
74        else
75                CALL ADInputGate
76        endif
77
78        if (ElemFileNameLen .gt. 0) then
79                !CALL ElemOpen('./aerodyn.elm')
80                CALL ElemOpen(ElemFileName)
81        endif
82
83        !print *,'<== MBDyn_ad_inputgate(',FileName(1:FileNameLen),',',ElemFileName(1:ElemFileNameLen),')'
84
85        RETURN 0
86
87END SUBROUTINE MBDyn_ad_inputgate
88
89SUBROUTINE MBDyn_true( val )
90
91IMPLICIT NONE
92
93LOGICAL val
94
95        val = .TRUE.
96
97        RETURN
98
99END SUBROUTINE MBDyn_true
100
101SUBROUTINE MBDyn_false( val )
102
103IMPLICIT NONE
104
105LOGICAL val
106
107        val = .FALSE.
108
109        RETURN
110
111END SUBROUTINE MBDyn_false
112
113! This subroutine is to make MBDyn-AeroDyn interface function
114! can access the AeroDyn variables which was defined in the
115! common module. By Fanzhong MENG 21 Feb. 2008
116
117SUBROUTINE MBDyn_com_data( c_blade, c_elem )
118
119USE Identify
120USE Blade
121USE Element
122
123IMPLICIT NONE
124
125INTEGER(4) c_blade
126INTEGER(4) c_elem
127
128        IBlade = c_blade
129        JElem  = c_elem
130
131        RETURN
132END SUBROUTINE MBDyn_com_data
133
134! This subroutine is to pass the current simulation time
135! of MBDyn to AeroDyn!
136! c_time: current time
137
138SUBROUTINE MBDyn_sim_time(c_time)
139
140USE Identify
141USE Blade
142USE Element
143USE Precision
144USE AeroTime
145
146IMPLICIT NONE
147
148REAL(DbKi) c_time
149
150        TIME = c_time
151
152        RETURN
153END SUBROUTINE MBDyn_sim_time
154
155! This subroutine is to pass the current simulation time step
156! of MBDyn to AeroDyn!
157! dt: time step
158
159SUBROUTINE MBDyn_time_step(time_step)
160
161USE Identify
162USE Blade
163USE Element
164USE Precision
165USE AeroTime
166
167IMPLICIT NONE
168
169REAL(ReKi) time_step
170
171        DT = time_step
172
173        RETURN
174END SUBROUTINE MBDyn_time_step
175
176!Tip loss constants are calculated and stored.
177
178SUBROUTINE MBDyn_get_tl_const ( RLOCAL, Cur_elem )
179
180! AeroDyn Modules:
181
182USE               Blade
183USE               Element
184USE               Precision
185
186
187IMPLICIT          NONE
188
189
190! Passed Variables:
191
192REAL(4)         RLOCAL
193INTEGER(4)      Cur_elem
194
195
196! Local Variables:
197
198REAL(4)         DTIP
199!!! INTEGER(4)      IELM
200
201! Calculation of tip loss constants.
202
203! R = RLOCAL(NELM) + 0.5 * DR( NELM ) !* COS( PC )
204
205! Calculate the tip-loss constant for each element
206   DTIP           = R - RLOCAL
207   TLCNST( Cur_elem ) = 0.5 * B * DTIP / RLOCAL
208
209RETURN
210END SUBROUTINE MBDyn_get_tl_const
211
212
213
214
215!  Hub loss constants are calculated and stored.
216SUBROUTINE MBDyn_get_hl_const( RLOCAL, Cur_elem, RHub )
217
218! AeroDyn Modules:
219
220USE               Blade
221USE               Element
222USE               Precision
223
224
225IMPLICIT          NONE
226
227! Passed variables:
228
229REAL(4)        RLOCAL
230INTEGER(4)     Cur_elem
231REAL(4)        RHub
232
233! Local Variables:
234
235REAL(4)        DHUB
236!!! INTEGER(4)     IELM
237
238
239! Calculation of hub loss constants.
240
241! Calculate the hub-loss constant for each element
242IF (RHub > 0.001) THEN
243      DHUB           = RLOCAL - RHub
244      HLCNST( Cur_elem ) = 0.5 * B * DHUB / RHub
245ENDIF
246
247
248
249RETURN
250END SUBROUTINE MBDyn_get_hl_const
251
252