!        Generated by TAPENADE     (INRIA, Ecuador team)
!  Tapenade 3.14 (r7114) - 22 Oct 2018 09:36
!
!  Differentiation of porteagel_analyze in forward (tangent) mode:
!   variations   of useful results: wtvelocity
!   with respect to varying inputs: rotordiameter turbinez turbinexw
!                turbineyw yawdeg ct
!   RW status of diff variables: rotordiameter:in turbinez:in turbinexw:in
!                wtvelocity:out turbineyw:in yawdeg:in ct:in
! Implementation of the Bastankhah and Porte Agel gaussian-shaped wind turbine wake
! model (2016) with various farm modeling (TI and wake combination) methods included
! Created by Jared J. Thomas, 2017.
! FLight Optimization and Wind Laboratory (FLOW Lab)
! Brigham Young University
! implementation of the Bastankhah and Porte Agel (BPA) wake model for analysis
SUBROUTINE PORTEAGEL_ANALYZE_DV(nturbines, nrotorpoints, nctpoints, &
& turbinexw, turbinexwd, sorted_x_idx, turbineyw, turbineywd, turbinez, &
& turbinezd, rotordiameter, rotordiameterd, ct, ctd, wind_speed, yawdeg&
& , yawdegd, ky, kz, alpha, beta, ti, rotorpointsy, rotorpointsz, z_ref&
& , z_0, shear_exp, wake_combination_method, ti_calculation_method, &
& calc_k_star, opt_exp_fac, print_ti, wake_model_version, interp_type, &
& use_ct_curve, ct_curve_wind_speed, ct_curve_ct, sm_smoothing, &
& wtvelocity, wtvelocityd, nbdirs)
!  USE DIFFSIZES
!  Hint: nbdirs should be the maximum number of differentiation directions
  IMPLICIT NONE
!!  print TIturbs values to a file
!     if (print_ti) then
!         open(unit=2, file="TIturbs_tmp.txt")
!         do, turb=1, nTurbines
!             write(2,*) TIturbs(turb)
!         end do
!         close(2)
!     end if
!print *, "TIturbs: ", TIturbs
!print *, wtVelocity
!! make sure turbine inflow velocity is non-negative
!             if (wtVelocity(turbI) .lt. 0.0_dp) then
!                 wtVelocity(turbI) = 0.0_dp
!             end if
!print *, "fortran"
  INTRINSIC KIND
! define precision to be the standard for a double precision ! on local system
  INTEGER, PARAMETER :: dp=KIND(0.d0)
! in
  INTEGER, INTENT(IN) :: nturbines, nrotorpoints, nctpoints
  INTEGER, INTENT(IN) :: wake_combination_method, ti_calculation_method&
& , wake_model_version, interp_type
  LOGICAL, INTENT(IN) :: calc_k_star, print_ti, use_ct_curve
  REAL(dp), DIMENSION(nturbines), INTENT(IN) :: turbinexw, turbineyw, &
& turbinez
  REAL(dp), DIMENSION(nbdirs, nturbines), INTENT(IN) :: turbinexwd, &
& turbineywd, turbinezd
  INTEGER, DIMENSION(nturbines), INTENT(IN) :: sorted_x_idx
  REAL(dp), DIMENSION(nturbines), INTENT(IN) :: rotordiameter, yawdeg
  REAL(dp), DIMENSION(nbdirs, nturbines), INTENT(IN) :: &
& rotordiameterd, yawdegd
  REAL(dp), DIMENSION(nturbines) :: ct
  REAL(dp), DIMENSION(nbdirs, nturbines) :: ctd
  REAL(dp), INTENT(IN) :: ky, kz, alpha, beta, ti, wind_speed, z_ref, &
& z_0, shear_exp, opt_exp_fac
  REAL(dp), DIMENSION(nrotorpoints), INTENT(IN) :: rotorpointsy, &
& rotorpointsz
  REAL(dp), DIMENSION(nctpoints), INTENT(IN) :: ct_curve_wind_speed, &
& ct_curve_ct
  REAL(dp), INTENT(IN) :: sm_smoothing
! local (General)
  REAL(dp), DIMENSION(nturbines) :: yaw, titurbs, ct_local, ky_local, &
& kz_local
  REAL(dp), DIMENSION(nbdirs, nturbines) :: yawd, titurbsd, ct_locald&
& , ky_locald, kz_locald
  REAL(dp) :: x0, deltax0, deltay, theta_c_0, sigmay, sigmaz, &
& wake_offset, k_star
  REAL(dp), DIMENSION(nbdirs) :: x0d, deltax0d, deltayd, theta_c_0d, &
& sigmayd, sigmazd, wake_offsetd, k_stard
  REAL(dp) :: x, deltav, deltaz, sigmay_dp, sigmaz_dp, deltax0_dp, &
& deficit_sum
  REAL(dp), DIMENSION(nbdirs) :: xd, deltavd, deltazd, sigmay_dpd, &
& sigmaz_dpd, deltax0_dpd, deficit_sumd
  REAL(dp) :: tol, discontinuity_point, ti_area_ratio
  REAL(dp), DIMENSION(nbdirs) :: discontinuity_pointd, ti_area_ratiod
  REAL(dp) :: ti_area_ratio_tmp, ti_dst_tmp, ti_ust_tmp, rpts
  REAL(dp), DIMENSION(nbdirs) :: ti_area_ratio_tmpd, ti_dst_tmpd, &
& ti_ust_tmpd
  REAL(dp) :: localrotorpointy, localrotorpointz, point_velocity, &
& point_z, point_velocity_with_shear
  REAL(dp), DIMENSION(nbdirs) :: localrotorpointyd, localrotorpointzd&
& , point_velocityd, point_zd, point_velocity_with_sheard
  INTEGER :: u, d, turb, turbi, p
  REAL(dp), PARAMETER :: pi=3.141592653589793_dp
! model out
  REAL(dp), DIMENSION(nturbines), INTENT(OUT) :: wtvelocity
  REAL(dp), DIMENSION(nbdirs, nturbines), INTENT(OUT) :: wtvelocityd
  INTRINSIC SIN, COS, ATAN, MAX, SQRT, LOG
  INTRINSIC REAL
  INTEGER :: nd
  INTEGER :: nbdirs
  DO nd=1,nbdirs
! bastankhah and porte agel 2016 define yaw to be positive clockwise, this is reversed
    yawd(nd, :) = -(pi*yawdegd(nd, :)/180.0_dp)
    ct_locald(nd, :) = ctd(nd, :)
  END DO
  yaw = -(yawdeg*pi/180.0_dp)
! set tolerance for location checks
  tol = 0.1_dp
! initialize wind turbine velocities to 0.0
  wtvelocity = 0.0_dp
! initialize TI of all turbines to free-stream value
!print *, "start TIturbs: ", TIturbs
  titurbs = ti
! initialize the local wake factors
  ky_local(:) = ky
  kz_local(:) = kz
  ct_local(:) = ct
  wtvelocityd(:, :) = 0.0_8
  titurbsd(:, :) = 0.0_8
  kz_locald(:, :) = 0.0_8
  ky_locald(:, :) = 0.0_8
!print *, 'wake model version: ', wake_model_version
!print *, "ky_local: ", ky_local
!print *, "kz_local: ", kz_local
!print *, "TIturbs init: ", TIturbs
  DO d=1,nturbines
! get index of downstream turbine
    turbi = sorted_x_idx(d) + 1
    DO p=1,nrotorpoints
! initialize the TI_area_ratio to 0.0 for each turbine
      ti_area_ratio = 0.0_dp
! initialize deficit summation term to zero
      deficit_sum = 0.0_dp
      DO nd=1,nbdirs
! scale rotor sample point coordinate by rotor diameter (in rotor hub ref. frame)
        localrotorpointyd(nd) = rotorpointsy(p)*0.5_dp*rotordiameterd(nd&
&         , turbi)
        localrotorpointzd(nd) = rotorpointsz(p)*0.5_dp*rotordiameterd(nd&
&         , turbi)
      END DO
      localrotorpointy = rotorpointsy(p)*0.5_dp*rotordiameter(turbi)
      localrotorpointz = rotorpointsz(p)*0.5_dp*rotordiameter(turbi)
      deficit_sumd(:) = 0.0_8
      ti_area_ratiod(:) = 0.0_8
!             !print *, "rotorDiameter after local rotor points", rotorDiameter
!             !print *, "local rotor points Y,Z: ", LocalRotorPointY, LocalRotorPointZ
! at turbineX-locations
      DO u=1,nturbines
! get index of upstream turbine
        turb = sorted_x_idx(u) + 1
! skip this loop if turb = turbI (turbines impact on itself)
        IF (turb .NE. turbi) THEN
          DO nd=1,nbdirs
! downstream distance between upstream turbine and point
            xd(nd) = turbinexwd(nd, turbi) - turbinexwd(nd, turb) + &
&             localrotorpointyd(nd)*SIN(yaw(turbi)) + localrotorpointy*&
&             yawd(nd, turbi)*COS(yaw(turbi))
          END DO
          x = turbinexw(turbi) - turbinexw(turb) + localrotorpointy*SIN(&
&           yaw(turbi))
! set this iterations velocity deficit to 0
          deltav = 0.0_dp
! check turbine relative locations
          IF (x .GT. 0.0_dp + tol) THEN
!print *, "rotorDiameter before x0 ", rotorDiameter
! determine the onset location of far wake
            CALL X0_FUNC_DV(rotordiameter(turb), rotordiameterd(:, turb)&
&                     , yaw(turb), yawd(:, turb), ct_local(turb), &
&                     ct_locald(:, turb), alpha, titurbs(turb), titurbsd&
&                     (:, turb), beta, x0, x0d, nbdirs)
            DO nd=1,nbdirs
!                     call x0_func(rotorDiameter(turb), yaw(turb), Ct(turb), alpha, &
!                                 & TI, beta, x0)
! downstream distance from far wake onset to downstream turbine
              deltax0d(nd) = xd(nd) - x0d(nd)
            END DO
            deltax0 = x - x0
! calculate wake spreading parameter at each turbine if desired
            IF (calc_k_star .EQV. .true.) THEN
              CALL K_STAR_FUNC_DV(titurbs(turb), titurbsd(:, turb), &
&                           k_star, k_stard, nbdirs)
              DO nd=1,nbdirs
                ky_locald(nd, turb) = k_stard(nd)
                kz_locald(nd, turb) = k_stard(nd)
              END DO
              ky_local(turb) = k_star
              kz_local(turb) = k_star
            END IF
!print *, "ky_local ", ky_local
!print *, "deltax0 ", deltax0
!print *, "turbineZ ", turbineZ
!print *, "rotorDiameter after x0 ", rotorDiameter
!print *, "Ct ", Ct
!print *, "yaw ", yaw
! determine the initial wake angle at the onset of far wake
            CALL THETA_C_0_FUNC_DV(yaw(turb), yawd(:, turb), ct_local(&
&                            turb), ct_locald(:, turb), theta_c_0, &
&                            theta_c_0d, nbdirs)
!print *, "theta_c_0 ", theta_c_0
! horizontal spread
            CALL SIGMAY_FUNC_DV(ky_local(turb), ky_locald(:, turb), &
&                         deltax0, deltax0d, rotordiameter(turb), &
&                         rotordiameterd(:, turb), yaw(turb), yawd(:, &
&                         turb), sigmay, sigmayd, nbdirs)
!print *, "sigmay ", sigmay
!print *, "rotorDiameter after sigmay", rotorDiameter
! vertical spread
            CALL SIGMAZ_FUNC_DV(kz_local(turb), kz_locald(:, turb), &
&                         deltax0, deltax0d, rotordiameter(turb), &
&                         rotordiameterd(:, turb), sigmaz, sigmazd, &
&                         nbdirs)
!print *, "sigmaz ", sigmaz
!print *, "rotorDiameter after sigmaz ", rotorDiameter
! horizontal cross-wind wake displacement from hub
            CALL WAKE_OFFSET_FUNC_DV(rotordiameter(turb), rotordiameterd&
&                              (:, turb), theta_c_0, theta_c_0d, x0, x0d&
&                              , yaw(turb), yawd(:, turb), ky_local(turb&
&                              ), ky_locald(:, turb), kz_local(turb), &
&                              kz_locald(:, turb), ct_local(turb), &
&                              ct_locald(:, turb), sigmay, sigmayd, &
&                              sigmaz, sigmazd, wake_offset, &
&                              wake_offsetd, nbdirs)
            DO nd=1,nbdirs
!print *, "wake_offset ", wake_offset
! cross wind distance from downstream point location to wake center
              deltayd(nd) = localrotorpointyd(nd)*COS(yaw(turbi)) - &
&               localrotorpointy*yawd(nd, turbi)*SIN(yaw(turbi)) + &
&               turbineywd(nd, turbi) - turbineywd(nd, turb) - &
&               wake_offsetd(nd)
! cross wind distance from hub height to height of point of interest
              deltazd(nd) = localrotorpointzd(nd) + turbinezd(nd, turbi)&
&               - turbinezd(nd, turb)
            END DO
            deltay = localrotorpointy*COS(yaw(turbi)) + turbineyw(turbi)&
&             - (turbineyw(turb)+wake_offset)
            deltaz = localrotorpointz + turbinez(turbi) - turbinez(turb)
!print *, "dx, dy, dz: ", x, deltay, deltaz
!print *, "local y,z : ", LocalRotorPointY, LocalRotorPointZ, turb, turbI, p
!print *, deltaz, deltay
! far wake region
! find the final point where the original model is undefined
            CALL DISCONTINUITY_POINT_FUNC_DV(x0, x0d, rotordiameter(turb&
&                                      ), rotordiameterd(:, turb), &
&                                      ky_local(turb), ky_locald(:, turb&
&                                      ), kz_local(turb), kz_locald(:, &
&                                      turb), yaw(turb), yawd(:, turb), &
&                                      ct_local(turb), ct_locald(:, turb&
&                                      ), discontinuity_point, &
&                                      discontinuity_pointd, nbdirs)
            IF (x .GT. discontinuity_point) THEN
!print *, x
! velocity difference in the wake
              CALL DELTAV_FUNC_DV(deltay, deltayd, deltaz, deltazd, &
&                           ct_local(turb), ct_locald(:, turb), yaw(turb&
&                           ), yawd(:, turb), sigmay, sigmayd, sigmaz, &
&                           sigmazd, rotordiameter(turb), rotordiameterd&
&                           (:, turb), wake_model_version, kz_local(turb&
&                           ), kz_locald(:, turb), x, xd, opt_exp_fac, &
&                           deltav, deltavd, nbdirs)
!print *, "rotorDiameter after far deltav ", rotorDiameter
! near wake region (linearized)
            ELSE
              DO nd=1,nbdirs
! determine distance from discontinuity point to far wake onset
                deltax0_dpd(nd) = discontinuity_pointd(nd) - x0d(nd)
              END DO
              deltax0_dp = discontinuity_point - x0
! horizontal spread at far wake onset
              CALL SIGMAY_FUNC_DV(ky_local(turb), ky_locald(:, turb), &
&                           deltax0_dp, deltax0_dpd, rotordiameter(turb)&
&                           , rotordiameterd(:, turb), yaw(turb), yawd(:&
&                           , turb), sigmay_dp, sigmay_dpd, nbdirs)
! vertical spread at far wake onset
              CALL SIGMAZ_FUNC_DV(kz_local(turb), kz_locald(:, turb), &
&                           deltax0_dp, deltax0_dpd, rotordiameter(turb)&
&                           , rotordiameterd(:, turb), sigmaz_dp, &
&                           sigmaz_dpd, nbdirs)
!  print *, "inputs in parent: ", deltay, deltaz, Ct(turb), yaw(turb), sigmay_dp, sigmaz_dp, &
!                                          & rotorDiameter(turb), x, discontinuity_point, sigmay_dp, sigmaz_dp, &
!                                          & wake_model_version, kz_local, x0, &
!                                          & opt_exp_fac
! velocity deficit in the nearwake (linear model)
              CALL DELTAV_NEAR_WAKE_LIN_FUNC_DV(deltay, deltayd, deltaz&
&                                         , deltazd, ct_local(turb), &
&                                         ct_locald(:, turb), yaw(turb)&
&                                         , yawd(:, turb), sigmay_dp, &
&                                         sigmay_dpd, sigmaz_dp, &
&                                         sigmaz_dpd, rotordiameter(turb&
&                                         ), rotordiameterd(:, turb), x&
&                                         , xd, discontinuity_point, &
&                                         discontinuity_pointd, &
&                                         sigmay_dp, sigmay_dpd, &
&                                         sigmaz_dp, sigmaz_dpd, &
&                                         wake_model_version, kz_local(&
&                                         turb), kz_locald(:, turb), x0&
&                                         , x0d, opt_exp_fac, deltav, &
&                                         deltavd, nbdirs)
!print *, "rotorDiameter after deltav near ", rotorDiameter
            END IF
