Changeset 2152 for palm/trunk/SOURCE


Ignore:
Timestamp:
Feb 17, 2017 1:27:24 PM (7 years ago)
Author:
lvollmer
Message:

bugfix in wtm_read_blade_tables, Addition of a tip loss model

File:
1 edited

Legend:

Unmodified
Added
Removed
  • palm/trunk/SOURCE/wind_turbine_model_mod.f90

    r2101 r2152  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! Bugfix in subroutine wtm_read_blade_tables
     23! Addition of a tip loss model
    2324!
    2425! Former revisions:
     
    104105    LOGICAL ::  speed_control = .FALSE.   !< switch for use of speed controller
    105106    LOGICAL ::  yaw_control   = .FALSE.   !< switch for use of yaw controller
     107    LOGICAL ::  tl_cor        = .FALSE.    !< switch for use of tip loss correct.
    106108
    107109    REAL(wp) ::  segment_length  = 1.0_wp          !< length of the segments, the rotor area is divided into
     
    403405                                  slope2, speed_control, tilt, time_turbine_on,&
    404406                                  turb_cd_nacelle, turb_cd_tower,              &
    405                                   yaw_control, yaw_speed
     407                                  yaw_control, yaw_speed, tl_cor
    406408
    407409!
     
    11951197             ialpha = 1
    11961198
    1197              DO WHILE ( alpha_attack_i > alpha_attack_tab(ialpha) )
     1199             DO WHILE ( ( alpha_attack_i > alpha_attack_tab(ialpha) ) .AND. (ialpha <= dlen ) )
    11981200                ialpha = ialpha + 1
    11991201             ENDDO
     
    13691371       INTEGER(iwp), DIMENSION(1) :: lct=0
    13701372       REAL(wp), DIMENSION(1)     :: rad_d=0.0_wp
     1373       
     1374       REAL(wp) :: tl_factor !< factor for tip loss correction
    13711375
    13721376
     
    17971801                                        ( (2.0_wp*pi) / 360.0_wp )
    17981802
     1803                   IF ( tl_cor )  THEN
     1804                   
     1805!--                  Tip loss correction following Schito
     1806!--                  Schito applies the tip loss correction only to the lift force
     1807!--                  Therefore, the tip loss correction is only applied to the lift
     1808!--                  coefficient and not to the drag coefficient in our case
     1809!--                 
     1810                     tl_factor = ( 2.0 / pi ) *                                &
     1811                          ACOS( EXP( -1.0 * ( 3.0 * ( rr(inot) - cur_r ) /     &
     1812                          ( 2.0 * cur_r * abs( sin( phi_rel(rseg) ) ) ) ) ) )
     1813                         
     1814                     turb_cl(rseg)  = tl_factor * turb_cl(rseg)                                 
     1815                                 
     1816                   END IF               
    17991817!
    18001818!--                !-----------------------------------------------------!
     
    20902108             ENDDO ! End of loop over turbines
    20912109                           
    2092           END IF
     2110          END IF  ! end of yaw control
    20932111         
    20942112          IF ( speed_control )  THEN
Note: See TracChangeset for help on using the changeset viewer.