! combine deficits according to selected method wake combination method
            CALL WAKE_COMBINATION_FUNC_DV(wind_speed, wtvelocity(turb), &
&                                   wtvelocityd(:, turb), deltav, &
&                                   deltavd, wake_combination_method, &
&                                   deficit_sum, deficit_sumd, nbdirs)
            IF (x .GT. 0.0_dp .AND. ti_calculation_method .GT. 0) THEN
              DO nd=1,nbdirs
!print *, "turbI, turb: ", turbI, turb
! calculate TI value at each turbine
!                         print *, "turb, turbI: ", turb, turbI
! save ti_area_ratio and ti_dst to new memory locations to avoid
! aliasing during differentiation
                ti_area_ratio_tmpd(nd) = ti_area_ratiod(nd)
                ti_dst_tmpd(nd) = titurbsd(nd, turbi)
                ti_ust_tmpd(nd) = titurbsd(nd, turb)
              END DO
              ti_area_ratio_tmp = ti_area_ratio
              ti_dst_tmp = titurbs(turbi)
              ti_ust_tmp = titurbs(turb)
              CALL ADDED_TI_FUNC_DV(ti, ct_local(turb), ct_locald(:, &
&                             turb), x, xd, ky_local(turb), ky_locald(:&
&                             , turb), rotordiameter(turb), &
&                             rotordiameterd(:, turb), rotordiameter(&
&                             turbi), rotordiameterd(:, turbi), deltay, &
&                             deltayd, turbinez(turb), turbinezd(:, turb&
&                             ), turbinez(turbi), turbinezd(:, turbi), &
&                             sm_smoothing, ti_ust_tmp, ti_ust_tmpd, &
&                             ti_calculation_method, ti_area_ratio_tmp, &
&                             ti_area_ratio_tmpd, ti_dst_tmp, &
&                             ti_dst_tmpd, ti_area_ratio, ti_area_ratiod&
&                             , titurbs(turbi), titurbsd(:, turbi), &
&                             nbdirs)
!print *, "rotorDiameter after TI calcs", rotorDiameter
            END IF
          END IF
        END IF
      END DO
      DO nd=1,nbdirs
!                     !print *, "deficit_sum, turbI, p, turb: ", deficit_sum, turbI, p, turb
! print *, deficit_sum
! find velocity at point p due to the wake of turbine turb
        point_velocityd(nd) = -deficit_sumd(nd)
!print *, "point velocity, deficit_sum, turbI, p: ", point_velocity, deficit_sum, turbI, p
! put sample point height in global reference frame
        point_zd(nd) = localrotorpointzd(nd) + turbinezd(nd, turbi)
      END DO
      point_velocity = wind_speed - deficit_sum
      point_z = localrotorpointz + turbinez(turbi)
!print *, "point_z, turbI, p: ", point_z, turbI, p
! adjust sample point velocity for shear
      CALL WIND_SHEAR_FUNC_DV(point_z, point_zd, point_velocity, &
&                       point_velocityd, z_ref, z_0, shear_exp, &
&                       point_velocity_with_shear, &
&                       point_velocity_with_sheard, nbdirs)
      DO nd=1,nbdirs
!print *, "v, vs, x, turb, turbI, p: ", point_velocity, point_velocity_with_shear, x, turb, turbI, p
! add sample point velocity to turbine velocity to be averaged later
        wtvelocityd(nd, turbi) = wtvelocityd(nd, turbi) + &
&         point_velocity_with_sheard(nd)
      END DO
      wtvelocity(turbi) = wtvelocity(turbi) + point_velocity_with_shear
    END DO
! final velocity calculation for turbine turbI (average equally across all points)
    rpts = REAL(nrotorpoints, dp)
    DO nd=1,nbdirs
!         print *, rpts, nRotorPoints, wtVelocity(turbI), wtVelocity(turbI)/rpts, wtVelocity(turbI)/nRotorPoints
!         STOP 1
      wtvelocityd(nd, turbi) = wtvelocityd(nd, turbi)/rpts
    END DO
    wtvelocity(turbi) = wtvelocity(turbi)/rpts
!         print *, wtVelocity(turbI)
    IF (use_ct_curve) CALL INTERPOLATION_DV(nctpoints, interp_type, &
&                                     ct_curve_wind_speed, ct_curve_ct, &
&                                     wtvelocity(turbi), wtvelocityd(:, &
&                                     turbi), ct_local(turbi), ct_locald&
&                                     (:, turbi), 0.0_dp, 0.0_dp, &
&                                     .false., nbdirs)
  END DO
END SUBROUTINE PORTEAGEL_ANALYZE_DV

!  Differentiation of x0_func in forward (tangent) mode:
!   variations   of useful results: x0
!   with respect to varying inputs: ti yaw rotor_diameter ct
! calculates the onset of far-wake conditions
SUBROUTINE X0_FUNC_DV(rotor_diameter, rotor_diameterd, yaw, yawd, ct, &
& ctd, alpha, ti, tid, beta, x0, x0d, nbdirs)
!  USE DIFFSIZES
!  Hint: nbdirs should be the maximum number of differentiation directions
  IMPLICIT NONE
  INTRINSIC KIND
! define precision to be the standard for a double precision ! on local system
  INTEGER, PARAMETER :: dp=KIND(0.d0)
! in
  REAL(dp), INTENT(IN) :: rotor_diameter, yaw, ct, alpha, ti, beta
  REAL(dp), DIMENSION(nbdirs), INTENT(IN) :: rotor_diameterd, yawd, &
& ctd, tid
! out
  REAL(dp), INTENT(OUT) :: x0
  REAL(dp), DIMENSION(nbdirs), INTENT(OUT) :: x0d
  INTRINSIC COS, SQRT
  REAL(dp) :: result1
  REAL(dp), DIMENSION(nbdirs) :: result1d
  REAL(dp) :: result2
  REAL(dp) :: result3
  REAL(dp), DIMENSION(nbdirs) :: result3d
  INTEGER :: nd
  INTEGER :: nbdirs
  result1 = SQRT(1.0_dp - ct)
  result2 = SQRT(2.0_dp)
  result3 = SQRT(1.0_dp - ct)
  DO nd=1,nbdirs
! determine the onset location of far wake
    result1d(nd) = -(ctd(nd)/(2.0*SQRT(1.0_dp-ct)))
    result3d(nd) = -(ctd(nd)/(2.0*SQRT(1.0_dp-ct)))
    x0d(nd) = rotor_diameterd(nd)*COS(yaw)*(1.0_dp+result1)/(result2*(&
&     alpha*ti+beta*(1.0_dp-result3))) + rotor_diameter*((COS(yaw)*&
&     result1d(nd)-yawd(nd)*SIN(yaw)*(1.0_dp+result1))*result2*(alpha*ti&
&     +beta*(1.0_dp-result3))-COS(yaw)*(1.0_dp+result1)*result2*(alpha*&
&     tid(nd)-beta*result3d(nd)))/(result2**2*(alpha*ti+beta*(1.0_dp-&
&     result3))**2)
  END DO
  x0 = rotor_diameter*(COS(yaw)*(1.0_dp+result1)/(result2*(alpha*ti+beta&
&   *(1.0_dp-result3))))
END SUBROUTINE X0_FUNC_DV

!  Differentiation of theta_c_0_func in forward (tangent) mode:
!   variations   of useful results: theta_c_0
!   with respect to varying inputs: yaw ct
! calculates the wake angle at the onset of far wake conditions
SUBROUTINE THETA_C_0_FUNC_DV(yaw, yawd, ct, ctd, theta_c_0, theta_c_0d, &
& nbdirs)
!  USE DIFFSIZES
!  Hint: nbdirs should be the maximum number of differentiation directions
  IMPLICIT NONE
  INTRINSIC KIND
! define precision to be the standard for a double precision ! on local system
  INTEGER, PARAMETER :: dp=KIND(0.d0)
! in
  REAL(dp), INTENT(IN) :: yaw, ct
  REAL(dp), DIMENSION(nbdirs), INTENT(IN) :: yawd, ctd
! out
  REAL(dp), INTENT(OUT) :: theta_c_0
  REAL(dp), DIMENSION(nbdirs), INTENT(OUT) :: theta_c_0d
  INTRINSIC COS, SQRT
  REAL(dp) :: arg1
  REAL(dp), DIMENSION(nbdirs) :: arg1d
  REAL(dp) :: result1
  REAL(dp), DIMENSION(nbdirs) :: result1d
  INTEGER :: nd
  INTEGER :: nbdirs
  arg1 = 1.0_dp - ct*COS(yaw)
  result1 = SQRT(arg1)
  DO nd=1,nbdirs
! determine the initial wake angle at the onset of far wake
    arg1d(nd) = ct*yawd(nd)*SIN(yaw) - ctd(nd)*COS(yaw)
    IF (arg1 .EQ. 0.0) THEN
      result1d(nd) = 0.0_8
    ELSE
      result1d(nd) = arg1d(nd)/(2.0*SQRT(arg1))
    END IF
    theta_c_0d(nd) = (0.3_dp*(yawd(nd)*(1.0_dp-result1)-yaw*result1d(nd)&
&     )*COS(yaw)+0.3_dp*yaw*(1.0_dp-result1)*yawd(nd)*SIN(yaw))/COS(yaw)&
&     **2
  END DO
  theta_c_0 = 0.3_dp*yaw*(1.0_dp-result1)/COS(yaw)
END SUBROUTINE THETA_C_0_FUNC_DV

!  Differentiation of sigmay_func in forward (tangent) mode:
!   variations   of useful results: sigmay
!   with respect to varying inputs: yaw ky rotor_diameter deltax0
! calculates the horizontal spread of the wake at a given distance from the onset of far
! wake condition
SUBROUTINE SIGMAY_FUNC_DV(ky, kyd, deltax0, deltax0d, rotor_diameter, &
& rotor_diameterd, yaw, yawd, sigmay, sigmayd, nbdirs)
!  USE DIFFSIZES
!  Hint: nbdirs should be the maximum number of differentiation directions
  IMPLICIT NONE
  INTRINSIC KIND
! define precision to be the standard for a double precision on local system
  INTEGER, PARAMETER :: dp=KIND(0.d0)
! in
  REAL(dp), INTENT(IN) :: ky, deltax0, rotor_diameter, yaw
  REAL(dp), DIMENSION(nbdirs), INTENT(IN) :: kyd, deltax0d, &
& rotor_diameterd, yawd
! out
  REAL(dp), INTENT(OUT) :: sigmay
  REAL(dp), DIMENSION(nbdirs), INTENT(OUT) :: sigmayd
  INTRINSIC COS, SQRT
  REAL(dp) :: result1
  INTEGER :: nd
  INTEGER :: nbdirs
! horizontal spread
  result1 = SQRT(8.0_dp)
  DO nd=1,nbdirs
    sigmayd(nd) = rotor_diameterd(nd)*(ky*deltax0/rotor_diameter+COS(yaw&
&     )/result1) + rotor_diameter*(((kyd(nd)*deltax0+ky*deltax0d(nd))*&
&     rotor_diameter-ky*deltax0*rotor_diameterd(nd))/rotor_diameter**2+(&
&     -(yawd(nd)*SIN(yaw)))/result1)
  END DO
  sigmay = rotor_diameter*(ky*deltax0/rotor_diameter+COS(yaw)/result1)
END SUBROUTINE SIGMAY_FUNC_DV

!  Differentiation of sigmaz_func in forward (tangent) mode:
!   variations   of useful results: sigmaz
!   with respect to varying inputs: kz rotor_diameter deltax0
! calculates the vertical spread of the wake at a given distance from the onset of far
! wake condition
SUBROUTINE SIGMAZ_FUNC_DV(kz, kzd, deltax0, deltax0d, rotor_diameter, &
& rotor_diameterd, sigmaz, sigmazd, nbdirs)
!  USE DIFFSIZES
!  Hint: nbdirs should be the maximum number of differentiation directions
  IMPLICIT NONE
  INTRINSIC KIND
! define precision to be the standard for a double precision ! on local system
  INTEGER, PARAMETER :: dp=KIND(0.d0)
! in
  REAL(dp), INTENT(IN) :: kz, deltax0, rotor_diameter
  REAL(dp), DIMENSION(nbdirs), INTENT(IN) :: kzd, deltax0d, &
& rotor_diameterd
! out
  REAL(dp), INTENT(OUT) :: sigmaz
  REAL(dp), DIMENSION(nbdirs), INTENT(OUT) :: sigmazd
! load necessary intrinsic functions
  INTRINSIC SQRT
  REAL(dp) :: result1
  INTEGER :: nd
  INTEGER :: nbdirs
! vertical spread
  result1 = SQRT(8.0_dp)
  DO nd=1,nbdirs
    sigmazd(nd) = rotor_diameterd(nd)*(kz*deltax0/rotor_diameter+1.0_dp/&
&     result1) + ((kzd(nd)*deltax0+kz*deltax0d(nd))*rotor_diameter-kz*&
&     deltax0*rotor_diameterd(nd))/rotor_diameter
  END DO
  sigmaz = rotor_diameter*(kz*deltax0/rotor_diameter+1.0_dp/result1)
END SUBROUTINE SIGMAZ_FUNC_DV

!  Differentiation of wake_offset_func in forward (tangent) mode:
!   variations   of useful results: wake_offset
!   with respect to varying inputs: theta_c_0 yaw sigmay sigmaz
!                ky kz rotor_diameter x0 ct
! calculates the horizontal distance from the wake center to the hub of the turbine making
! the wake
SUBROUTINE WAKE_OFFSET_FUNC_DV(rotor_diameter, rotor_diameterd, &
& theta_c_0, theta_c_0d, x0, x0d, yaw, yawd, ky, kyd, kz, kzd, ct, ctd, &
& sigmay, sigmayd, sigmaz, sigmazd, wake_offset, wake_offsetd, nbdirs)
!  USE DIFFSIZES
!  Hint: nbdirs should be the maximum number of differentiation directions
  IMPLICIT NONE
  INTRINSIC KIND
! define precision to be the standard for a double precision ! on local system
  INTEGER, PARAMETER :: dp=KIND(0.d0)
! in
  REAL(dp), INTENT(IN) :: rotor_diameter, theta_c_0, x0, yaw, ky, kz, ct&
& , sigmay
  REAL(dp), DIMENSION(nbdirs), INTENT(IN) :: rotor_diameterd, &
& theta_c_0d, x0d, yawd, kyd, kzd, ctd, sigmayd
  REAL(dp), INTENT(IN) :: sigmaz
  REAL(dp), DIMENSION(nbdirs), INTENT(IN) :: sigmazd
! out
  REAL(dp), INTENT(OUT) :: wake_offset
  REAL(dp), DIMENSION(nbdirs), INTENT(OUT) :: wake_offsetd
  INTRINSIC COS, SQRT, LOG
  REAL(dp) :: arg1
  REAL(dp), DIMENSION(nbdirs) :: arg1d
  REAL(dp) :: result1
  REAL(dp), DIMENSION(nbdirs) :: result1d
  REAL(dp) :: result2
  REAL(dp), DIMENSION(nbdirs) :: result2d
  REAL(dp) :: result3
  REAL(dp), DIMENSION(nbdirs) :: result3d
  REAL(dp) :: arg2
  REAL(dp), DIMENSION(nbdirs) :: arg2d
  REAL(dp) :: result4
  REAL(dp), DIMENSION(nbdirs) :: result4d
  REAL(dp) :: result5
  REAL(dp), DIMENSION(nbdirs) :: result5d
  REAL(dp) :: result6
  REAL(dp), DIMENSION(nbdirs) :: result6d
  REAL(dp) :: arg3
  REAL(dp), DIMENSION(nbdirs) :: arg3d
  REAL(dp) :: result7
  REAL(dp), DIMENSION(nbdirs) :: result7d
  REAL(dp) :: result8
  REAL(dp), DIMENSION(nbdirs) :: result8d
  REAL(dp) :: arg4
  REAL(dp), DIMENSION(nbdirs) :: arg4d
  INTEGER :: nd
  INTEGER :: nbdirs
  arg1 = COS(yaw)/(ky*kz*ct)
  result1 = SQRT(arg1)
  result2 = SQRT(1.0_dp - ct)
  result3 = SQRT(ct)
  arg2 = 8.0_dp*sigmay*sigmaz/(COS(yaw)*rotor_diameter**2)
  result4 = SQRT(arg2)
  result5 = SQRT(ct)
  result6 = SQRT(ct)
  arg3 = 8.0_dp*sigmay*sigmaz/(COS(yaw)*rotor_diameter**2)
  result7 = SQRT(arg3)
  result8 = SQRT(ct)
  arg4 = (1.6_dp+result3)*(1.6_dp*result4-result5)/((1.6_dp-result6)*(&
&   1.6_dp*result7+result8))
  DO nd=1,nbdirs
! horizontal cross-wind wake displacement from hub
    arg1d(nd) = (-(yawd(nd)*SIN(yaw)*ky*kz*ct)-COS(yaw)*((kyd(nd)*kz+ky*&
&     kzd(nd))*ct+ky*kz*ctd(nd)))/(ky*kz*ct)**2
    IF (arg1 .EQ. 0.0) THEN
      result1d(nd) = 0.0_8
    ELSE
      result1d(nd) = arg1d(nd)/(2.0*SQRT(arg1))
    END IF
    result2d(nd) = -(ctd(nd)/(2.0*SQRT(1.0_dp-ct)))
    IF (ct .EQ. 0.0) THEN
      result3d(nd) = 0.0_8
    ELSE
      result3d(nd) = ctd(nd)/(2.0*SQRT(ct))
    END IF
    arg2d(nd) = (8.0_dp*(sigmayd(nd)*sigmaz+sigmay*sigmazd(nd))*COS(yaw)&
&     *rotor_diameter**2-8.0_dp*sigmay*sigmaz*(COS(yaw)*2*rotor_diameter&
&     *rotor_diameterd(nd)-yawd(nd)*SIN(yaw)*rotor_diameter**2))/(COS(&
&     yaw)*rotor_diameter**2)**2
    IF (arg2 .EQ. 0.0) THEN
      result4d(nd) = 0.0_8
    ELSE
      result4d(nd) = arg2d(nd)/(2.0*SQRT(arg2))
    END IF
    IF (ct .EQ. 0.0) THEN
      result5d(nd) = 0.0_8
    ELSE
      result5d(nd) = ctd(nd)/(2.0*SQRT(ct))
    END IF
    IF (ct .EQ. 0.0) THEN
      result6d(nd) = 0.0_8
    ELSE
      result6d(nd) = ctd(nd)/(2.0*SQRT(ct))
    END IF
    arg3d(nd) = (8.0_dp*(sigmayd(nd)*sigmaz+sigmay*sigmazd(nd))*COS(yaw)&
&     *rotor_diameter**2-8.0_dp*sigmay*sigmaz*(COS(yaw)*2*rotor_diameter&
&     *rotor_diameterd(nd)-yawd(nd)*SIN(yaw)*rotor_diameter**2))/(COS(&
&     yaw)*rotor_diameter**2)**2
    IF (arg3 .EQ. 0.0) THEN
      result7d(nd) = 0.0_8
    ELSE
      result7d(nd) = arg3d(nd)/(2.0*SQRT(arg3))
    END IF
    IF (ct .EQ. 0.0) THEN
      result8d(nd) = 0.0_8
    ELSE
      result8d(nd) = ctd(nd)/(2.0*SQRT(ct))
    END IF
    arg4d(nd) = ((result3d(nd)*(1.6_dp*result4-result5)+(1.6_dp+result3)&
&     *(1.6_dp*result4d(nd)-result5d(nd)))*(1.6_dp-result6)*(1.6_dp*&
&     result7+result8)-(1.6_dp+result3)*(1.6_dp*result4-result5)*((&
&     1.6_dp-result6)*(1.6_dp*result7d(nd)+result8d(nd))-result6d(nd)*(&
&     1.6_dp*result7+result8)))/((1.6_dp-result6)*(1.6_dp*result7+&
&     result8))**2
    wake_offsetd(nd) = rotor_diameterd(nd)*(theta_c_0*x0/rotor_diameter+&
&     theta_c_0/14.7_dp*result1*(2.9_dp+1.3_dp*result2-ct)*LOG(arg4)) + &
&     rotor_diameter*(((theta_c_0d(nd)*x0+theta_c_0*x0d(nd))*&
&     rotor_diameter-theta_c_0*x0*rotor_diameterd(nd))/rotor_diameter**2&
&     +((theta_c_0d(nd)*result1/14.7_dp+theta_c_0*result1d(nd)/14.7_dp)*&
&     (2.9_dp+1.3_dp*result2-ct)+theta_c_0*result1*(1.3_dp*result2d(nd)-&
&     ctd(nd))/14.7_dp)*LOG(arg4)+theta_c_0*result1*(2.9_dp+1.3_dp*&
&     result2-ct)*arg4d(nd)/(14.7_dp*arg4))
  END DO
  wake_offset = rotor_diameter*(theta_c_0*x0/rotor_diameter+theta_c_0/&
&   14.7_dp*result1*(2.9_dp+1.3_dp*result2-ct)*LOG(arg4))
END SUBROUTINE WAKE_OFFSET_FUNC_DV

!  Differentiation of deltav_func in forward (tangent) mode:
!   variations   of useful results: deltav
!   with respect to varying inputs: k yaw rotor_diameter_ust sigmay
!                sigmaz deltax deltay deltaz ct
! calculates the velocity difference between hub velocity and free stream for a given wake
! for use in the far wake region
SUBROUTINE DELTAV_FUNC_DV(deltay, deltayd, deltaz, deltazd, ct, ctd, yaw&
& , yawd, sigmay, sigmayd, sigmaz, sigmazd, rotor_diameter_ust, &
& rotor_diameter_ustd, version, k, kd, deltax, deltaxd, opt_exp_fac, &
& deltav, deltavd, nbdirs)
!  USE DIFFSIZES
!  Hint: nbdirs should be the maximum number of differentiation directions
  IMPLICIT NONE
!print *, "rotor_diameter in deltav exit", rotor_diameter_ust
  INTRINSIC KIND
! define precision to be the standard for a double precision ! on local system
  INTEGER, PARAMETER :: dp=KIND(0.d0)
! in
  REAL(dp), INTENT(IN) :: deltay, deltaz, ct, yaw, sigmay
  REAL(dp), DIMENSION(nbdirs), INTENT(IN) :: deltayd, deltazd, ctd, &
& yawd, sigmayd
  REAL(dp), INTENT(IN) :: sigmaz, rotor_diameter_ust, opt_exp_fac
  REAL(dp), DIMENSION(nbdirs), INTENT(IN) :: sigmazd, &
& rotor_diameter_ustd
! only for 2014 version
  REAL(dp), INTENT(IN) :: k, deltax
  REAL(dp), DIMENSION(nbdirs), INTENT(IN) :: kd, deltaxd
  INTEGER, INTENT(IN) :: version
! local
! only for 2014 version
  REAL(dp) :: beta_2014, epsilon_2014
  REAL(dp), DIMENSION(nbdirs) :: beta_2014d, epsilon_2014d
! out
  REAL(dp), INTENT(OUT) :: deltav
  REAL(dp), DIMENSION(nbdirs), INTENT(OUT) :: deltavd
! load intrinsic functions
  INTRINSIC COS, SQRT, EXP
  REAL(dp) :: result1
  REAL(dp), DIMENSION(nbdirs) :: result1d
  REAL(dp) :: result2
  REAL(dp), DIMENSION(nbdirs) :: result2d
  REAL(dp) :: arg1
  REAL(dp), DIMENSION(nbdirs) :: arg1d
  REAL(dp) :: arg2
  REAL(dp), DIMENSION(nbdirs) :: arg2d
  REAL(dp) :: arg3
  REAL(dp), DIMENSION(nbdirs) :: arg3d
  INTEGER :: nd
  INTEGER :: nbdirs
!print *, "rotor_diameter in deltav entry", rotor_diameter_ust
!     print *, 'wake model version in deltav: ', version
  IF (version .EQ. 2014) THEN
    result1 = SQRT(1.0_dp - ct)
    result2 = SQRT(1.0_dp - ct)
    beta_2014 = 0.5_dp*(1.0_dp+result1)/result2
    DO nd=1,nbdirs
!print *, "in 2014 version"
      result1d(nd) = -(ctd(nd)/(2.0*SQRT(1.0_dp-ct)))
      result2d(nd) = -(ctd(nd)/(2.0*SQRT(1.0_dp-ct)))
      beta_2014d(nd) = (0.5_dp*result1d(nd)*result2-0.5_dp*(1.0_dp+&
&       result1)*result2d(nd))/result2**2
      IF (beta_2014 .EQ. 0.0) THEN
        result1d(nd) = 0.0_8
      ELSE
        result1d(nd) = beta_2014d(nd)/(2.0*SQRT(beta_2014))
      END IF
      epsilon_2014d(nd) = 0.2_dp*result1d(nd)
    END DO
    result1 = SQRT(beta_2014)
    epsilon_2014 = 0.2_dp*result1
    arg1 = 1.0_dp - ct/(8.0_dp*(k*deltax/rotor_diameter_ust+epsilon_2014&
&     )**2)
    result1 = SQRT(arg1)
    arg2 = (-(1.0_dp/(2.0_dp*(k*deltax/rotor_diameter_ust+epsilon_2014)&
&     **2)))*((deltaz/(opt_exp_fac*rotor_diameter_ust))**2+(deltay/(&
&     opt_exp_fac*rotor_diameter_ust))**2)
    DO nd=1,nbdirs
! print *, "beta = ", beta_2014, "epsilon = ", epsilon_2014
! print *, "k, deltax: ", k, deltax
! print *, "term: ", Ct                                                   &
!                            / (8.0_dp * (k*deltax/rotor_diameter_ust+epsilon_2014)**2)
      arg1d(nd) = -((ctd(nd)*8.0_dp*(k*deltax/rotor_diameter_ust+&
&       epsilon_2014)**2-ct*8.0_dp*2*(k*deltax/rotor_diameter_ust+&
&       epsilon_2014)*(((kd(nd)*deltax+k*deltaxd(nd))*rotor_diameter_ust&
&       -k*deltax*rotor_diameter_ustd(nd))/rotor_diameter_ust**2+&
&       epsilon_2014d(nd)))/(8.0_dp*(k*deltax/rotor_diameter_ust+&
&       epsilon_2014)**2)**2)
      IF (arg1 .EQ. 0.0) THEN
        result1d(nd) = 0.0_8
      ELSE
        result1d(nd) = arg1d(nd)/(2.0*SQRT(arg1))
      END IF
      arg2d(nd) = 2*(((kd(nd)*deltax+k*deltaxd(nd))*rotor_diameter_ust-k&
&       *deltax*rotor_diameter_ustd(nd))/rotor_diameter_ust**2+&
&       epsilon_2014d(nd))*((deltaz/(opt_exp_fac*rotor_diameter_ust))**2&
&       +(deltay/(opt_exp_fac*rotor_diameter_ust))**2)/(2.0_dp*(k*deltax&
&       /rotor_diameter_ust+epsilon_2014)**3) - (2*deltaz*(deltazd(nd)*&
&       opt_exp_fac*rotor_diameter_ust-deltaz*opt_exp_fac*&
&       rotor_diameter_ustd(nd))/(opt_exp_fac**3*rotor_diameter_ust**3)+&
&       2*deltay*(deltayd(nd)*opt_exp_fac*rotor_diameter_ust-deltay*&
&       opt_exp_fac*rotor_diameter_ustd(nd))/(opt_exp_fac**3*&
&       rotor_diameter_ust**3))/(2.0_dp*(k*deltax/rotor_diameter_ust+&
&       epsilon_2014)**2)
      deltavd(nd) = (1.0_dp-result1)*arg2d(nd)*EXP(arg2) - result1d(nd)*&
&       EXP(arg2)
    END DO
    deltav = (1.0_dp-result1)*EXP(arg2)
! print *, "deltav 2014 = ", deltav
  ELSE IF (version .EQ. 2016) THEN
    arg1 = 1.0_dp - ct*COS(yaw)/(8.0_dp*sigmay*sigmaz/rotor_diameter_ust&
&     **2)
    result1 = SQRT(arg1)
    arg2 = -(0.5_dp*(deltay/(opt_exp_fac*sigmay))**2)
    arg3 = -(0.5_dp*(deltaz/(opt_exp_fac*sigmaz))**2)
    DO nd=1,nbdirs
! velocity difference in the wake at each sample point
      arg1d(nd) = -(((ctd(nd)*COS(yaw)-ct*yawd(nd)*SIN(yaw))*8.0_dp*&
&       sigmay*sigmaz/rotor_diameter_ust**2-ct*COS(yaw)*(8.0_dp*(sigmayd&
&       (nd)*sigmaz+sigmay*sigmazd(nd))*rotor_diameter_ust**2-8.0_dp*&
&       sigmay*sigmaz*2*rotor_diameter_ust*rotor_diameter_ustd(nd))/&
&       rotor_diameter_ust**4)/(8.0_dp*sigmay*sigmaz/rotor_diameter_ust&
&       **2)**2)
      IF (arg1 .EQ. 0.0) THEN
        result1d(nd) = 0.0_8
      ELSE
        result1d(nd) = arg1d(nd)/(2.0*SQRT(arg1))
      END IF
      arg2d(nd) = -(0.5_dp*2*deltay*(deltayd(nd)*opt_exp_fac*sigmay-&
&       deltay*opt_exp_fac*sigmayd(nd))/(opt_exp_fac**3*sigmay**3))
      arg3d(nd) = -(0.5_dp*2*deltaz*(deltazd(nd)*opt_exp_fac*sigmaz-&
&       deltaz*opt_exp_fac*sigmazd(nd))/(opt_exp_fac**3*sigmaz**3))
      deltavd(nd) = ((1.0_dp-result1)*arg2d(nd)*EXP(arg2)-result1d(nd)*&
&       EXP(arg2))*EXP(arg3) + (1.0_dp-result1)*EXP(arg2)*arg3d(nd)*EXP(&
&       arg3)
    END DO
    deltav = (1.0_dp-result1)*EXP(arg2)*EXP(arg3)
  ELSE
    PRINT*, 'Invalid Bastankhah and Porte Agel model version. Must be 20&
&14 or 2016. ', version, ' was given.'
    STOP
  END IF
END SUBROUTINE DELTAV_FUNC_DV

!  Differentiation of deltav_near_wake_lin_func in forward (tangent) mode:
!   variations   of useful results: deltav
!   with respect to varying inputs: k yaw discontinuity_point x
!                rotor_diameter_ust sigmay sigmaz deltax0_dp deltay
!                deltaz sigmay0 ct sigmaz0
! calculates the velocity difference between hub velocity and free stream for a given wake
! for use in the near wake region only
SUBROUTINE DELTAV_NEAR_WAKE_LIN_FUNC_DV(deltay, deltayd, deltaz, deltazd&
& , ct, ctd, yaw, yawd, sigmay, sigmayd, sigmaz, sigmazd, &
& rotor_diameter_ust, rotor_diameter_ustd, x, xd, discontinuity_point, &
& discontinuity_pointd, sigmay0, sigmay0d, sigmaz0, sigmaz0d, version, k&
& , kd, deltax0_dp, deltax0_dpd, opt_exp_fac, deltav, deltavd, nbdirs)
!  USE DIFFSIZES
!  Hint: nbdirs should be the maximum number of differentiation directions
  IMPLICIT NONE
  INTRINSIC KIND
! define precision to be the standard for a double precision ! on local system
  INTEGER, PARAMETER :: dp=KIND(0.d0)
! in
  REAL(dp), INTENT(IN) :: deltay, deltaz, ct, yaw, sigmay
  REAL(dp), DIMENSION(nbdirs), INTENT(IN) :: deltayd, deltazd, ctd, &
& yawd, sigmayd
  REAL(dp), INTENT(IN) :: sigmaz, rotor_diameter_ust, opt_exp_fac
  REAL(dp), DIMENSION(nbdirs), INTENT(IN) :: sigmazd, &
& rotor_diameter_ustd
  REAL(dp), INTENT(IN) :: x, discontinuity_point, sigmay0, sigmaz0
  REAL(dp), DIMENSION(nbdirs), INTENT(IN) :: xd, discontinuity_pointd&
& , sigmay0d, sigmaz0d
! only for 2014 version
  REAL(dp), INTENT(IN) :: k, deltax0_dp
  REAL(dp), DIMENSION(nbdirs), INTENT(IN) :: kd, deltax0_dpd
  INTEGER, INTENT(IN) :: version
! local
  REAL(dp) :: deltav0m, deltavr
  REAL(dp), DIMENSION(nbdirs) :: deltav0md, deltavrd
! only for 2014 version
  REAL(dp) :: beta_2014, epsilon_2014
  REAL(dp), DIMENSION(nbdirs) :: beta_2014d, epsilon_2014d
! out
  REAL(dp), INTENT(OUT) :: deltav
  REAL(dp), DIMENSION(nbdirs), INTENT(OUT) :: deltavd
! load intrinsic functions
  INTRINSIC COS, SQRT, EXP
  REAL(dp) :: result1
  REAL(dp), DIMENSION(nbdirs) :: result1d
  REAL(dp) :: result2
  REAL(dp), DIMENSION(nbdirs) :: result2d
  REAL(dp) :: arg1
  REAL(dp), DIMENSION(nbdirs) :: arg1d
  REAL(dp) :: arg2
  REAL(dp), DIMENSION(nbdirs) :: arg2d
  INTEGER :: nd
  INTEGER :: nbdirs
!  print *, 'wake model version in deltav near wake: ', version
!     print *, "inputs: ", deltay, deltaz, Ct, yaw,  &
!                                  & sigmay, sigmaz, rotor_diameter_ust, x, &
!                                  & discontinuity_point, sigmay0, sigmaz0, version, k, &
!                                  & deltax0_dp, opt_exp_fac
  IF (version .EQ. 2014) THEN
    IF (yaw .GT. 0.0_dp) THEN
      PRINT*, 'model version 2014 may only be used when yaw=0'
      STOP
    ELSE
      result1 = SQRT(1.0_dp - ct)
      result2 = SQRT(1.0_dp - ct)
      beta_2014 = 0.5_dp*(1.0_dp+result1)/result2
      DO nd=1,nbdirs
        result1d(nd) = -(ctd(nd)/(2.0*SQRT(1.0_dp-ct)))
        result2d(nd) = -(ctd(nd)/(2.0*SQRT(1.0_dp-ct)))
        beta_2014d(nd) = (0.5_dp*result1d(nd)*result2-0.5_dp*(1.0_dp+&
&         result1)*result2d(nd))/result2**2
        IF (beta_2014 .EQ. 0.0) THEN
          result1d(nd) = 0.0_8
        ELSE
          result1d(nd) = beta_2014d(nd)/(2.0*SQRT(beta_2014))
        END IF
        epsilon_2014d(nd) = 0.2_dp*result1d(nd)
      END DO
      result1 = SQRT(beta_2014)
      epsilon_2014 = 0.2_dp*result1
      arg1 = 1.0_dp - ct/(8.0_dp*(k*deltax0_dp/rotor_diameter_ust+&
&       epsilon_2014)**2)
      DO nd=1,nbdirs
! magnitude term of gaussian at x0
        arg1d(nd) = -((ctd(nd)*8.0_dp*(k*deltax0_dp/rotor_diameter_ust+&
&         epsilon_2014)**2-ct*8.0_dp*2*(k*deltax0_dp/rotor_diameter_ust+&
&         epsilon_2014)*(((kd(nd)*deltax0_dp+k*deltax0_dpd(nd))*&
&         rotor_diameter_ust-k*deltax0_dp*rotor_diameter_ustd(nd))/&
&         rotor_diameter_ust**2+epsilon_2014d(nd)))/(8.0_dp*(k*&
&         deltax0_dp/rotor_diameter_ust+epsilon_2014)**2)**2)
        IF (arg1 .EQ. 0.0) THEN
          result1d(nd) = 0.0_8
        ELSE
          result1d(nd) = arg1d(nd)/(2.0*SQRT(arg1))
        END IF
        deltav0md(nd) = -result1d(nd)
! initialize the gaussian magnitude term at the rotor for the linear interpolation
        deltavrd(nd) = deltav0md(nd)
! linearized gaussian magnitude term for near wake
        arg1d(nd) = 2*(((kd(nd)*deltax0_dp+k*deltax0_dpd(nd))*&
&         rotor_diameter_ust-k*deltax0_dp*rotor_diameter_ustd(nd))/&
&         rotor_diameter_ust**2+epsilon_2014d(nd))*((deltaz/(opt_exp_fac&
&         *rotor_diameter_ust))**2+(deltay/(opt_exp_fac*&
&         rotor_diameter_ust))**2)/(2.0_dp*(k*deltax0_dp/&
&         rotor_diameter_ust+epsilon_2014)**3) - (2*deltaz*(deltazd(nd)*&
&         opt_exp_fac*rotor_diameter_ust-deltaz*opt_exp_fac*&
&         rotor_diameter_ustd(nd))/(opt_exp_fac**3*rotor_diameter_ust**3&
&         )+2*deltay*(deltayd(nd)*opt_exp_fac*rotor_diameter_ust-deltay*&
&         opt_exp_fac*rotor_diameter_ustd(nd))/(opt_exp_fac**3*&
&         rotor_diameter_ust**3))/(2.0_dp*(k*deltax0_dp/&
&         rotor_diameter_ust+epsilon_2014)**2)
      END DO
      result1 = SQRT(arg1)
      deltav0m = 1.0_dp - result1
      deltavr = deltav0m
      arg1 = (-(1.0_dp/(2.0_dp*(k*deltax0_dp/rotor_diameter_ust+&
&       epsilon_2014)**2)))*((deltaz/(opt_exp_fac*rotor_diameter_ust))**&
&       2+(deltay/(opt_exp_fac*rotor_diameter_ust))**2)
      DO nd=1,nbdirs
        deltavd(nd) = (((deltav0md(nd)-deltavrd(nd))*discontinuity_point&
&         -(deltav0m-deltavr)*discontinuity_pointd(nd))*x/&
&         discontinuity_point**2+(deltav0m-deltavr)*xd(nd)/&
&         discontinuity_point+deltavrd(nd))*EXP(arg1) + ((deltav0m-&
&         deltavr)/discontinuity_point*x+deltavr)*arg1d(nd)*EXP(arg1)
      END DO
      deltav = ((deltav0m-deltavr)/discontinuity_point*x+deltavr)*EXP(&
&       arg1)
    END IF
  ELSE IF (version .EQ. 2016) THEN
    arg1 = 1.0_dp - ct*COS(yaw)/(8.0_dp*sigmay0*sigmaz0/&
&     rotor_diameter_ust**2)
    DO nd=1,nbdirs
! magnitude term of gaussian at x0
      arg1d(nd) = -(((ctd(nd)*COS(yaw)-ct*yawd(nd)*SIN(yaw))*8.0_dp*&
&       sigmay0*sigmaz0/rotor_diameter_ust**2-ct*COS(yaw)*(8.0_dp*(&
&       sigmay0d(nd)*sigmaz0+sigmay0*sigmaz0d(nd))*rotor_diameter_ust**2&
&       -8.0_dp*sigmay0*sigmaz0*2*rotor_diameter_ust*rotor_diameter_ustd&
&       (nd))/rotor_diameter_ust**4)/(8.0_dp*sigmay0*sigmaz0/&
&       rotor_diameter_ust**2)**2)
      IF (arg1 .EQ. 0.0) THEN
        result1d(nd) = 0.0_8
      ELSE
        result1d(nd) = arg1d(nd)/(2.0*SQRT(arg1))
      END IF
      deltav0md(nd) = -result1d(nd)
! initialize the gaussian magnitude term at the rotor for the linear interpolation
      deltavrd(nd) = deltav0md(nd)
! linearized gaussian magnitude term for near wake
      arg1d(nd) = -(0.5_dp*2*deltay*(deltayd(nd)*opt_exp_fac*sigmay-&
&       deltay*opt_exp_fac*sigmayd(nd))/(opt_exp_fac**3*sigmay**3))
      arg2d(nd) = -(0.5_dp*2*deltaz*(deltazd(nd)*opt_exp_fac*sigmaz-&
&       deltaz*opt_exp_fac*sigmazd(nd))/(opt_exp_fac**3*sigmaz**3))
    END DO
    result1 = SQRT(arg1)
    deltav0m = 1.0_dp - result1
    deltavr = deltav0m
    arg1 = -(0.5_dp*(deltay/(opt_exp_fac*sigmay))**2)
    arg2 = -(0.5_dp*(deltaz/(opt_exp_fac*sigmaz))**2)
    DO nd=1,nbdirs
      deltavd(nd) = ((((deltav0md(nd)-deltavrd(nd))*discontinuity_point-&
&       (deltav0m-deltavr)*discontinuity_pointd(nd))*x/&
&       discontinuity_point**2+(deltav0m-deltavr)*xd(nd)/&
&       discontinuity_point+deltavrd(nd))*EXP(arg1)+((deltav0m-deltavr)/&
&       discontinuity_point*x+deltavr)*arg1d(nd)*EXP(arg1))*EXP(arg2) + &
&       ((deltav0m-deltavr)/discontinuity_point*x+deltavr)*EXP(arg1)*&
&       arg2d(nd)*EXP(arg2)
    END DO
    deltav = ((deltav0m-deltavr)/discontinuity_point*x+deltavr)*EXP(arg1&
&     )*EXP(arg2)
  ELSE
    PRINT*, 'Invalid Bastankhah and Porte Agel model version. Must be 20&
&14 or 2016. ', version, ' was given.'
    STOP
  END IF
END SUBROUTINE DELTAV_NEAR_WAKE_LIN_FUNC_DV

!  Differentiation of wake_combination_func in forward (tangent) mode:
!   variations   of useful results: deficit_sum
!   with respect to varying inputs: turb_inflow deficit_sum deltav
! combines wakes using various methods
SUBROUTINE WAKE_COMBINATION_FUNC_DV(wind_speed, turb_inflow, &
& turb_inflowd, deltav, deltavd, wake_combination_method, deficit_sum, &
& deficit_sumd, nbdirs)
!  USE DIFFSIZES
!  Hint: nbdirs should be the maximum number of differentiation directions
  IMPLICIT NONE
  INTRINSIC KIND
! define precision to be the standard for a double precision ! on local system
  INTEGER, PARAMETER :: dp=KIND(0.d0)
! in
  REAL(dp), INTENT(IN) :: wind_speed, turb_inflow, deltav
  REAL(dp), DIMENSION(nbdirs), INTENT(IN) :: turb_inflowd, deltavd
  INTEGER, INTENT(IN) :: wake_combination_method
! out
  REAL(dp), INTENT(INOUT) :: deficit_sum
  REAL(dp), DIMENSION(nbdirs), INTENT(INOUT) :: deficit_sumd
! intrinsic functions
  INTRINSIC SQRT
  REAL(dp) :: arg1
  REAL(dp), DIMENSION(nbdirs) :: arg1d
  INTEGER :: nd
  INTEGER :: nbdirs
! freestream linear superposition (Lissaman 1979)
  IF (wake_combination_method .EQ. 0) THEN
    DO nd=1,nbdirs
      deficit_sumd(nd) = deficit_sumd(nd) + wind_speed*deltavd(nd)
    END DO
    deficit_sum = deficit_sum + wind_speed*deltav
! local velocity linear superposition (Niayifar and Porte Agel 2015, 2016)
  ELSE IF (wake_combination_method .EQ. 1) THEN
    DO nd=1,nbdirs
      deficit_sumd(nd) = deficit_sumd(nd) + turb_inflowd(nd)*deltav + &
&       turb_inflow*deltavd(nd)
    END DO
    deficit_sum = deficit_sum + turb_inflow*deltav
!print *, "here"
! sum of squares freestream superposition (Katic et al. 1986)
  ELSE IF (wake_combination_method .EQ. 2) THEN
    arg1 = deficit_sum**2 + (wind_speed*deltav)**2
    DO nd=1,nbdirs
      arg1d(nd) = 2*deficit_sum*deficit_sumd(nd) + 2*wind_speed**2*&
&       deltav*deltavd(nd)
      IF (arg1 .EQ. 0.0) THEN
        deficit_sumd(nd) = 0.0_8
      ELSE
        deficit_sumd(nd) = arg1d(nd)/(2.0*SQRT(arg1))
      END IF
    END DO
    deficit_sum = SQRT(arg1)
! sum of squares local velocity superposition (Voutsinas 1990)
  ELSE IF (wake_combination_method .EQ. 3) THEN
    arg1 = deficit_sum**2 + (turb_inflow*deltav)**2
    DO nd=1,nbdirs
      arg1d(nd) = 2*deficit_sum*deficit_sumd(nd) + 2*turb_inflow*deltav*&
&       (turb_inflowd(nd)*deltav+turb_inflow*deltavd(nd))
      IF (arg1 .EQ. 0.0) THEN
        deficit_sumd(nd) = 0.0_8
      ELSE
        deficit_sumd(nd) = arg1d(nd)/(2.0*SQRT(arg1))
      END IF
    END DO
    deficit_sum = SQRT(arg1)
! wake combination method error
  ELSE
    PRINT*, 'Invalid wake combination method. Must be one of [0,1,2,3].'
    STOP
  END IF
END SUBROUTINE WAKE_COMBINATION_FUNC_DV

!  Differentiation of added_ti_func in forward (tangent) mode:
!   variations   of useful results: ti_dst ti_area_ratio
!   with respect to varying inputs: k_star_ust x rotor_diameter_ust
!                wake_height turbine_height ti_dst_in ct_ust deltay
!                ti_area_ratio_in rotor_diameter_dst ti_ust
! combines wakes using various methods
SUBROUTINE ADDED_TI_FUNC_DV(ti, ct_ust, ct_ustd, x, xd, k_star_ust, &
& k_star_ustd, rotor_diameter_ust, rotor_diameter_ustd, &
& rotor_diameter_dst, rotor_diameter_dstd, deltay, deltayd, wake_height&
& , wake_heightd, turbine_height, turbine_heightd, sm_smoothing, ti_ust&
& , ti_ustd, ti_calculation_method, ti_area_ratio_in, ti_area_ratio_ind&
& , ti_dst_in, ti_dst_ind, ti_area_ratio, ti_area_ratiod, ti_dst, &
& ti_dstd, nbdirs)
!  USE DIFFSIZES
!  Hint: nbdirs should be the maximum number of differentiation directions
  IMPLICIT NONE
!print *, "ratio: ", wake_overlap/rotor_area_dst
!print *, "Dr, Dw: ", rotor_diameter_dst, wake_diameter
!print *, "Ar, Aol: ", rotor_area_dst, wake_overlap
  INTRINSIC KIND
! define precision to be the standard for a double precision ! on local system
  INTEGER, PARAMETER :: dp=KIND(0.d0)
! in
  REAL(dp), INTENT(IN) :: ct_ust, x, k_star_ust, rotor_diameter_ust, &
& rotor_diameter_dst
  REAL(dp), DIMENSION(nbdirs), INTENT(IN) :: ct_ustd, xd, k_star_ustd&
& , rotor_diameter_ustd, rotor_diameter_dstd
  REAL(dp), INTENT(IN) :: deltay, wake_height, turbine_height, &
& sm_smoothing
  REAL(dp), DIMENSION(nbdirs), INTENT(IN) :: deltayd, wake_heightd, &
& turbine_heightd
  REAL(dp), INTENT(IN) :: ti_ust, ti, ti_area_ratio_in, ti_dst_in
  REAL(dp), DIMENSION(nbdirs), INTENT(IN) :: ti_ustd, &
& ti_area_ratio_ind, ti_dst_ind
  INTEGER, INTENT(IN) :: ti_calculation_method
! local
  REAL(dp) :: axial_induction_ust, beta, epsilon, sigma, wake_diameter, &
& wake_overlap
  REAL(dp), DIMENSION(nbdirs) :: axial_induction_ustd, betad, &
& epsilond, sigmad, wake_diameterd, wake_overlapd
  REAL(dp) :: ti_added, ti_tmp, rotor_area_dst, ti_area_ratio_tmp
  REAL(dp), DIMENSION(nbdirs) :: ti_addedd, ti_tmpd, rotor_area_dstd&
& , ti_area_ratio_tmpd
  REAL(dp), PARAMETER :: pi=3.141592653589793_dp
! out
  REAL(dp), INTENT(OUT) :: ti_dst, ti_area_ratio
  REAL(dp), DIMENSION(nbdirs), INTENT(OUT) :: ti_dstd, ti_area_ratiod
! intrinsic functions
  INTRINSIC SQRT
  REAL(dp) :: result1
  REAL(dp), DIMENSION(nbdirs) :: result1d
  REAL(dp) :: result2
  REAL(dp), DIMENSION(nbdirs) :: result2d
  REAL(dp) :: pwx1
  REAL(dp), DIMENSION(nbdirs) :: pwx1d
  REAL(dp) :: pwr1
  REAL(dp), DIMENSION(nbdirs) :: pwr1d
  REAL(dp) :: arg1
  REAL(dp), DIMENSION(nbdirs) :: arg1d
  INTEGER :: nd
  INTEGER :: nbdirs
  DO nd=1,nbdirs
! initialize output variables
    ti_area_ratiod(nd) = ti_area_ratio_ind(nd)
    ti_dstd(nd) = ti_dst_ind(nd)
  END DO
  ti_area_ratio = ti_area_ratio_in
  ti_dst = ti_dst_in
! initialize wake overlap to zero
  wake_overlap = 0.0_dp
!print *, "TI_dst in: ", TI_dst
! Niayifar and Porte Agel 2015, 2016 (adjusted by Annoni and Thomas for SOWFA match
! and optimization)
  IF (ti_calculation_method .EQ. 1) THEN
! calculate axial induction based on the Ct value
    CALL CT_TO_AXIAL_IND_FUNC_DV(ct_ust, ct_ustd, axial_induction_ust, &
&                          axial_induction_ustd, nbdirs)
    result1 = SQRT(1.0_dp - ct_ust)
    result2 = SQRT(1.0_dp - ct_ust)
    beta = 0.5_dp*((1.0_dp+result1)/result2)
    pwx1 = x/rotor_diameter_ust
    pwr1 = pwx1**(-0.32_dp)
    DO nd=1,nbdirs
! calculate BPA spread parameters Bastankhah and Porte Agel 2014
      result1d(nd) = -(ct_ustd(nd)/(2.0*SQRT(1.0_dp-ct_ust)))
      result2d(nd) = -(ct_ustd(nd)/(2.0*SQRT(1.0_dp-ct_ust)))
      betad(nd) = 0.5_dp*(result1d(nd)*result2-(1.0_dp+result1)*result2d&
&       (nd))/result2**2
      IF (beta .EQ. 0.0) THEN
        result1d(nd) = 0.0_8
      ELSE
        result1d(nd) = betad(nd)/(2.0*SQRT(beta))
      END IF
      epsilond(nd) = 0.2_dp*result1d(nd)
!print *, "wake_overlap = ", wake_overlap
! Calculate the turbulence added to the inflow of the downstream turbine by the
! wake of the upstream turbine
      pwx1d(nd) = (xd(nd)*rotor_diameter_ust-x*rotor_diameter_ustd(nd))/&
&       rotor_diameter_ust**2
      IF (pwx1 .GT. 0.0) THEN
        pwr1d(nd) = -(0.32_dp*pwx1**(-1.32)*pwx1d(nd))
      ELSE
        pwr1d(nd) = 0.0
      END IF
      ti_addedd(nd) = 0.73_dp*((0.8325_dp*axial_induction_ust**(-0.1675)&
&       *axial_induction_ustd(nd)*pwr1+axial_induction_ust**0.8325_dp*&
&       pwr1d(nd))*ti_ust**0.0325_dp+axial_induction_ust**0.8325_dp*pwr1&
&       *0.0325_dp*ti_ust**(-0.9675)*ti_ustd(nd))
!print *, "TI_added = ", TI_added
      rotor_area_dstd(nd) = 0.25_dp*pi*2_dp*rotor_diameter_dst*&
&       rotor_diameter_dstd(nd)
    END DO
    result1 = SQRT(beta)
    epsilon = 0.2_dp*result1
    DO nd=1,nbdirs
!print *, "epsilon = ", epsilon
! calculate wake spread for TI calcs
      sigmad(nd) = k_star_ustd(nd)*x + k_star_ust*xd(nd) + &
&       rotor_diameter_ustd(nd)*epsilon + rotor_diameter_ust*epsilond(nd&
&       )
      wake_diameterd(nd) = 4.0_dp*sigmad(nd)
    END DO
    sigma = k_star_ust*x + rotor_diameter_ust*epsilon
    wake_diameter = 4.0_dp*sigma
!print *, "sigma = ", sigma
! calculate wake overlap ratio
    CALL OVERLAP_AREA_FUNC_DV(deltay, deltayd, turbine_height, &
&                       turbine_heightd, rotor_diameter_dst, &
&                       rotor_diameter_dstd, 0.0_dp, wake_height, &
&                       wake_heightd, wake_diameter, wake_diameterd, &
&                       wake_overlap, wake_overlapd, nbdirs)
    ti_added = 0.73_dp*axial_induction_ust**0.8325_dp*ti_ust**0.0325_dp*&
&     pwr1
    rotor_area_dst = 0.25_dp*pi*rotor_diameter_dst**2_dp
    arg1 = ti_dst_in**2.0_dp + (ti_added*wake_overlap/rotor_area_dst)**&
&     2.0_dp
    DO nd=1,nbdirs
! Calculate the total turbulence intensity at the downstream turbine
!sum_of_squares = TI_dst**2 + (TI_added*wake_overlap)**2
! print *, "sum of squares = ", sum_of_squares
!         TI_dst = sqrt(sum_of_squares)
!         !print *, "TI_dst = ", TI_dst
      arg1d(nd) = 2.0_dp*ti_dst_in*ti_dst_ind(nd) + 2.0_dp*ti_added*&
&       wake_overlap*((ti_addedd(nd)*wake_overlap+ti_added*wake_overlapd&
&       (nd))*rotor_area_dst-ti_added*wake_overlap*rotor_area_dstd(nd))/&
&       rotor_area_dst**3
      IF (arg1 .EQ. 0.0) THEN
        ti_dstd(nd) = 0.0_8
      ELSE
        ti_dstd(nd) = arg1d(nd)/(2.0*SQRT(arg1))
      END IF
    END DO
    ti_dst = SQRT(arg1)
! Niayifar and Porte Agel 2015, 2016
  ELSE IF (ti_calculation_method .EQ. 2) THEN
! calculate axial induction based on the Ct value
    CALL CT_TO_AXIAL_IND_FUNC_DV(ct_ust, ct_ustd, axial_induction_ust, &
&                          axial_induction_ustd, nbdirs)
    result1 = SQRT(1.0_dp - ct_ust)
    result2 = SQRT(1.0_dp - ct_ust)
    beta = 0.5_dp*((1.0_dp+result1)/result2)
    pwx1 = x/rotor_diameter_ust
    pwr1 = pwx1**(-0.32_dp)
    DO nd=1,nbdirs
! calculate BPA spread parameters Bastankhah and Porte Agel 2014
      result1d(nd) = -(ct_ustd(nd)/(2.0*SQRT(1.0_dp-ct_ust)))
      result2d(nd) = -(ct_ustd(nd)/(2.0*SQRT(1.0_dp-ct_ust)))
      betad(nd) = 0.5_dp*(result1d(nd)*result2-(1.0_dp+result1)*result2d&
&       (nd))/result2**2
      IF (beta .EQ. 0.0) THEN
        result1d(nd) = 0.0_8
      ELSE
        result1d(nd) = betad(nd)/(2.0*SQRT(beta))
      END IF
      epsilond(nd) = 0.2_dp*result1d(nd)
! Calculate the turbulence added to the inflow of the downstream turbine by the
! wake of the upstream turbine
      pwx1d(nd) = (xd(nd)*rotor_diameter_ust-x*rotor_diameter_ustd(nd))/&
&       rotor_diameter_ust**2
      IF (pwx1 .GT. 0.0) THEN
        pwr1d(nd) = -(0.32_dp*pwx1**(-1.32)*pwx1d(nd))
      ELSE
        pwr1d(nd) = 0.0
      END IF
      ti_addedd(nd) = 0.73_dp*((0.8325_dp*axial_induction_ust**(-0.1675)&
&       *axial_induction_ustd(nd)*pwr1+axial_induction_ust**0.8325_dp*&
&       pwr1d(nd))*ti_ust**0.0325_dp+axial_induction_ust**0.8325_dp*pwr1&
&       *0.0325_dp*ti_ust**(-0.9675)*ti_ustd(nd))
! Calculate the total turbulence intensity at the downstream turbine based on
! current upstream turbine
      rotor_area_dstd(nd) = 0.25_dp*pi*2_dp*rotor_diameter_dst*&
&       rotor_diameter_dstd(nd)
    END DO
    result1 = SQRT(beta)
    epsilon = 0.2_dp*result1
    DO nd=1,nbdirs
! calculate wake spread for TI calcs
      sigmad(nd) = k_star_ustd(nd)*x + k_star_ust*xd(nd) + &
&       rotor_diameter_ustd(nd)*epsilon + rotor_diameter_ust*epsilond(nd&
&       )
      wake_diameterd(nd) = 4.0_dp*sigmad(nd)
    END DO
    sigma = k_star_ust*x + rotor_diameter_ust*epsilon
    wake_diameter = 4.0_dp*sigma
! calculate wake overlap ratio
    CALL OVERLAP_AREA_FUNC_DV(deltay, deltayd, turbine_height, &
&                       turbine_heightd, rotor_diameter_dst, &
&                       rotor_diameter_dstd, 0.0_dp, wake_height, &
&                       wake_heightd, wake_diameter, wake_diameterd, &
&                       wake_overlap, wake_overlapd, nbdirs)
    ti_added = 0.73_dp*axial_induction_ust**0.8325_dp*ti_ust**0.0325_dp*&
&     pwr1
    rotor_area_dst = 0.25_dp*pi*rotor_diameter_dst**2_dp
    arg1 = ti**2.0_dp + (ti_added*(wake_overlap/rotor_area_dst))**2.0_dp
    DO nd=1,nbdirs
      arg1d(nd) = 2.0_dp*ti_added*wake_overlap*(ti_addedd(nd)*&
&       wake_overlap/rotor_area_dst+ti_added*(wake_overlapd(nd)*&
&       rotor_area_dst-wake_overlap*rotor_area_dstd(nd))/rotor_area_dst&
&       **2)/rotor_area_dst
      IF (arg1 .EQ. 0.0) THEN
        ti_tmpd(nd) = 0.0_8
      ELSE
        ti_tmpd(nd) = arg1d(nd)/(2.0*SQRT(arg1))
      END IF
    END DO
    ti_tmp = SQRT(arg1)
! Check if this is the max and use it if it is
    IF (ti_tmp .GT. ti_dst_in) THEN
      DO nd=1,nbdirs
!            print *, "TI_tmp > TI_dst"
        ti_dstd(nd) = ti_tmpd(nd)
      END DO
      ti_dst = ti_tmp
    END IF
  ELSE IF (ti_calculation_method .EQ. 3) THEN
! Niayifar and Porte Agel 2015, 2016 with smooth max
! calculate axial induction based on the Ct value
    CALL CT_TO_AXIAL_IND_FUNC_DV(ct_ust, ct_ustd, axial_induction_ust, &
&                          axial_induction_ustd, nbdirs)
    result1 = SQRT(1.0_dp - ct_ust)
    result2 = SQRT(1.0_dp - ct_ust)
    beta = 0.5_dp*((1.0_dp+result1)/result2)
    pwx1 = x/rotor_diameter_ust
    pwr1 = pwx1**(-0.32_dp)
    DO nd=1,nbdirs
! calculate BPA spread parameters Bastankhah and Porte Agel 2014
      result1d(nd) = -(ct_ustd(nd)/(2.0*SQRT(1.0_dp-ct_ust)))
      result2d(nd) = -(ct_ustd(nd)/(2.0*SQRT(1.0_dp-ct_ust)))
      betad(nd) = 0.5_dp*(result1d(nd)*result2-(1.0_dp+result1)*result2d&
&       (nd))/result2**2
      IF (beta .EQ. 0.0) THEN
        result1d(nd) = 0.0_8
      ELSE
        result1d(nd) = betad(nd)/(2.0*SQRT(beta))
      END IF
      epsilond(nd) = 0.2_dp*result1d(nd)
! Calculate the turbulence added to the inflow of the downstream turbine by the
! wake of the upstream turbine
      pwx1d(nd) = (xd(nd)*rotor_diameter_ust-x*rotor_diameter_ustd(nd))/&
&       rotor_diameter_ust**2
      IF (pwx1 .GT. 0.0) THEN
        pwr1d(nd) = -(0.32_dp*pwx1**(-1.32)*pwx1d(nd))
      ELSE
        pwr1d(nd) = 0.0
      END IF
      ti_addedd(nd) = 0.73_dp*((0.8325_dp*axial_induction_ust**(-0.1675)&
&       *axial_induction_ustd(nd)*pwr1+axial_induction_ust**0.8325_dp*&
&       pwr1d(nd))*ti_ust**0.0325_dp+axial_induction_ust**0.8325_dp*pwr1&
&       *0.0325_dp*ti_ust**(-0.9675)*ti_ustd(nd))
! Calculate the total turbulence intensity at the downstream turbine based on
! current upstream turbine
      rotor_area_dstd(nd) = 0.25_dp*pi*2_dp*rotor_diameter_dst*&
&       rotor_diameter_dstd(nd)
    END DO
    result1 = SQRT(beta)
    epsilon = 0.2_dp*result1
    DO nd=1,nbdirs
! calculate wake spread for TI calcs
      sigmad(nd) = k_star_ustd(nd)*x + k_star_ust*xd(nd) + &
&       rotor_diameter_ustd(nd)*epsilon + rotor_diameter_ust*epsilond(nd&
&       )
      wake_diameterd(nd) = 4.0_dp*sigmad(nd)
    END DO
    sigma = k_star_ust*x + rotor_diameter_ust*epsilon
    wake_diameter = 4.0_dp*sigma
!         print *, "sigma, k_star_ust, x, rotor_diameter_ust, epsilon ", sigma, k_star_ust, x, rotor_diameter_ust, epsilon
! print *, "deltay, turbine_height, rotor_diameter_dst, wake_height, wake_diameter", &
!                 & deltay, turbine_height, rotor_diameter_dst, &
!                             wake_height, wake_diameter
! calculate wake overlap ratio
    CALL OVERLAP_AREA_FUNC_DV(deltay, deltayd, turbine_height, &
&                       turbine_heightd, rotor_diameter_dst, &
&                       rotor_diameter_dstd, 0.0_dp, wake_height, &
&                       wake_heightd, wake_diameter, wake_diameterd, &
&                       wake_overlap, wake_overlapd, nbdirs)
    ti_added = 0.73_dp*axial_induction_ust**0.8325_dp*ti_ust**0.0325_dp*&
&     pwr1
    rotor_area_dst = 0.25_dp*pi*rotor_diameter_dst**2_dp
    arg1 = ti**2.0_dp + (ti_added*(wake_overlap/rotor_area_dst))**2.0_dp
    DO nd=1,nbdirs
      arg1d(nd) = 2.0_dp*ti_added*wake_overlap*(ti_addedd(nd)*&
&       wake_overlap/rotor_area_dst+ti_added*(wake_overlapd(nd)*&
&       rotor_area_dst-wake_overlap*rotor_area_dstd(nd))/rotor_area_dst&
&       **2)/rotor_area_dst
      IF (arg1 .EQ. 0.0) THEN
        ti_tmpd(nd) = 0.0_8
      ELSE
        ti_tmpd(nd) = arg1d(nd)/(2.0*SQRT(arg1))
      END IF
    END DO
    ti_tmp = SQRT(arg1)
!print *, "TI, TI_added, wake_overlap, rotor_area_dst: ", TI, TI_added, wake_overlap, rotor_area_dst
! Check if this is the max and use it if it is
!if (TI_tmp > TI_dst) then
!    TI_dst = TI_tmp
!end if
!         print *, "before: ", TI_dst, TI_tmp
!         TI_dst_in = TI_dst
    CALL SMOOTH_MAX_DV(sm_smoothing, ti_dst_in, ti_dst_ind, ti_tmp, &
&                ti_tmpd, ti_dst, ti_dstd, nbdirs)
!         print *, "after:: ", TI_dst, TI_tmp
! Niayifar and Porte Agel 2015, 2016 using max on area TI ratio
  ELSE IF (ti_calculation_method .EQ. 4) THEN
! calculate axial induction based on the Ct value
    CALL CT_TO_AXIAL_IND_FUNC_DV(ct_ust, ct_ustd, axial_induction_ust, &
&                          axial_induction_ustd, nbdirs)
    result1 = SQRT(1.0_dp - ct_ust)
    result2 = SQRT(1.0_dp - ct_ust)
    beta = 0.5_dp*((1.0_dp+result1)/result2)
    pwx1 = x/rotor_diameter_ust
    pwr1 = pwx1**(-0.32_dp)
    DO nd=1,nbdirs
! calculate BPA spread parameters Bastankhah and Porte Agel 2014
      result1d(nd) = -(ct_ustd(nd)/(2.0*SQRT(1.0_dp-ct_ust)))
      result2d(nd) = -(ct_ustd(nd)/(2.0*SQRT(1.0_dp-ct_ust)))
      betad(nd) = 0.5_dp*(result1d(nd)*result2-(1.0_dp+result1)*result2d&
&       (nd))/result2**2
      IF (beta .EQ. 0.0) THEN
        result1d(nd) = 0.0_8
      ELSE
        result1d(nd) = betad(nd)/(2.0*SQRT(beta))
      END IF
      epsilond(nd) = 0.2_dp*result1d(nd)
! Calculate the turbulence added to the inflow of the downstream turbine by the
! wake of the upstream turbine
      pwx1d(nd) = (xd(nd)*rotor_diameter_ust-x*rotor_diameter_ustd(nd))/&
&       rotor_diameter_ust**2
      IF (pwx1 .GT. 0.0) THEN
        pwr1d(nd) = -(0.32_dp*pwx1**(-1.32)*pwx1d(nd))
      ELSE
        pwr1d(nd) = 0.0
      END IF
      ti_addedd(nd) = 0.73_dp*((0.8325_dp*axial_induction_ust**(-0.1675)&
&       *axial_induction_ustd(nd)*pwr1+axial_induction_ust**0.8325_dp*&
&       pwr1d(nd))*ti_ust**0.0325_dp+axial_induction_ust**0.8325_dp*pwr1&
&       *0.0325_dp*ti_ust**(-0.9675)*ti_ustd(nd))
! Calculate the total turbulence intensity at the downstream turbine based on
! current upstream turbine
      rotor_area_dstd(nd) = 0.25_dp*pi*2_dp*rotor_diameter_dst*&
&       rotor_diameter_dstd(nd)
    END DO
    result1 = SQRT(beta)
    epsilon = 0.2_dp*result1
    DO nd=1,nbdirs
! calculate wake spread for TI calcs
      sigmad(nd) = k_star_ustd(nd)*x + k_star_ust*xd(nd) + &
&       rotor_diameter_ustd(nd)*epsilon + rotor_diameter_ust*epsilond(nd&
&       )
      wake_diameterd(nd) = 4.0_dp*sigmad(nd)
    END DO
    sigma = k_star_ust*x + rotor_diameter_ust*epsilon
    wake_diameter = 4.0_dp*sigma
! calculate wake overlap ratio
    CALL OVERLAP_AREA_FUNC_DV(deltay, deltayd, turbine_height, &
&                       turbine_heightd, rotor_diameter_dst, &
&                       rotor_diameter_dstd, 0.0_dp, wake_height, &
&                       wake_heightd, wake_diameter, wake_diameterd, &
&                       wake_overlap, wake_overlapd, nbdirs)
    ti_added = 0.73_dp*axial_induction_ust**0.8325_dp*ti_ust**0.0325_dp*&
&     pwr1
    rotor_area_dst = 0.25_dp*pi*rotor_diameter_dst**2_dp
    DO nd=1,nbdirs
      ti_area_ratio_tmpd(nd) = ti_addedd(nd)*wake_overlap/rotor_area_dst&
&       + ti_added*(wake_overlapd(nd)*rotor_area_dst-wake_overlap*&
&       rotor_area_dstd(nd))/rotor_area_dst**2
    END DO
    ti_area_ratio_tmp = ti_added*(wake_overlap/rotor_area_dst)
! Check if this is the max and use it if it is
    IF (ti_area_ratio_tmp .GT. ti_area_ratio_in) THEN
      ti_area_ratio = ti_area_ratio_tmp
      arg1 = ti**2.0_dp + ti_area_ratio**2.0_dp
      DO nd=1,nbdirs
!            print *, "ti_area_ratio_tmp > ti_area_ratio"
!TI_dst = TI_tmp
        ti_area_ratiod(nd) = ti_area_ratio_tmpd(nd)
        arg1d(nd) = 2.0_dp*ti_area_ratio*ti_area_ratiod(nd)
        IF (arg1 .EQ. 0.0) THEN
          ti_dstd(nd) = 0.0_8
        ELSE
          ti_dstd(nd) = arg1d(nd)/(2.0*SQRT(arg1))
        END IF
      END DO
      ti_dst = SQRT(arg1)
    END IF
  ELSE IF (ti_calculation_method .EQ. 5) THEN
! Niayifar and Porte Agel 2015, 2016 using smooth max on area TI ratio
! calculate axial induction based on the Ct value
    CALL CT_TO_AXIAL_IND_FUNC_DV(ct_ust, ct_ustd, axial_induction_ust, &
&                          axial_induction_ustd, nbdirs)
    result1 = SQRT(1.0_dp - ct_ust)
    result2 = SQRT(1.0_dp - ct_ust)
    beta = 0.5_dp*((1.0_dp+result1)/result2)
    DO nd=1,nbdirs
! calculate BPA spread parameters Bastankhah and Porte Agel 2014
      result1d(nd) = -(ct_ustd(nd)/(2.0*SQRT(1.0_dp-ct_ust)))
      result2d(nd) = -(ct_ustd(nd)/(2.0*SQRT(1.0_dp-ct_ust)))
      betad(nd) = 0.5_dp*(result1d(nd)*result2-(1.0_dp+result1)*result2d&
&       (nd))/result2**2
      IF (beta .EQ. 0.0) THEN
        result1d(nd) = 0.0_8
      ELSE
        result1d(nd) = betad(nd)/(2.0*SQRT(beta))
      END IF
      epsilond(nd) = 0.2_dp*result1d(nd)
    END DO
    result1 = SQRT(beta)
    epsilon = 0.2_dp*result1
    DO nd=1,nbdirs
! calculate wake spread for TI calcs
      sigmad(nd) = k_star_ustd(nd)*x + k_star_ust*xd(nd) + &
&       rotor_diameter_ustd(nd)*epsilon + rotor_diameter_ust*epsilond(nd&
&       )
      wake_diameterd(nd) = 4.0_dp*sigmad(nd)
    END DO
    sigma = k_star_ust*x + rotor_diameter_ust*epsilon
    wake_diameter = 4.0_dp*sigma
! calculate wake overlap ratio
    CALL OVERLAP_AREA_FUNC_DV(deltay, deltayd, turbine_height, &
&                       turbine_heightd, rotor_diameter_dst, &
&                       rotor_diameter_dstd, 0.0_dp, wake_height, &
&                       wake_heightd, wake_diameter, wake_diameterd, &
&                       wake_overlap, wake_overlapd, nbdirs)
! only include turbines with area overlap in the softmax
    IF (wake_overlap .GT. 0.0_dp) THEN
      pwx1 = x/rotor_diameter_ust
      pwr1 = pwx1**(-0.32_dp)
      ti_added = 0.73_dp*axial_induction_ust**0.8325_dp*ti_ust**&
&       0.0325_dp*pwr1
      rotor_area_dst = 0.25_dp*pi*rotor_diameter_dst**2_dp
      DO nd=1,nbdirs
! Calculate the turbulence added to the inflow of the downstream turbine by the
! wake of the upstream turbine
        pwx1d(nd) = (xd(nd)*rotor_diameter_ust-x*rotor_diameter_ustd(nd)&
&         )/rotor_diameter_ust**2
        IF (pwx1 .GT. 0.0) THEN
          pwr1d(nd) = -(0.32_dp*pwx1**(-1.32)*pwx1d(nd))
        ELSE
          pwr1d(nd) = 0.0
        END IF
        ti_addedd(nd) = 0.73_dp*((0.8325_dp*axial_induction_ust**(&
&         -0.1675)*axial_induction_ustd(nd)*pwr1+axial_induction_ust**&
&         0.8325_dp*pwr1d(nd))*ti_ust**0.0325_dp+axial_induction_ust**&
&         0.8325_dp*pwr1*0.0325_dp*ti_ust**(-0.9675)*ti_ustd(nd))
        rotor_area_dstd(nd) = 0.25_dp*pi*2_dp*rotor_diameter_dst*&
&         rotor_diameter_dstd(nd)
        ti_area_ratio_tmpd(nd) = ti_addedd(nd)*wake_overlap/&
&         rotor_area_dst + ti_added*(wake_overlapd(nd)*rotor_area_dst-&
&         wake_overlap*rotor_area_dstd(nd))/rotor_area_dst**2
      END DO
      ti_area_ratio_tmp = ti_added*(wake_overlap/rotor_area_dst)
!TI_tmp = sqrt(TI**2.0_dp + (TI_added*(wake_overlap/rotor_area_dst))**2.0_dp)
! Run through the smooth max to get an approximation of the true max TI area ratio
      CALL SMOOTH_MAX_DV(sm_smoothing, ti_area_ratio_in, &
&                  ti_area_ratio_ind, ti_area_ratio_tmp, &
&                  ti_area_ratio_tmpd, ti_area_ratio, ti_area_ratiod, &
&                  nbdirs)
      arg1 = ti**2.0_dp + ti_area_ratio**2.0_dp
      DO nd=1,nbdirs
! Calculate the total turbulence intensity at the downstream turbine based on
! the result of the smooth max function
        arg1d(nd) = 2.0_dp*ti_area_ratio*ti_area_ratiod(nd)
        IF (arg1 .EQ. 0.0) THEN
          ti_dstd(nd) = 0.0_8
        ELSE
          ti_dstd(nd) = arg1d(nd)/(2.0*SQRT(arg1))
        END IF
      END DO
      ti_dst = SQRT(arg1)
    END IF
  ELSE
! wake combination method error
    PRINT*, &
&   'Invalid added TI calculation method. Must be one of [0,1,2,3,4,5].'
    STOP
  END IF
END SUBROUTINE ADDED_TI_FUNC_DV

!  Differentiation of overlap_area_func in forward (tangent) mode:
!   variations   of useful results: wake_overlap
!   with respect to varying inputs: wake_diameter rotor_diameter
!                turbine_y turbine_z wake_center_z
! calculates the overlap area between a given wake and a rotor area
SUBROUTINE OVERLAP_AREA_FUNC_DV(turbine_y, turbine_yd, turbine_z, &
& turbine_zd, rotor_diameter, rotor_diameterd, wake_center_y, &
& wake_center_z, wake_center_zd, wake_diameter, wake_diameterd, &
& wake_overlap, wake_overlapd, nbdirs)
!  USE DIFFSIZES
!  Hint: nbdirs should be the maximum number of differentiation directions
  IMPLICIT NONE
  INTRINSIC KIND
! define precision to be the standard for a double precision ! on local system
  INTEGER, PARAMETER :: dp=KIND(0.d0)
! in
  REAL(dp), INTENT(IN) :: turbine_y, turbine_z, rotor_diameter
  REAL(dp), DIMENSION(nbdirs), INTENT(IN) :: turbine_yd, turbine_zd, &
& rotor_diameterd
  REAL(dp), INTENT(IN) :: wake_center_y, wake_center_z, wake_diameter
  REAL(dp), DIMENSION(nbdirs), INTENT(IN) :: wake_center_zd, &
& wake_diameterd
! out
  REAL(dp), INTENT(OUT) :: wake_overlap
  REAL(dp), DIMENSION(nbdirs), INTENT(OUT) :: wake_overlapd
! local
  REAL(dp), PARAMETER :: pi=3.141592653589793_dp, tol=0.000001_dp
  REAL(dp) :: ovdyd, ovr, ovrr, ovl, ovz, ovz2
  REAL(dp), DIMENSION(nbdirs) :: ovdydd, ovrd, ovrrd, ovld, ovzd, &
& ovz2d
! load intrinsic functions
  INTRINSIC ACOS, SQRT
  REAL(dp) :: arg1
  REAL(dp), DIMENSION(nbdirs) :: arg1d
  REAL(dp) :: result1
  REAL(dp), DIMENSION(nbdirs) :: result1d
  REAL(dp) :: arg2
  REAL(dp), DIMENSION(nbdirs) :: arg2d
  REAL(dp) :: result2
  REAL(dp), DIMENSION(nbdirs) :: result2d
  INTEGER :: nd
  INTEGER :: nbdirs
!     print *, turbine_y, turbine_z, rotor_diameter, &
!                             wake_center_y, wake_center_z, wake_diameter, &
!                             wake_overlap
! distance between wake center and rotor center
  IF (wake_center_z .GT. turbine_z + tol .OR. wake_center_z .LT. &
&     turbine_z - tol) THEN
    arg1 = (wake_center_y-turbine_y)**2_dp + (wake_center_z-turbine_z)**&
&     2_dp
    DO nd=1,nbdirs
      arg1d(nd) = 2_dp*(wake_center_z-turbine_z)*(wake_center_zd(nd)-&
&       turbine_zd(nd)) - 2_dp*(wake_center_y-turbine_y)*turbine_yd(nd)
      IF (arg1 .EQ. 0.0) THEN
        ovdydd(nd) = 0.0_8
      ELSE
        ovdydd(nd) = arg1d(nd)/(2.0*SQRT(arg1))
      END IF
    END DO
    ovdyd = SQRT(arg1)
  ELSE IF (wake_center_y .GT. turbine_y + tol) THEN
    DO nd=1,nbdirs
! potential source of gradient issues, abs() did not cause a problem in FLORIS
      ovdydd(nd) = -turbine_yd(nd)
    END DO
    ovdyd = wake_center_y - turbine_y
  ELSE IF (turbine_y .GT. wake_center_y + tol) THEN
    DO nd=1,nbdirs
      ovdydd(nd) = turbine_yd(nd)
    END DO
    ovdyd = turbine_y - wake_center_y
  ELSE
    ovdyd = 0.0_dp
    ovdydd(:) = 0.0_8
  END IF
  DO nd=1,nbdirs
!print *, "OVdYd: ", OVdYd
! find rotor radius
    ovrd(nd) = rotor_diameterd(nd)/2.0_dp
!print *, "OVr: ", OVr
! find wake radius
    ovrrd(nd) = wake_diameterd(nd)/2.0_dp
  END DO
  ovr = rotor_diameter/2.0_dp
  ovrr = wake_diameter/2.0_dp
!print *, "OVRR: ", OVRR
! make sure the distance from wake center to turbine hub is positive
! OVdYd = abs(OVdYd) !!! commented out since change to 2D distance (y,z) will always be positive
! calculate the distance from the wake center to the line perpendicular to the
! line between the two circle intersection points
!if (OVdYd >= 0.0_dp + tol) then ! check case to avoid division by zero
!     print *, "OVdYd ", OVdYd
! if (OVdYd >= 0.0_dp + tol) then ! check case to avoid division by zero
!         OVL = (-OVr*OVr+OVRR*OVRR+OVdYd*OVdYd)/(2.0_dp*OVdYd)
! !         print *, "OVdYd, OVL: ", OVdYd, OVL
!     else
!         OVL = 0.0_dp
!     end if
!
!     OVz = OVRR*OVRR-OVL*OVL
!
!     ! Finish calculating the distance from the intersection line to the outer edge of the wake
!     !if (OVz > 0.0_dp + tol) then
!     if (OVz > 0.0_dp + tol) then
!         OVz = sqrt(OVz)
!     else
!         OVz = 0.0_dp
!     end if
!print *, "OVRR, OVL, OVRR, OVr, OVdYd, OVz ", OVRR, OVL, OVRR, OVr, OVdYd, OVz
! if (OVdYd < (OVr+OVRR)) then ! if the rotor overlaps the wake
!         !print *, "OVL: ", OVL
!         if (OVL < OVRR .and. (OVdYd-OVL) < OVr) then
! !         if (OVdYd > 0.0_dp + tol) then
! !         if ((OVdYd > 0.0_dp) .and. (OVdYd > (OVRR - OVr))) then
!             ! print *, "acos(OVL/OVRR), acos((OVdYd-OVL)/OVr), OVRR, OVL, OVr, OVdYd, OVL/OVRR, (OVdYd-OVL)/OVr ", &
! !     & acos(OVL/OVRR), acos((OVdYd-OVL)/OVr), OVRR, OVL, OVr, OVdYd, OVL/OVRR, (OVdYd-OVL)/OVr
!             wake_overlap = OVRR*OVRR*acos(OVL/OVRR) + OVr*OVr*acos((OVdYd-OVL)/OVr) - OVdYd*OVz
!         else if (OVRR > OVr) then
!             wake_overlap = pi*OVr*OVr
!             !print *, "wake ovl: ", wake_overlap
!         else
!             wake_overlap = pi*OVRR*OVRR
!         end if
!     else
!         wake_overlap = 0.0_dp
!     end if
! determine if there is overlap
  IF (ovdyd .LT. ovr + ovrr) THEN
! if the rotor overlaps the wake zone
! check that turbine and wake centers are not perfectly aligned
    IF (ovdyd .GT. 0.0_dp + tol) THEN
! check if the rotor is wholly contained in the wake
      IF (ovdyd + ovr .LT. ovrr + tol) THEN
        DO nd=1,nbdirs
          wake_overlapd(nd) = pi*(ovrd(nd)*ovr+ovr*ovrd(nd))
        END DO
        wake_overlap = pi*ovr*ovr
!                 print *, "1"
! check if the wake is wholly contained in the rotor swept area
      ELSE IF (ovdyd + ovrr .LT. ovr + tol) THEN
        DO nd=1,nbdirs
          wake_overlapd(nd) = pi*(ovrrd(nd)*ovrr+ovrr*ovrrd(nd))
        END DO
        wake_overlap = pi*ovrr*ovrr
!                 print *, "2"
      ELSE
        ovl = (-(ovr*ovr)+ovrr*ovrr+ovdyd*ovdyd)/(2.0_dp*ovdyd)
        arg1 = ovrr*ovrr - ovl*ovl
        arg2 = (ovdyd-ovl)/ovr
        DO nd=1,nbdirs
! calculate the distance from the wake center to the chord connecting the lens
! cusps
          ovld(nd) = ((ovrrd(nd)*ovrr-ovr*ovrd(nd)-ovrd(nd)*ovr+ovrr*&
&           ovrrd(nd)+ovdydd(nd)*ovdyd+ovdyd*ovdydd(nd))*2.0_dp*ovdyd-(-&
&           (ovr*ovr)+ovrr*ovrr+ovdyd*ovdyd)*2.0_dp*ovdydd(nd))/(2.0_dp*&
&           ovdyd)**2
          arg1d(nd) = ovrrd(nd)*ovrr + ovrr*ovrrd(nd) - ovld(nd)*ovl - &
&           ovl*ovld(nd)
          IF (arg1 .EQ. 0.0) THEN
            ovzd(nd) = 0.0_8
          ELSE
            ovzd(nd) = arg1d(nd)/(2.0*SQRT(arg1))
          END IF
          arg1d(nd) = ovrd(nd)*ovr + ovr*ovrd(nd) - (ovdydd(nd)-ovld(nd)&
&           )*(ovdyd-ovl) - (ovdyd-ovl)*(ovdydd(nd)-ovld(nd))
          arg2d(nd) = ((ovdydd(nd)-ovld(nd))*ovr-(ovdyd-ovl)*ovrd(nd))/&
&           ovr**2
          IF (arg2 .EQ. 1.0 .OR. arg2 .EQ. (-1.0)) THEN
            result2d(nd) = 0.0_8
          ELSE
            result2d(nd) = -(arg2d(nd)/SQRT(1.0-arg2**2))
          END IF
        END DO
        ovz = SQRT(arg1)
        arg1 = ovr*ovr - (ovdyd-ovl)*(ovdyd-ovl)
        DO nd=1,nbdirs
          IF (arg1 .EQ. 0.0) THEN
            ovz2d(nd) = 0.0_8
          ELSE
            ovz2d(nd) = arg1d(nd)/(2.0*SQRT(arg1))
          END IF
          arg1d(nd) = (ovld(nd)*ovrr-ovl*ovrrd(nd))/ovrr**2
        END DO
        ovz2 = SQRT(arg1)
        arg1 = ovl/ovrr
        result1 = ACOS(arg1)
        result2 = ACOS(arg2)
        DO nd=1,nbdirs
          IF (arg1 .EQ. 1.0 .OR. arg1 .EQ. (-1.0)) THEN
            result1d(nd) = 0.0_8
          ELSE
            result1d(nd) = -(arg1d(nd)/SQRT(1.0-arg1**2))
          END IF
          wake_overlapd(nd) = (ovrrd(nd)*ovrr+ovrr*ovrrd(nd))*result1 + &
&           ovrr**2*result1d(nd) + (ovrd(nd)*ovr+ovr*ovrd(nd))*result2 +&
&           ovr**2*result2d(nd) - ovld(nd)*ovz - ovl*ovzd(nd) - (ovdydd(&
&           nd)-ovld(nd))*ovz2 - (ovdyd-ovl)*ovz2d(nd)
        END DO
        wake_overlap = ovrr*ovrr*result1 + ovr*ovr*result2 - ovl*ovz - (&
&         ovdyd-ovl)*ovz2
!                 print *, OVRR, OVr, OVdYd, OVL, OVz, OVz2
!                 print *, "3"
      END IF
    ELSE IF (ovrr .GT. ovr) THEN
! perfect overlap case where the wake is larger than the rotor
      DO nd=1,nbdirs
        wake_overlapd(nd) = pi*(ovrd(nd)*ovr+ovr*ovrd(nd))
      END DO
      wake_overlap = pi*ovr*ovr
!             print *, "4"
! perfect overlap case where the rotor is larger than the wake
    ELSE
      DO nd=1,nbdirs
        wake_overlapd(nd) = pi*(ovrrd(nd)*ovrr+ovrr*ovrrd(nd))
      END DO
      wake_overlap = pi*ovrr*ovrr
!             print *, "5"
    END IF
  ELSE
! case with no overlap
    wake_overlap = 0.0_dp
    wake_overlapd(:) = 0.0_8
  END IF
!     print *, "wake overlap in func: ", wake_overlap/(pi*OVr**2)
!     print *, "wake overlap in func: ", wake_overlap/(pi*OVRR**2)
  IF (wake_overlap/(pi*ovr*ovr) .GT. 1.0_dp + tol .OR. wake_overlap/(pi*&
&     ovrr*ovrr) .GT. 1.0_dp + tol) THEN
    PRINT*, 'wake overlap in func: ', wake_overlap/(pi*ovr*ovr)
    PRINT*, 'wake overlap in func: ', wake_overlap/(pi*ovrr*ovrr)
    STOP
  END IF
END SUBROUTINE OVERLAP_AREA_FUNC_DV

!  Differentiation of k_star_func in forward (tangent) mode:
!   variations   of useful results: k_star_ust
!   with respect to varying inputs: ti_ust
! compute wake spread parameter based on local turbulence intensity
SUBROUTINE K_STAR_FUNC_DV(ti_ust, ti_ustd, k_star_ust, k_star_ustd, &
& nbdirs)
!  USE DIFFSIZES
!  Hint: nbdirs should be the maximum number of differentiation directions
  IMPLICIT NONE
  INTRINSIC KIND
! define precision to be the standard for a double precision ! on local system
  INTEGER, PARAMETER :: dp=KIND(0.d0)
! in
  REAL(dp), INTENT(IN) :: ti_ust
  REAL(dp), DIMENSION(nbdirs), INTENT(IN) :: ti_ustd
! out
  REAL(dp), INTENT(OUT) :: k_star_ust
  REAL(dp), DIMENSION(nbdirs), INTENT(OUT) :: k_star_ustd
  INTEGER :: nd
  INTEGER :: nbdirs
  DO nd=1,nbdirs
! calculate wake spread parameter from Niayifar and Porte Agel (2015, 2016)
    k_star_ustd(nd) = 0.3837*ti_ustd(nd)
  END DO
  k_star_ust = 0.3837*ti_ust + 0.003678
END SUBROUTINE K_STAR_FUNC_DV

!  Differentiation of ct_to_axial_ind_func in forward (tangent) mode:
!   variations   of useful results: axial_induction
!   with respect to varying inputs: ct
! calculate axial induction from Ct
SUBROUTINE CT_TO_AXIAL_IND_FUNC_DV(ct, ctd, axial_induction, &
& axial_inductiond, nbdirs)
!  USE DIFFSIZES
!  Hint: nbdirs should be the maximum number of differentiation directions
  IMPLICIT NONE
  INTRINSIC KIND
! define precision to be the standard for a double precision ! on local system
  INTEGER, PARAMETER :: dp=KIND(0.d0)
! in
  REAL(dp), INTENT(IN) :: ct
  REAL(dp), DIMENSION(nbdirs), INTENT(IN) :: ctd
! out
  REAL(dp), INTENT(OUT) :: axial_induction
  REAL(dp), DIMENSION(nbdirs), INTENT(OUT) :: axial_inductiond
  INTRINSIC SQRT
  REAL(dp) :: arg1
  REAL(dp), DIMENSION(nbdirs) :: arg1d
  REAL(dp) :: result1
  REAL(dp), DIMENSION(nbdirs) :: result1d
  INTEGER :: nd
  INTEGER :: nbdirs
! initialize axial induction to zero
  axial_induction = 0.0_dp
! calculate axial induction
  IF (ct .GT. 0.96) THEN
    arg1 = 0.0203_dp - 0.6427_dp*(0.889_dp-ct)
    DO nd=1,nbdirs
! Glauert condition
      arg1d(nd) = 0.6427_dp*ctd(nd)
      IF (arg1 .EQ. 0.0) THEN
        result1d(nd) = 0.0_8
      ELSE
        result1d(nd) = arg1d(nd)/(2.0*SQRT(arg1))
      END IF
      axial_inductiond(nd) = result1d(nd)
    END DO
    result1 = SQRT(arg1)
    axial_induction = 0.143_dp + result1
  ELSE
    DO nd=1,nbdirs
      result1d(nd) = -(ctd(nd)/(2.0*SQRT(1.0_dp-ct)))
      axial_inductiond(nd) = -(0.5_dp*result1d(nd))
    END DO
    result1 = SQRT(1.0_dp - ct)
    axial_induction = 0.5_dp*(1.0_dp-result1)
  END IF
END SUBROUTINE CT_TO_AXIAL_IND_FUNC_DV

!  Differentiation of wind_shear_func in forward (tangent) mode:
!   variations   of useful results: adjusted_wind_speed
!   with respect to varying inputs: point_z u_ref
! adjust wind speed for wind shear
SUBROUTINE WIND_SHEAR_FUNC_DV(point_z, point_zd, u_ref, u_refd, z_ref, &
& z_0, shear_exp, adjusted_wind_speed, adjusted_wind_speedd, nbdirs)
!  USE DIFFSIZES
!  Hint: nbdirs should be the maximum number of differentiation directions
  IMPLICIT NONE
  INTRINSIC KIND
! define precision to be the standard for a double precision ! on local system
  INTEGER, PARAMETER :: dp=KIND(0.d0)
! in
  REAL(dp), INTENT(IN) :: point_z, u_ref, z_ref, z_0, shear_exp
  REAL(dp), DIMENSION(nbdirs), INTENT(IN) :: point_zd, u_refd
! out
  REAL(dp), INTENT(OUT) :: adjusted_wind_speed
  REAL(dp), DIMENSION(nbdirs), INTENT(OUT) :: adjusted_wind_speedd
  REAL(dp) :: pwx1
  REAL(dp), DIMENSION(nbdirs) :: pwx1d
  REAL(dp) :: pwr1
  REAL(dp), DIMENSION(nbdirs) :: pwr1d
  INTEGER :: nd
  INTEGER :: nbdirs
! initialize adjusted wind speed to zero
  adjusted_wind_speed = 0.0_dp
! check that the point of interest is above ground level
  IF (point_z .GE. z_0) THEN
    pwx1 = (point_z-z_0)/(z_ref-z_0)
    pwr1 = pwx1**shear_exp
    DO nd=1,nbdirs
! adjusted wind speed for wind shear if point is above ground
      pwx1d(nd) = point_zd(nd)/(z_ref-z_0)
      IF (pwx1 .GT. 0.0 .OR. (pwx1 .LT. 0.0 .AND. shear_exp .EQ. INT(&
&         shear_exp))) THEN
        pwr1d(nd) = shear_exp*pwx1**(shear_exp-1)*pwx1d(nd)
      ELSE IF (pwx1 .EQ. 0.0 .AND. shear_exp .EQ. 1.0) THEN
        pwr1d(nd) = pwx1d(nd)
      ELSE
        pwr1d(nd) = 0.0
      END IF
      adjusted_wind_speedd(nd) = u_refd(nd)*pwr1 + u_ref*pwr1d(nd)
    END DO
    adjusted_wind_speed = u_ref*pwr1
  ELSE
! if the point of interest is below ground, set the wind speed to 0.0
    adjusted_wind_speed = 0.0_dp
    adjusted_wind_speedd(:) = 0.0_8
  END IF
END SUBROUTINE WIND_SHEAR_FUNC_DV

!  Differentiation of discontinuity_point_func in forward (tangent) mode:
!   variations   of useful results: discontinuity_point
!   with respect to varying inputs: yaw ky kz rotor_diameter x0
!                ct
! calculate the point where the Bastankhah and Porte Agel wake model becomes undefined
SUBROUTINE DISCONTINUITY_POINT_FUNC_DV(x0, x0d, rotor_diameter, &
& rotor_diameterd, ky, kyd, kz, kzd, yaw, yawd, ct, ctd, &
& discontinuity_point, discontinuity_pointd, nbdirs)
!  USE DIFFSIZES
!  Hint: nbdirs should be the maximum number of differentiation directions
  IMPLICIT NONE
  INTRINSIC KIND
! define precision to be the standard for a double precision ! on local system
  INTEGER, PARAMETER :: dp=KIND(0.d0)
! in
  REAL(dp), INTENT(IN) :: x0, rotor_diameter, ky, kz, yaw, ct
  REAL(dp), DIMENSION(nbdirs), INTENT(IN) :: x0d, rotor_diameterd, &
& kyd, kzd, yawd, ctd
! local
  REAL(dp) :: a, b, c
  REAL(dp), DIMENSION(nbdirs) :: ad, bd, cd
! out
  REAL(dp), INTENT(OUT) :: discontinuity_point
  REAL(dp), DIMENSION(nbdirs), INTENT(OUT) :: discontinuity_pointd
  INTRINSIC COS, SQRT
  REAL(dp) :: result1
  REAL(dp), DIMENSION(nbdirs) :: result1d
  REAL(dp) :: arg1
  REAL(dp), DIMENSION(nbdirs) :: arg1d
  INTEGER :: nd
  INTEGER :: nbdirs
  a = ky + kz*COS(yaw)
  b = 4.0_dp*ky*kz*COS(yaw)*(ct-1.0_dp)
  result1 = SQRT(8.0_dp)
  arg1 = a**2 - b
  DO nd=1,nbdirs
! for clarity, break out the terms in the equation
    ad(nd) = kyd(nd) + kzd(nd)*COS(yaw) - kz*yawd(nd)*SIN(yaw)
    bd(nd) = 4.0_dp*(((kyd(nd)*kz+ky*kzd(nd))*(ct-1.0_dp)+ky*kz*ctd(nd))&
&     *COS(yaw)-ky*kz*(ct-1.0_dp)*yawd(nd)*SIN(yaw))
    cd(nd) = 2.0_dp*result1*(kyd(nd)*kz+ky*kzd(nd))
! distance from rotor to the last point where the wake model is undefined
    arg1d(nd) = 2*a*ad(nd) - bd(nd)
    IF (arg1 .EQ. 0.0) THEN
      result1d(nd) = 0.0_8
    ELSE
      result1d(nd) = arg1d(nd)/(2.0*SQRT(arg1))
    END IF
  END DO
  c = 2.0_dp*result1*ky*kz
  result1 = SQRT(arg1)
  DO nd=1,nbdirs
    discontinuity_pointd(nd) = x0d(nd) + ((rotor_diameterd(nd)*(a-&
&     result1)+rotor_diameter*(ad(nd)-result1d(nd)))*c-rotor_diameter*(a&
&     -result1)*cd(nd))/c**2
  END DO
  discontinuity_point = x0 + rotor_diameter*(a-result1)/c
END SUBROUTINE DISCONTINUITY_POINT_FUNC_DV

!  Differentiation of smooth_max in forward (tangent) mode:
!   variations   of useful results: g
!   with respect to varying inputs: x y
SUBROUTINE SMOOTH_MAX_DV(s, x, xd, y, yd, g, gd, nbdirs)
!  USE DIFFSIZES
!  Hint: nbdirs should be the maximum number of differentiation directions
  IMPLICIT NONE
  INTRINSIC KIND
! define precision to be the standard for a double precision ! on local system
  INTEGER, PARAMETER :: dp=KIND(0.d0)
! in
  REAL(dp), INTENT(IN) :: s, x, y
  REAL(dp), DIMENSION(nbdirs), INTENT(IN) :: xd, yd
! local
  REAL(dp) :: max_val, min_val
  REAL(dp), DIMENSION(nbdirs) :: max_vald, min_vald
! out
  REAL(dp), INTENT(OUT) :: g
  REAL(dp), DIMENSION(nbdirs), INTENT(OUT) :: gd
  INTRINSIC LOG, EXP, MAX, MIN
  REAL(dp) :: arg1
  REAL(dp), DIMENSION(nbdirs) :: arg1d
  REAL(dp) :: arg2
  REAL(dp), DIMENSION(nbdirs) :: arg2d
  INTEGER :: nd
  INTEGER :: nbdirs
  IF (x .LT. y) THEN
    DO nd=1,nbdirs
      max_vald(nd) = yd(nd)
    END DO
    max_val = y
  ELSE
    DO nd=1,nbdirs
      max_vald(nd) = xd(nd)
    END DO
    max_val = x
  END IF
  IF (x .GT. y) THEN
    DO nd=1,nbdirs
      min_vald(nd) = yd(nd)
    END DO
    min_val = y
  ELSE
    DO nd=1,nbdirs
      min_vald(nd) = xd(nd)
    END DO
    min_val = x
  END IF
  arg1 = s*(min_val-max_val)
  arg2 = 1.0_dp + EXP(arg1)
  DO nd=1,nbdirs
    arg1d(nd) = s*(min_vald(nd)-max_vald(nd))
    arg2d(nd) = arg1d(nd)*EXP(arg1)
    gd(nd) = (arg2d(nd)/arg2+s*max_vald(nd))/s
  END DO
  g = (LOG(arg2)+s*max_val)/s
END SUBROUTINE SMOOTH_MAX_DV

!  Differentiation of interpolation in forward (tangent) mode:
!   variations   of useful results: yval
!   with respect to varying inputs: yval xval
SUBROUTINE INTERPOLATION_DV(npoints, interp_type, x, y, xval, xvald, &
& yval, yvald, dy0in, dy1in, usedyin, nbdirs)
!  USE DIFFSIZES
!  Hint: nbdirs should be the maximum number of differentiation directions
  IMPLICIT NONE
!     print *, "yval = ", yval
  INTRINSIC KIND
! define precision to be the standard for a double precision ! on local system
  INTEGER, PARAMETER :: dp=KIND(0.d0)
! in
  INTEGER, INTENT(IN) :: npoints, interp_type
  REAL(dp), DIMENSION(npoints), INTENT(IN) :: x, y
  REAL(dp), INTENT(IN) :: xval
  REAL(dp), DIMENSION(nbdirs), INTENT(IN) :: xvald
  REAL(dp), INTENT(IN) :: dy0in, dy1in
  LOGICAL :: usedyin
! local
  INTEGER :: idx
  REAL(dp) :: x0, x1, y0, dy0, y1, dy1
! out
  REAL(dp), INTENT(OUT) :: yval
  REAL(dp), DIMENSION(nbdirs), INTENT(OUT) :: yvald
  INTEGER :: nd
  INTEGER :: nbdirs
!     print *, "in interpolation"
! if ((xval < x(1)) .or. (xval > x(nPoints))) then
!         print *, "interpolation point is out of bounds"
! !         STOP 1
!     end if
  IF (usedyin .AND. interp_type .EQ. 1) THEN
    PRINT*, &
&  'end point derivatives may not be specified for linear interpolation'
    STOP
  ELSE IF (xval .LT. x(1)) THEN
    yval = y(1)
    yvald(:) = 0.0_8
  ELSE IF (xval .GT. x(npoints)) THEN
    yval = y(npoints)
    yvald(:) = 0.0_8
  ELSE
    idx = 1
    DO WHILE (xval .GT. x(idx) .AND. idx .LE. npoints)
      idx = idx + 1
    END DO
    idx = idx - 1
    x0 = x(idx)
    x1 = x(idx+1)
    y0 = y(idx)
    y1 = y(idx+1)
! Hermite cubic piecewise spline interpolation
    IF (interp_type .EQ. 0) THEN
! approximate derivative at left end of interval
      IF (idx .EQ. 1) THEN
        IF (usedyin) THEN
          dy0 = dy0in
        ELSE
          dy0 = 0.0_dp
        END IF
      ELSE
        dy0 = (y(idx+1)-y(idx-1))/(x(idx+1)-x(idx-1))
      END IF
! approximate derivative at the right end of interval
      IF (idx .GE. npoints - 1) THEN
        IF (usedyin) THEN
          dy1 = dy1in
        ELSE
          dy1 = 0.0_dp
        END IF
      ELSE
        dy1 = (y(idx+2)-y(idx))/(x(idx+2)-x(idx))
      END IF
! call Hermite spline routine
      CALL HERMITE_SPLINE_DV(xval, xvald, x0, x1, y0, dy0, y1, dy1, yval&
&                      , yvald, nbdirs)
! linear interpolation
    ELSE IF (interp_type .EQ. 1) THEN
      DO nd=1,nbdirs
        yvald(nd) = (y1-y0)*xvald(nd)/(x1-x0)
      END DO
      yval = (xval-x0)*(y1-y0)/(x1-x0) + y0
    END IF
  END IF
END SUBROUTINE INTERPOLATION_DV

!  Differentiation of hermite_spline in forward (tangent) mode:
!   variations   of useful results: y
!   with respect to varying inputs: x
SUBROUTINE HERMITE_SPLINE_DV(x, xd, x0, x1, y0, dy0, y1, dy1, y, yd, &
& nbdirs)
!  USE DIFFSIZES
!  Hint: nbdirs should be the maximum number of differentiation directions
  IMPLICIT NONE
!dy_dx = c3*3*x**2 + c2*2*x + c1
  INTRINSIC KIND
! define precision to be the standard for a double precision ! on local system
  INTEGER, PARAMETER :: dp=KIND(0.d0)
! in
  REAL(dp), INTENT(IN) :: x, x0, x1, y0, dy0, y1, dy1
  REAL(dp), DIMENSION(nbdirs), INTENT(IN) :: xd
! out
!, dy_dx
  REAL(dp), INTENT(OUT) :: y
  REAL(dp), DIMENSION(nbdirs), INTENT(OUT) :: yd
! local
  REAL(dp) :: c3, c2, c1, c0
  INTEGER :: nd
  INTEGER :: nbdirs
! initialize coefficients for parametric cubic spline
  c3 = 2.0_dp*y1/(x0**3-3.0_dp*x0**2*x1+3.0_dp*x0*x1**2-x1**3) - 2.0_dp*&
&   y0/(x0**3-3.0_dp*x0**2*x1+3.0_dp*x0*x1**2-x1**3) + dy0/(x0**2-2.0_dp&
&   *x0*x1+x1**2) + dy1/(x0**2-2.0_dp*x0*x1+x1**2)
  c2 = 3.0_dp*y0*(x0+x1)/(x0**3-3.0_dp*x0**2*x1+3.0_dp*x0*x1**2-x1**3) -&
&   dy1*(2.0_dp*x0+x1)/(x0**2-2.0_dp*x0*x1+x1**2) - dy0*(x0+2.0_dp*x1)/(&
&   x0**2-2.0_dp*x0*x1+x1**2) - 3.0_dp*y1*(x0+x1)/(x0**3-3.0_dp*x0**2*x1&
&   +3.0_dp*x0*x1**2-x1**3)
  c1 = dy0*(x1**2+2.0_dp*x0*x1)/(x0**2-2.0_dp*x0*x1+x1**2) + dy1*(x0**2+&
&   2.0_dp*x1*x0)/(x0**2-2.0_dp*x0*x1+x1**2) - 6.0_dp*x0*x1*y0/(x0**3-&
&   3.0_dp*x0**2*x1+3.0_dp*x0*x1**2-x1**3) + 6.0_dp*x0*x1*y1/(x0**3-&
&   3.0_dp*x0**2*x1+3.0_dp*x0*x1**2-x1**3)
  c0 = y0*(-(x1**3)+3.0_dp*x0*x1**2)/(x0**3-3.0_dp*x0**2*x1+3.0_dp*x0*x1&
&   **2-x1**3) - y1*(-(x0**3)+3.0_dp*x1*x0**2)/(x0**3-3.0_dp*x0**2*x1+&
&   3.0_dp*x0*x1**2-x1**3) - x0*x1**2*dy0/(x0**2-2.0_dp*x0*x1+x1**2) - &
&   x0**2*x1*dy1/(x0**2-2.0_dp*x0*x1+x1**2)
  DO nd=1,nbdirs
!    print *, 'c3 = ', c3
!    print *, 'c2 = ', c2
!    print *, 'c1 = ', c1
!    print *, 'c0 = ', c0
! Solve for y and dy values at the given point
    yd(nd) = c3*3*x**2*xd(nd) + c2*2*x*xd(nd) + c1*xd(nd)
  END DO
  y = c3*x**3 + c2*x**2 + c1*x + c0
END SUBROUTINE HERMITE_SPLINE_DV
!    yd, n = _checkIfFloat(yd)
!
!     y1 = (1-pct_offset)*ymax
!     y2 = (1+pct_offset)*ymax
!
!     dy1 = (1-pct_offset)
!     dy2 = (1+pct_offset)
!
!     if (maxmin == 1) then
!         f1 = y1
!         f2 = ymax
!         g1 = 1.0_dp
!         g2 = 0.0_dp
!         if (yd .ge. y2) then
!             idx_constant = False
!         else
!             idx_constant = True
!         end if
!
!         df1 = dy1
!         df2 = 1.0_dp
!
!
!     else if (maxmin == 0) then
!         f1 = ymax
!         f2 = y2
!         g1 = 0.0_dp
!         g2 = 1.0_dp
!         if (yd .ge. y1) then
!             idx_constant = False
!         else
!             idx_constant = True
!         end if
!
!         df1 = 1.0_dp
!         df2 = dy2
!
!     end if
!
!     f = CubicSplineSegment(y1, y2, f1, f2, g1, g2)
!
!     # main region
!     ya = np.copy(yd)
!     if dyd is None:
!         dya_dyd = np.ones_like(yd)
!     else:
!         dya_dyd = np.copy(dyd)
!
!     dya_dymax = np.zeros_like(ya)
!
!     # cubic spline region
!     idx = np.logical_and(yd > y1, yd < y2)
!     ya[idx] = f.eval(yd[idx])
!     dya_dyd[idx] = f.eval_deriv(yd[idx])
!     dya_dymax[idx] = f.eval_deriv_params(yd[idx], dy1, dy2, df1, df2, 0.0, 0.0)
!
!     # constant region
!     ya[idx_constant] = ymax
!     dya_dyd[idx_constant] = 0.0
!     dya_dymax[idx_constant] = 1.0
!
!     if n == 1:
!         ya = ya[0]
!         dya_dyd = dya_dyd[0]
!         dya_dymax = dya_dymax[0]
!
!
!     return ya, dya_dyd, dya_dymax
!
!
! def smooth_max(yd, ymax, pct_offset=0.01, dyd=None):
!     """array max, uses cubic spline to smoothly transition.  derivatives with respect to array and max value.
!     width of transition can be controlled, and chain rules for differentiation"""
!     return _smooth_maxmin(yd, ymax, 'max', pct_offset, dyd)
!
!
! def smooth_min(yd, ymin, pct_offset=0.01, dyd=None):
!     """array min, uses cubic spline to smoothly transition.  derivatives with respect to array and min value.
!     width of transition can be controlled, and chain rules for differentiation"""
!     return _smooth_maxmin(yd, ymin, 'min', pct_offset, dyd)
!


C
C**************************  FHUDDS ************************************
C
C  calculate second derivative of effective saturation with respect to
C  pressure head using Huyakorn characteristic equation
C
C***********************************************************************
C
      DOUBLE PRECISION FUNCTION FHUDDS(PSI)
C
      IMPLICIT NONE
      INCLUDE 'CATHY.H'
      REAL*8   PAP,PAPR,LAMBDA,LAMR
      REAL*8   PSI
      INCLUDE 'SOILCHAR.H'
C
      IF (PSI .LT. HUPSIA) THEN
         PAP=HUPSIA - PSI
         PAPR=1.0D0/PAP
         LAMBDA=HUALB*(PAP**HUBETA)
         LAMR=1.0D0/(1.0D0 + LAMBDA)
         FHUDDS=HUGB*LAMBDA*PAPR*PAPR*(HU1BET + HUGB1*LAMBDA)*
     1                                (LAMR**HUGAM2)
      ELSE
         FHUDDS=0.0D0
      END IF
C
      RETURN
      END


MODULE find2d_com
   !
   USE kind
   !
   IMPLICIT NONE
   !
   ! basic variables of the system-----------------------------------
   !
   !
   ! basis vectors for lattice and reciprocal lattice from input
   REAL(KIND=DP), DIMENSION(3,3) :: cvec, bvec_c
   ! volume and wigner-seitz radius of lattice and reciprocal lattice
   REAL(KIND=DP) :: rvolume,gvolume,rradius,gradius
   !
   ! atoms position
   INTEGER :: nat
   INTEGER, ALLOCATABLE, DIMENSION(:) :: atom_type
   REAL(KIND=DP), ALLOCATABLE, DIMENSION(:,:) :: atom_tau
   !
   ! tolerance for lattice and reciprocal lattice
   REAL(KIND=DP) :: eps_scale, eps_r, eps_g
   !
   ! distance
   REAL(KIND=DP) :: dist_min, dist_a_min, dist_a_new, r_max
      ! minimal distance between crystal planes
      ! minimal distance between atoms in different crystal planes
      ! new distance between atoms in different crystal planes
      ! maximal magnitude of lattice vector grid
   !
   ! variables about crystal planes----------------------------------
   !
   INTEGER, PARAMETER :: gv_max_num=9261,gv_max_n1=10,gv_max_n2=10,&
                                                      gv_max_n3=10
   INTEGER :: gv_num
   REAL(KIND=DP), ALLOCATABLE, DIMENSION(:,:) :: gv_vec
      ! gv(1:3,fixed_num) three components on bvec_c...
   REAL(KIND=DP), ALLOCATABLE, DIMENSION(:) :: gv_len
   !
   ! variables about inner and intra layer basis vectors-------------
   !
   INTEGER, PARAMETER :: av_max_num=1331,av_max_n1=5,av_max_n2=5,&
                                                      av_max_n3=5
   REAL(KIND=DP), ALLOCATABLE, DIMENSION(:,:,:) :: avec
   !
ENDMODULE find2d_com


!
! Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
! See https://llvm.org/LICENSE.txt for license information.
! SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception

! 2d int array, minloc with dim and back

program main
  integer :: res(4)
  integer, dimension(3,4) :: array
  integer :: expect(4)
  array = reshape((/4,3,-4,-4,1,-4,4,-2,5,2,6,5/),shape(array))
  res = minloc(array, dim = 1, back=.true.)
  expect = (/3,3,2,1/)
  call check(res, expect, 4)
  !print *, "base=true:", res
  res = minloc(array, dim = 1, back=.false.)
  expect = (/3,1,2,1/)
  call check(res, expect, 4)
  !print *, "back=false:", res
end


program file_statistics
    use, intrinsic :: iso_fortran_env, only : dp => REAL64, error_unit
    use :: statistics
    implicit none
    integer, parameter :: file_unit = 20
    character(len=1024) :: file_name, msg
    integer :: istat
    type(stats_type) :: stats
    real(kind=dp) :: data_value

    if (command_argument_count() < 1) then
        write (unit=error_unit, fmt='(A)') '# error: no file given'
        stop 1
    end if
    call get_command_argument(1, file_name)
    open(unit=file_unit, file=trim(file_name), access='sequential', action='read', &
         status='old', form='formatted', iostat=istat, iomsg=msg)
    if (istat /= 0) then
        write (unit=error_unit, fmt='(2A)') '# error: ', msg
        stop istat
    end if
    call init_stats(stats)
    do while (.true.)
        read (unit=file_unit, fmt='(E25.0)', iostat=istat, iomsg=msg) data_value
        if (is_iostat_end(istat)) exit
        if (istat /= 0) then
            write (unit=error_unit, fmt='(2A)') '# error: ', msg
            stop istat
        end if
        print '(A, E15.4)', 'read ', data_value
        call add_stats(stats, data_value)
    end do
    close(unit=file_unit)
    if (nr_stats(stats) > 0) then
        print '(A, E10.4)', 'mean   = ', mean_stats(stats)
        print '(A, E10.4)', 'stddev = ', stddev_stats(stats)
    end if

end program file_statistics


!* Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
!* See https://llvm.org/LICENSE.txt for license information.
!* SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception

!	OpenMP Parallel Region in caller, DO in callee, with NOWAIT

! If -Mfprelaxed is used, the test could fail because of the use of
! the rsqrt instruction when computing sqrt.
! The following -y says to inhibit '-Mfprelaxed'; need this because
! That doesn't work for IPA case, though.  Change the op to use double.
!!!pgi$g -y 15 0x10
	program p
	 implicit none
	 integer n
	 parameter(n=10)
	 real a(0:n),b(n),y(n)
	 real result(2*n)
	 real expect(2*n)
	 data expect/1.,4.,9.,16.,25.,36.,49.,64.,81.,100.,
     &		     1.,2.,3.,4.,5.,6.,7.,8.,9.,10./
	 integer i
	 do i = 0,n
	  a(i) = i*i+i
	 enddo
!$omp   parallel
	 call sp2(a,b,y,n)
!$omp   end parallel
	 !print *,b
	 !print *,y
	 do i = 1,n
	  result(i) = b(i)
	  result(n+i) = y(i)
	 enddo
	 call check(result,expect,2*n)
	end

	subroutine sp2(a,b,y,n)
	 implicit none
	 integer n
	 real a(0:n),b(n),y(n)
	 integer i
!$omp   do
	do i = 1,n
	 b(i) = (a(i) + a(i-1)) / 2.0
	enddo
!$omp   end do
!$omp   do
	do i = 1,n
	 y(i) = dsqrt(dble(b(i)))
	enddo
!$omp   end do nowait
	end


module comm

use, intrinsic :: iso_c_binding, only: sp=>C_FLOAT, dp=>C_DOUBLE, int64=>C_LONG_LONG, sizeof=>c_sizeof

implicit none (type, external)
private
public :: rand_init, sp, dp, J, pi, debug

complex(dp),parameter :: J = (0._dp, 1._dp)
real(dp),parameter :: pi = 4._dp*atan(1._dp)
logical :: debug = .false.

contains

subroutine rand_init(repeatable, image_distinct)
logical, intent(in) :: repeatable, image_distinct

call random_init(repeatable, image_distinct)

end subroutine rand_init

end module comm


program test5
  use SparseKit
  implicit none
  type(Sparse) :: matrix

  matrix = sparse( nnz = 12, rows = 4)

  call matrix%append( val =    4.d0, row = 1, col = 1)
  call matrix%append( val =    1.d0, row = 1, col = 2)
  call matrix%append( val =   60.d0, row = 1, col = 3)
  call matrix%append( val =   -5.d0, row = 1, col = 4)
  call matrix%append( val =  300.d0, row = 2, col = 2)
  call matrix%append( val = -675.d0, row = 2, col = 3)
  call matrix%append( val =  420.d0, row = 2, col = 4)
  call matrix%append( val =   60.d0, row = 3, col = 1)
  call matrix%append( val =    1.d0, row = 3, col = 3)
  call matrix%append( val =  -35.d0, row = 4, col = 1)
  call matrix%append( val =  420.d0, row = 4, col = 2)
  call matrix%append( val =  700.d0, row = 4, col = 4)

  call matrix%makeCRS

  print'(/,A,E14.7)','Norma de Frobenius = ', norm(matrix)

end program test5

tests/test5 - Norma de Frobenius/main.f90